Option Compare Database
Option Explicit

Public Type WTS_SESSION_INFO
  SessionId As Long
  pWinStationName As Long
  STATE As Long
End Type

Public Type WTS_PROCESS_INFO
  SessionId As Long
  ProcessId As Long
  pProcessName As Long
  pUserSid As Long
End Type

Public Type WTS_CLIENT_ADDRESS
  AddressFamily As Long
  Address( 1  To  20 ) As Byte
End Type

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



  Const WTSInitialProgram =  0 
  Const WTSApplicationName =  1 
  Const WTSWorkingDirectory =  2 
  Const WTSOEMId =  3 
  Const WTSSessionId =  4 
  Const WTSUserName =  5 
  Const WTSWinStationName =  6 
  Const WTSDomainName =  7 
  Const WTSConnectState =  8 
  Const WTSClientBuildNumber =  9 
  Const WTSClientName =  10 
  Const WTSClientDirectory =  11 
  Const WTSClientProductId =  12 
  Const WTSClientHardwareId =  13 
  Const WTSClientAddress =  14 
  Const WTSClientDisplay =  15 
  Const WTSClientProtocolType =  16 
  
  

  Const WTSActive =  0 
  Const WTSConnected =  1 
  Const WTSConnectQuery =  2 
  Const WTSShadow =  3 
  Const WTSDisconnected =  4 
  Const WTSIdle =  5 
  Const WTSListen =  6 
  Const WTSReset =  7 
  Const WTSDown =  8 
  Const WTSInit =  9 
  
  Const WTSUserConfigInitialProgram =  0 
  Const WTSUserConfigWorkingDirectory =  1 
  Const WTSUserConfigfInheritInitialProgram =  2 
  Const WTSUserConfigfAllowLogonTerminalServer =  3 
  Const WTSUserConfigTimeoutSettingsConnections =  4 
  Const WTSUserConfigTimeoutSettingsDisconnections =  5 
  Const WTSUserConfigTimeoutSettingsIdle =  6 
  Const WTSUserConfigfDeviceClientDrives =  7 
  Const WTSUserConfigfDeviceClientPrinters =  8 
  Const WTSUserConfigfDeviceClientDefaultPrinter =  9 
  Const WTSUserConfigBrokenTimeoutSettings =  10 
  Const WTSUserConfigReconnectSettings =  11 
  Const WTSUserConfigModemCallbackSettings =  12 
  Const WTSUserConfigModemCallbackPhoneNumber =  13 
  Const WTSUserConfigShadowingSettings =  14 
  Const WTSUserConfigTerminalServerProfilePath =  15 
  Const WTSUserConfigTerminalServerHomeDir =  16 
  Const WTSUserConfigTerminalServerHomeDirDrive =  17 
  Const WTSUserConfigfTerminalServerRemoteHomeDir =  18 
  
Declare Function WTSOpenServer Lib "wtsapi32" Alias "WTSOpenServerA" (ByVal pServerName As Any) As Long
Declare Sub WTSCloseServer Lib "wtsapi32" (ByVal hServer As Long)

Declare Function WTSLogoffSession Lib "wtsapi32" (ByVal hServer As Long, ByVal SessionId As Long, ByVal bWait As Long) As Long
Declare Function WTSDisconnectSession Lib "wtsapi32" (ByVal hServer As Long, ByVal SessionId As Long, ByVal bWait As Long) As Long
Declare Function WTSShutdownSystem Lib "wtsapi32" (ByVal hServer As Long, ByVal ShutdownFlag As Long) As Long
Declare Function WTSTerminateProcess Lib "wtsapi32" (ByVal hServer As Long, ByVal ProcessId As Long, ByVal ExitCode As Long) As Long
Declare Sub WTSFreeMemory Lib "wtsapi32" (ByVal pMemory As Long)

  
Declare Function WTSSendMessage Lib "wtsapi32" Alias "WTSSendMessageA" (ByVal hServer As Long, ByVal SessionId As Long, ByVal pTitle As String, _
    ByVal TitleLength As Long, ByVal pmessage As String, ByVal MessageLength As Long, ByVal Style As Long, ByVal Timeout As Long, _
    ByRef pResponce As Long, ByVal bWait As Long) As Long
Declare Function WTSEnumerateSessions Lib "wtsapi32" Alias "WTSEnumerateSessionsA" (ByVal hServer As Long, ByVal Reserved As Long, ByVal Version As Long, _
    ByRef ppSessionInfo As Long, ByRef pCount As Long) As Long
Declare Function WTSEnumerateProcesses Lib "wtsapi32" Alias "WTSEnumerateProcessesA" (ByVal hServer As Long, ByVal Reserved As Long, ByVal Version As Long, _
    ByRef ppProcessInfo As Long, ByRef pCount As Long) As Long
