Hi :)
Not my code, just adapted for x64 versions (maybe helps someone so many years later). Is just for getting current RDP (Remote Desktop) client hostname.
Private Declare PtrSafe Sub WTSFreeMemory Lib "wtsapi32.dll" (ByVal pMemory As Any)
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongLong)
Private Declare PtrSafe Function WTSQuerySessionInformationA Lib "wtsapi32.dll" (ByVal hServer As LongLong, ByVal sessionId As LongLong, ByVal wtsInfoClass As LongLong, ByRef pBuffer As LongLong, ByRef dwSize As LongLong) As LongLong
Public Function GetMachinenameofCurrentSession() As String
Dim RetVal As LongLong 'Return Value of API Call
Dim lpBuffer As LongLong 'Buffer to Hold Info Returned
Dim Count As LongLong 'Length of Buffer info
Dim MachineName As String
'If the function succeeds, the return value is a nonzero value.
'If the function fails, the return value is zero.
'To get extended error information, call GetLastError API.
RetVal = WTSQuerySessionInformationA(WTS_CURRENT_SERVER_HANDLE, _
WTS_CURRENT_SESSION, _
WTSClientName, _
lpBuffer, _
Count)
MachineName = GetStringFromLP(lpBuffer)
WTSFreeMemory lpBuffer 'Free the memory used by the buffer.
GetMachinenameofCurrentSession = MachineName
End Function
Private Function GetStringFromLP(ByVal StrPtr As LongLong) As String
Dim b As Byte
Dim tempStr As String
Dim bufferStr As String
Dim Done As Boolean
Done = False
Do
' Get the byte/character that StrPtr is pointing to.
CopyMemory b, ByVal StrPtr, 1
If b = 0 Then ' If you've found a null character,
Done = True
Else
tempStr = Chr$(b)
bufferStr = bufferStr & tempStr 'Add it to the string
StrPtr = StrPtr + 1 ' Increment the pointer to next
End If
Loop Until Done
GetStringFromLP = bufferStr
End Function