WTSQuerySessionInformation

API「WTSQuerySessionInformation」を用いてターミナルサービスに接続した
クライアントの情報を取得するサンプル。

呼び出し元(Form1.vb)

Public Class Form1

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Dim objWTS As New WTS()
        Dim strWk As String

        'クライアント名の取得
        If objWTS.Get_WTSQuerySessionInformation(WTS.WTS_INFO_CLASS.WTSClientName, strWk) Then
            MsgBox("WTSClientName=" & strWk, MsgBoxStyle.Information)
        Else
            MsgBox("失敗", MsgBoxStyle.Critical)
        End If

        'ドメイン名の取得
        If objWTS.Get_WTSQuerySessionInformation(WTS.WTS_INFO_CLASS.WTSDomainName, strWk) Then
            MsgBox("WTSDomainName=" & strWk, MsgBoxStyle.Information)
        Else
            MsgBox("失敗", MsgBoxStyle.Critical)
        End If

        'アドレスの取得
        If objWTS.Get_WTSQuerySessionInformation(WTS.WTS_INFO_CLASS.WTSClientAddress, strWk) Then
            MsgBox("WTSClientAddress=" & strWk, MsgBoxStyle.Information)
        Else
            MsgBox("失敗", MsgBoxStyle.Critical)
        End If


        objWTS = Nothing
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        'ログインユーザの取得
        MsgBox(SystemInformation.UserName)

    End Sub


End Class

※ログインユーザはSystemInformationで取得できる

呼び出し先クラス(WTS.vb)

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

    '*********************************************
    '**　　 APIの定義
    '*********************************************

    <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

        hServer = WTSOpenServer(0)

        'API「WTSQuerySessionInformation」でターミナルサービスの情報を取得
        blnRet = WTSQuerySessionInformation(hServer, getTermSessionID, 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

    '*********************************************
    '**　　 プロセスよりセッションIDを取得
    '*********************************************
    Private Function getTermSessionID() As Integer
        Const con_SessionId As String = "SessionId"

        Dim obj32Proc As Object
        Dim objProperty As Object
        Dim intCount As Integer = 0

        Dim strSQL As String = "SELECT " & con_SessionId & " FROM Win32_Process WHERE handle = " & Process.GetCurrentProcess.Id

        For Each obj32Proc In GetObject("winmgmts:").ExecQuery(strSQL)
            For Each objProperty In obj32Proc.Properties_
                If (objProperty.Name.ToString = con_SessionId) Then
                    Return CType(objProperty.Value, Integer)
                End If
            Next
            Exit For
        Next
    End Function

End Class

セッションIDを取得する方法はプロセスからでなく
もっとスマートなやり方があるような気がする。

動作確認環境：Windows XP、Windows 2003 Server、Visual Stadion 2005