Imports System.Runtime.InteropServices
Imports System
 
Module RDP_API
 
    Private Const WTS_CURRENT_SERVER_HANDLE As Long = 0
 
    Public Enum WTSInfoClass
        WTSInitialProgram
        WTSApplicationName
        WTSWorkingDirectory
        WTSOEMID
        WTSSessionId
        WTSUserName
        WTSWinStationName
        WTSDomainName
        WTSConnectState
        WTSClientBuilderNumber
        WTSClientName
        WTSClientDirectory
        WTSClientProductId
        WTSClientHardwareId
        WTSClientAddress
        WTSClientDisplay
        WTSClientProtocolType
    End Enum
 
    'WTS Sitzungsanfragen-Struktur
    Public Structure WTS_SESSION_QUERY
        Public SessionID As Int32
        Public pWinStationName As Int32
        Public WTSClientName As String
        Public senum As WTSInfoClass
    End Structure
 
    'Funktionsdefinition API-Aufruf für Session-Daten auslesen
    <DllImport("wtsapi32", CharSet:=CharSet.Ansi)> _
    Public Function _
         WTSQuerySessionInformation(ByVal hServer As System.IntPtr, ByVal _
         sessionId As Integer, ByVal wtsInfoClass As WTSInfoClass, ByRef _
         ppBuffer As System.IntPtr, ByRef pBytesReturned As System.UInt32) As _
         UInt32
 
    End Function
 
 
    'Funktionsdefinition für API-Aufruf "Speicher freigeben",
    <DllImport("wtsapi32", ExactSpelling:=True, SetLastError:=False)> _
    Private Sub WTSFreeMemory(ByVal pMemory As IntPtr)
 
    End Sub
 
 
    'Funktion für Auslesen des RDP-Hostnames
    Public Function GetWTSQueryHost(ByVal SessionID As Int32) As String
        Dim retval As Int32
        Dim lpBuffer As System.IntPtr = IntPtr.Zero
 
 
        Dim Count As System.UInt32
        Dim lName As Int32
        Dim sName As String = ""
 
        Try
 
 
            'Remotesitzungsinformationen holen
            'retval = WTSQuerySessionInformation(WTS_CURRENT_SERVER_HANDLE, _
            '    SessionID, WTSInfoClass.WTSClientName, lpBuffer, Count)
 
 
            retval = WTSQuerySessionInformation(System.IntPtr.Zero, _
              WTS_CURRENT_SERVER_HANDLE, WTSInfoClass.WTSClientName, lpBuffer, _
              Count)
            'Funktionsausschnitt
            ' Prozedur erfolgreich
            If retval Then
 
                'Stringlänge ermitteln
                lName = Strings.Len( _
                  System.Runtime.InteropServices.Marshal.PtrToStringAnsi( _
                  lpBuffer))
 
                If lName <> 0 Then
 
                    sName = _
                      System.Runtime.InteropServices.Marshal.PtrToStringAnsi( _
                      lpBuffer)
 
                End If
 
                ' Speicher wieder freigeben
                WTSFreeMemory(lpBuffer)
            Else
 
                'Prozedurfehler: Keine RDP, Keine DLL da oder sonstwas faul...
                MsgBox("Fehler beim Auslesen der RDP-Sitzungsdaten. Es konnten" _
                  & _
                    "keine Informationen gewonnen werden. ", vbCritical, _
                    "DLL-Zugriffsfehler " & Err.LastDllError)
 
            End If
 
            'Returnwert
            Return sName
        Catch ex As Exception
            Return ""
        End Try
    End Function
 
End Module