Computer Name of Remote Desktop

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

SANJAY SHAH-MICROBRAIN COMPUTERS PVT. LTD. - 09 Jul 2008 13:18 GMT

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

Reply to this Message

Dean Earley - 09 Jul 2008 14:28 GMT

> 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)

Signature

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

iCode Systems

Reply to this Message

Ian Williams - 09 Jul 2008 15:52 GMT

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

Signature

regards

Ian

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

> > Dear Sir,
> >
[quoted text clipped - 6 lines]
> An app running in TS has no access to this info of the client (as it may
> not even exist)

Reply to this Message

Dean Earley - 09 Jul 2008 16:53 GMT

> Of course you can

I stand corrected :)

Signature

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

iCode Systems

Reply to this Message

Sinna - 10 Jul 2008 07:52 GMT

> Of course you can
>
[quoted text clipped - 41 lines]
>
> End Function

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

Reply to this Message

Ian Williams - 10 Jul 2008 09:30 GMT

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

Signature

regards

Ian

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

> 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
[quoted text clipped - 12 lines]
>
> Sinna

Reply to this Message

SANJAY SHAH-MICROBRAIN COMPUTERS PVT. LTD. - 11 Jul 2008 09:50 GMT

Thanks a Lot Ian,

I will check and implement it in my application.

Sanjay Shah

> Sinna
>
[quoted text clipped - 141 lines]
>>
>> Sinna

Reply to this Message

VB Forum / Win API / July 2008

Computer Name of Remote Desktop