В Visual Basic 6 функция Environ() возвращает нулевое значение для CLIENTNAME

У меня есть устаревшее приложение в Visual Basic 6, которое использует функцию Environ(), чтобы получить переменную среды CLIENTNAME.

Функция не возвращает значения. Однако, если я использую команду "SET CLIENTNAME" из оболочки, я получу правильное значение.

Если пользователю предоставлены права администратора, Environ() работает нормально, возвращая правильное значение, что свидетельствует о проблеме безопасности.

Буду признателен за любое предложение.

1 ответ

Решение

Вы можете использовать вызовы API для получения текущего имени клиента сеанса RDP, как это

Option Explicit

'--- for WTSQuerySessionInformation
Private Const WTS_CURRENT_SERVER_HANDLE             As Long = 0
Private Const WTS_CURRENT_SESSION                   As Long = -1
Private Const WTSClientName                         As Long = 10

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Declare Function WTSQuerySessionInformation Lib "wtsapi32" Alias "WTSQuerySessionInformationA" (ByVal hServer As Long, ByVal SessionId As Long, ByVal WtsInfoClass As Long, ppBuffer As Long, pBytesReturned As Long) As Long
Private Declare Sub WTSFreeMemory Lib "wtsapi32" (ByVal pMemory As Long)

Private Function GetSessionClientName() As String
    Dim lPtr            As Long
    Dim lSize           As Long

    Call WTSQuerySessionInformation(WTS_CURRENT_SERVER_HANDLE, WTS_CURRENT_SESSION, WTSClientName, lPtr, lSize)
    If lPtr <> 0 Then
        GetSessionClientName = String$(lSize - 1, 0)
        Call CopyMemory(ByVal GetSessionClientName, ByVal lPtr, lSize - 1)
        Call WTSFreeMemory(lPtr)
    End If
End Function

Private Sub Form_Load()
    MsgBox "GetSessionClientName=[" & GetSessionClientName() & "]", vbExclamation
End Sub
Другие вопросы по тегам