ターミナルサービスでのクライアント情報の取得について

ターミナルサービスを使用しているのですが、VB.NET2003からクライアントの情報を取得する方法は無いでしょうか。

プリンターをネットワークプリンターにしているので、ターミナルサービスに接続している、クライアントの情報が分かれば、クライアントの近くのプリンターより印刷できるように印刷設定のファイルを作成したいのです。

よろしくお願いします。

No.1 回答者： todo36 回答日時： 2005/09/01 18:10

環境変数のCLIENTNAMEか

APIのWTSQuerySessionInformation()

この回答への補足

回答ありがとうございます。

よろしければWTSQuerySessionInformation()の使い方を教えていただけないでしょうか。

補足日時：2005/09/01 18:19

No.2 ベストアンサー 回答者： 1050YEN 回答日時： 2005/09/01 22:41

>WTSQuerySessionInformation

OKWEBで「WTSQuerySessionInformation」で検索をかけ、引っかかった2件をベースに、DOBON.NETさんのTipsを見ながら、コンバートしてみました。
http://okweb.jp/kotaeru.php3?q=1409616
http://okweb.jp/kotaeru.php3?q=1419369
http://dobon.net/


私は旧式な人間なため、VB6感覚で作成したために、内部で文字コード変換を行っております。
おそらくAPIの宣言次第では、コンバート部は不要だと思うのですが、調べるのが面倒なので、そのまま載せちゃいます。


それと
http://www.microsoft.com/japan/msdn/library/defa …
のWTSInfoClassのデータの形式を見ると、
「関数をターミナルサービスコンソールから呼び出すと、NULL ポインタを受け取ります」
とあります。

私のところでは、ターミナルサービスコンソールから呼び出す実験をしておりません。

だから、結果が正しいかどうかは無視として、とりあえずコンバートはこんな感じかなぁっていうところです。





[モジュール]Module1.vb
[クラス]WTS.vb
の構成です。

-----------------------------------------------
Module Module1
　　Sub Main()
　　　　Dim objWTS As New WTS()
　　　　Dim strWk As String

　　　　If objWTS.Get_WTSQuerySessionInformation(WTS.WTS_INFO_CLASS.WTSUserName, strWk) Then
　　　　　　MsgBox(strWk, MsgBoxStyle.Information)
　　　　Else
　　　　　　MsgBox("失敗", MsgBoxStyle.Critical)
　　　　End If

　　　　objWTS = Nothing
　　End Sub
End Module

-----------------------------------------------

Imports System.Text
Imports System.Runtime.InteropServices

Public Class WTS
　　Public Enum WTS_INFO_CLASS
　　　　WTSInitialProgram
　　　　WTSApplicationName
　　　　WTSWorkingDirectory
　　　　WTSOEMId
　　　　WTSSessionId
　　　　WTSUserName
　　　　WTSWinStationName
　　　　WTSDomainName
　　　　WTSConnectState
　　　　WTSClientBuildNumber
　　　　WTSClientName
　　　　WTSClientDirectory
　　　　WTSClientProductId
　　　　WTSClientHardwareId
　　　　WTSClientAddress
　　　　WTSClientDisplay
　　　　WTSClientProtocolType
　　End Enum

　　<DllImport("kernel32.dll")> _
　　Private Shared Function lstrlen( _
　　　　　　ByVal Ptr As Integer _
　　　　) As Integer

　　End Function

　　<DllImport("kernel32.dll")> _
　　Private Shared Function lstrcpy( _
　　　　　　ByVal lpString1 As Integer _
　　　　　　, ByVal lpString2 As Integer _
　　　　) As Integer

　　End Function


　　<DllImport("wtsapi32.dll")> _
　　Private Shared Function WTSOpenServer( _
　　　　ByVal pServerName As Integer _
　　　　) As Integer
　　End Function

　　<DllImport("wtsapi32.dll")> _
　　Private Shared Sub WTSFreeMemory( _
　　ByRef pMemory As Integer _
　　)
　　End Sub

　　<DllImport("wtsapi32.dll")> _
　　Private Shared Function WTSQuerySessionInformation( _
　　　　　　ByVal hServer As Integer _
　　　　　　, ByVal SessionId As Integer _
　　　　　　, ByVal WTSInfoClass As WTS_INFO_CLASS _
　　　　　　, ByRef ppBuffer As Integer _
　　　　　　, ByRef pBytesReturned As Integer _
　　　　　　) As Boolean
　　End Function


　　Public Function Get_WTSQuerySessionInformation(ByVal inWTSInfoClass As WTS_INFO_CLASS, ByRef 取得文字列 As String) As Boolean
　　　　Dim l_strRet As String = ""

　　　　Dim hServer As Integer
　　　　Dim blnRet As Boolean
　　　　Dim dwBytesReturned As Integer
　　　　Dim lpBuffer As Integer


　　　　Const WTS_CURRENT_SESSION As Integer = 0

　　　　hServer = WTSOpenServer(0)


　　　　blnRet = WTSQuerySessionInformation(hServer, WTS_CURRENT_SESSION, inWTSInfoClass, lpBuffer, dwBytesReturned)
　　　　If blnRet Then
　　　　　　l_strRet = GetStringFromPointer(lpBuffer)

　　　　　　Call WTSFreeMemory(lpBuffer)
　　　　End If

　　　　取得文字列 = l_strRet

　　　　Return blnRet
　　End Function

　　'*********************************************
　　'**　　 ポインタから文字列取得
　　'*********************************************
　　Private Function GetStringFromPointer(ByVal inPointer As Integer) As String
　　　　Dim l_strRet As String = ""

　　　　'文字長取得
　　　　Dim l_intLen As Integer = lstrlen(inPointer)
　　　　If (l_intLen > 0) Then
　　　　　　Dim bytAry(l_intLen - 1) As Byte

　　　　　　Dim gch As GCHandle = GCHandle.Alloc(bytAry, GCHandleType.Pinned)
　　　　　　Dim address As Integer = gch.AddrOfPinnedObject().ToInt32()

　　　　　　Call lstrcpy(address, inPointer)
　　　　　　gch.Free()

　　　　　　Call Conv_UTF8_to_SJIS(bytAry, l_strRet)
　　　　End If

　　　　Return l_strRet
　　End Function


　　'*********************************************
　　'**　　 エンコード変換
　　'*********************************************
　　Private Sub Conv_UTF8_to_SJIS(ByVal inByte() As Byte, ByRef otStr As String)
　　　　Dim strSJIS As Encoding = Encoding.GetEncoding("Shift-JIS")
　　　　Dim strUTF8 As Encoding = Encoding.UTF8

　　　　Dim asciiBytes As Byte() = Encoding.Convert(strUTF8, strSJIS, inByte)
　　　　Dim chrSJIS(strSJIS.GetCharCount(asciiBytes, 0, asciiBytes.Length - 1)) As Char
　　　　strSJIS.GetChars(asciiBytes, 0, asciiBytes.Length, chrSJIS, 0)
　　　　otStr = New String(chrSJIS)
　　End Sub

End Class

この回答へのお礼

ソースまで付けていただき申し訳ないです。
早速試してみます。
ありがとうございました。

お礼日時：2005/09/02 09:31