Declare Function WTSQuerySessionInformation Lib "wtsapi32" Alias "WTSQuerySessionInformationA" (ByVal hServer As Long, _
    ByVal SessionId As Long, ByVal WTSInfoClass As Long, ByRef ppBuffer As Long, ByRef pBytesReturned As Long) As Long
    
Declare Function WTSQueryUserConfig Lib "wtsapi32" Alias "WTSQueryUserConfigA" (ByVal pServerName As String, _
  ByVal pUserName As String, ByVal WTSConfigClass As Long, ByRef ppBuffer As Long, ByRef pBytesReturned As Long) As Long
Declare Function WTSSetUserConfig Lib "wtsapi32" Alias "WTSSetUserConfigA" (ByVal pServerName As String, _
  ByVal pUserName As String, ByVal WTSConfigClass As Long, ByVal ppBuffer As Any, ByVal pBytesReturned As Long) As Long
  
Declare Function WTSWaitSystemEvent Lib "wtsapi32" (ByVal hServer As Long, ByVal EventMask As Long, ByRef pEventFlags As Long) As Long
    
Declare Function ProcessIdToSessionId Lib "kernel32" (ByVal dwProcessId As Long, ByRef pSessionId As Long) As Long

Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal v As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hModule As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy&)

Private Function LongByAddr(ptr As Long)
    Dim B As Long
    If ptr <>  0  Then
            RtlMoveMemory B, ptr,  4 
            LongByAddr = B
    Else
            LongByAddr =  0 
    End If
End Function

Private Function StringByAddr(ptr As Long, Optional maxl =  65535 )
    Dim B As Byte
    Dim s As String
    Dim p As Long
    Dim C As Long
    p = ptr
    s = ""
    C = maxl
    If ptr =  0  Then
        StringByAddr = ""
        Exit Function
    End If
    
    Do
        RtlMoveMemory B, p,  1 
        p = p +  1 
        C = C -  1 
        If B =  0  Or C <  0  Then
            StringByAddr = s
            Exit Function
        Else
            s = s & Chr(B)
        End If
    Loop
End Function

Sub test3()
    Dim rc As Long, hs As Long
    Dim rc2 As Long
    Dim A As Long, B As Long
    Dim a1 As Long, b1 As Long
    Dim i As Integer
    Dim ds As WTS_SESSION_INFO
    
    
    hs = WTSOpenServer("10.135.199.197")
    A =  0 : B =  0 
    rc = WTSEnumerateSessions(hs,  0 ,  1 , B, A)
    For i =  1  To A
        RtlMoveMemory ds, B + LenB(ds) * (i -  1 ), LenB(ds)
        a1 =  0 : b1 =  0 
        rc = WTSQuerySessionInformation(hs, ds.SessionId, WTSClientName, b1, a1)
        Debug.Print ds.SessionId, ds.STATE, StringByAddr(ds.pWinStationName), StringByAddr(b1)
    Next i
    WTSFreeMemory B
End Sub


Sub test2()
    Dim A As Long, B As Long
    Dim rc
    rc = WTSWaitSystemEvent( 0 ,  1 , B)
    Debug.Print rc, B



End Sub

Sub test1()
    
    Dim rc, hs
    Dim rc2 As Long
    Dim A As Long, B As Long
    Dim i
    B =  0 
    A =  0 
    
    rc = WTSQueryUserConfig("XP1", "administrator", WTSUserConfigfAllowLogonTerminalServer, B, A)
    Debug.Print rc, A, LongByAddr(B)
    
    Exit Sub
    
    
    
    
    
    
    
    rc = WTSEnumerateSessions( 0 ,  0 ,  1 , B, A)
     'Debug.Print rc, b, a 
    Dim ds As WTS_SESSION_INFO
    For i =  1  To A
        RtlMoveMemory ds, B + LenB(ds) * (i -  1 ), LenB(ds)
        Debug.Print ds.SessionId, ds.STATE, StringByAddr(ds.pWinStationName)
    Next i
    WTSFreeMemory B
    
    For i =  0  To - 1 
        A =  0 : B =  0 
        rc = WTSQuerySessionInformation( 0 ,  0 , i, B, A)
        Debug.Print rc, "len=", A, i, B, StringByAddr(B, A)
        WTSFreeMemory B
    Next i
        
     'a = GetCurrentProcessId() 
     'rc = ProcessIdToSessionId(a, b) 
      
     'Debug.Print rc, b 
    
     'rc = WTSLogoffSession(0, 1, 0) 
     'a = LoadLibrary("wtsapi32") 
     'b = FreeLibrary(a) 
    ' 
    ' 
     'Debug.Print "LL", a, b 
   
    
    Exit Sub
    
    
    A =  0 
     hs = WTSOpenServer(A)
    Debug.Print hs
    WTSCloseServer (hs)
    
    rc = WTSSendMessage( 0 ,  0 , "KKK",  2 , "йцук",  3 ,  0 ,  0 , rc2,  0 )
    Debug.Print rc
End Sub