Computer Name of Remote Desktop

SANJAY SHAH-MICROBRAIN COMPUTERS PVT. LTD.

unread,

Jul 9, 2008, 8:18:14 AM7/9/08

to

Dear Sir,

If user is connected to server using remote desktop connection and runs
application.

In such case how to find name of computer of user.

Thanks,

Sanjay Shah

Dean Earley

unread,

Jul 9, 2008, 9:28:09 AM7/9/08

to

SANJAY SHAH-MICROBRAIN COMPUTERS PVT. LTD. wrote:
> Dear Sir,
>
> If user is connected to server using remote desktop connection and runs
> application.
>
> In such case how to find name of computer of user.

GetUserName()
An app running in TS has no access to this info of the client (as it may
not even exist)

--
Dean Earley (dean....@icode.co.uk)
i-Catcher Development Team

iCode Systems

Ian Williams

unread,

Jul 9, 2008, 10:52:57 AM7/9/08

to

Of course you can

***********************
Option Explicit

Private Declare Function WTSQuerySessionInformation Lib "wtsapi32" _
Alias "WTSQuerySessionInformationA" (ByVal hServer As Long, _
ByVal SessionID As Long, ByVal WTSInfoClass As Long, _
ByRef ppBuffer As Long, ByRef lLen As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Private Const WTS_CURRENT_SERVER_HANDLE As Long = 0
Private Const WTS_CURRENT_SESSION As Long = -1

Public Function GetTSClientHostName() As String
Dim sVal As String
Dim lRet As Long
Dim lLen As Long
Dim lErr As Long
Dim I As Long

Dim lBufferAddress As Long

lRet = WTSQuerySessionInformation(WTS_CURRENT_SERVER_HANDLE, _
WTS_CURRENT_SESSION, _
10, _
lBufferAddress, _
lLen)

' copying the buffer to a VB string

If lLen > 0 Then
lVal = 0
CopyMemory ByVal sVal, ByVal lBufferAddress, lLen
GetTSClientHostName = sVal
End If

If lRet = 0 Then
lErr = Err.LastDllError
GetTSClientHostName = ""
End If

End Function

--

regards

Ian

*** inavlid email address - change country code to full country name

"Dean Earley" <dean....@icode.co.uk> wrote in message
news:u9a6hec4...@TK2MSFTNGP06.phx.gbl...

Dean Earley

unread,

Jul 9, 2008, 11:53:23 AM7/9/08

to

Ian Williams wrote:
> Of course you can

I stand corrected :)

Sinna

unread,

Jul 10, 2008, 2:52:07 AM7/10/08

to

If I take a closer look to your implementation, I think you introduce a
possible GPF in the CopyMemory line. Reason: you didn't allocate memory
for the sVal string. So I think the following improvement will do:
<code>
If lLen > 0 Then
sVal = String(lLen, vbNullChar)

CopyMemory ByVal sVal, ByVal lBufferAddress, lLen
GetTSClientHostName = sVal
End If

</code>

More: I'm also not sure about the CopyMemory call itself, as there are
many declarations for the same call (As Any, As Long, ...) all resulting
in a different behavior.

Sinna

Ian Williams

unread,

Jul 10, 2008, 4:30:45 AM7/10/08

to

Sinna

You're correct on the buffer allocation, I copied from the full function and
missed that line by mistake.

FYI, here's the full function

Private Enum WTS_CONNECTSTATE_CLASS
WTSActive
WTSConnected
WTSConnectQuery
WTSShadow
WTSDisconnected
WTSIdle
WTSListen
WTSReset
WTSDown
WTSInit
End Enum

Private Type WTS_CLIENT_ADDRESS
AddressFamily As Long
Address(20) As Byte
End Type

Private Type WTS_CLIENT_DISPLAY
HorizontalResolution As Long
VerticalResolution As Long
ColorDepth As Long
End Type

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

Private Const WTS_CURRENT_SERVER_HANDLE As Long = 0
Private Const WTS_CURRENT_SESSION As Long = -1

Private varWTS_CONNECTSTATE_CLASS As WTS_CONNECTSTATE_CLASS

Function GetTSEValue(eWTSType As WTS_INFO_CLASS) As String
Dim sVal As String
Dim lVal As Long
Dim intVal As Integer

Dim lRet As Long
Dim lLen As Long
Dim lErr As Long
Dim I As Long

Dim sIP As String

Dim lBufferAddress As Long
Dim varWTS_CLIENT_ADDRESS As WTS_CLIENT_ADDRESS
Dim varWTS_CLIENT_DISPLAY As WTS_CLIENT_DISPLAY

lRet = WTSQuerySessionInformation(WTS_CURRENT_SERVER_HANDLE, _
WTS_CURRENT_SESSION, _

eWTSType, _
lBufferAddress, _
lLen)

' copying the buffer to a VB string

If lLen > 0 Then
Select Case eWTSType
Case 4
CopyMemory lVal, ByVal lBufferAddress, lLen
GetTSEValue = CStr(lVal)
Case 8
CopyMemory lVal, ByVal lBufferAddress, lLen
GetTSEValue = CStr(lVal)
Case 9
CopyMemory intVal, ByVal lBufferAddress, lLen
GetTSEValue = CStr(intVal)
Case 12
CopyMemory intVal, ByVal lBufferAddress, lLen
GetTSEValue = CStr(intVal)
Case 13
CopyMemory intVal, ByVal lBufferAddress, lLen
GetTSEValue = CStr(intVal)
Case 14
CopyMemory varWTS_CLIENT_ADDRESS, ByVal lBufferAddress, lLen
With varWTS_CLIENT_ADDRESS
sIP = .Address(2) & "." & .Address(3) & "." & .Address(4) & "."
& .Address(5)
End With
GetTSEValue = sIP

Case 15
'Can't see any reason to use this as W2K TS only displays at 256
colours
' CopyMemory varWTS_CLIENT_DISPLAY, ByVal lBufferAddress, lLen
' MsgBox "varWTS_CLIENT_DISPLAY.ColorDepth " &
varWTS_CLIENT_DISPLAY.ColorDepth
' MsgBox "varWTS_CLIENT_DISPLAY.HorizontalResolution " &
varWTS_CLIENT_DISPLAY.HorizontalResolution
' MsgBox "varWTS_CLIENT_DISPLAY.VerticalResolution " &
varWTS_CLIENT_DISPLAY.VerticalResolution
Case Else
sVal = Space(lLen) ' allocating memory to the VB string to be
able to store the buffer

CopyMemory ByVal sVal, ByVal lBufferAddress, lLen

GetTSEValue = Trim$(Replace(sVal, Chr(0), ""))
End Select
End If

If lRet = 0 Then
lErr = Err.LastDllError

GetTSEValue = ""
End If

End Function

--

regards

Ian

*** inavlid email address - change country code to full country name

"Sinna" <news4sin...@hotpop.com> wrote in message
news:uBlVOml4...@TK2MSFTNGP05.phx.gbl...
<snipped>

SANJAY SHAH-MICROBRAIN COMPUTERS PVT. LTD.

unread,

Jul 11, 2008, 4:50:33 AM7/11/08

to

Thanks a Lot Ian,

I will check and implement it in my application.

Sanjay Shah

"Ian Williams" <i...@kingsoft-dk.com> wrote in message
news:%23tPECdm...@TK2MSFTNGP06.phx.gbl...