PowerBuilder à Donf ! / [RESOLU] API Terminal Sever, WTSEnumerateSessions

erasorz · 29-07-2008 16:01:56

déclarations des fonctions externes :

Code: pb

Function Boolean WTSEnumerateSessionsW( Ulong hServer, Ulong Reserved, Ulong Version, &
  Ref Ulong  ppSessionInfo, Ref Ulong pCount ) Library 'Wtsapi32.dll' 
  
Function Long CopyMemory( Ref String d, Long s, Long l) Library 'kernel32.dll' alias for 'lstrcpynW'

déclaration de la structure wts_session_info :

Code: pb

global type wts_session_info from structure
  ulong    sessionid
  string    pWinStationName
  ulong    State
end type

appel :

Code: pb

ulong ll_count, ll_pointer 
Boolean lb_ok  
WTS_SESSION_INFO lst_tab_session[]

lb_ok = WTSEnumerateSessionsW( 0, 0, 1, ll_pointer, ll_count )

If lb_ok Then
  
  messagebox(string(ll_pointer),string(ll_count))
  
//  CopyMemory( lst_tab_session[0], ll_pointer, ll_count * 12 )
  
Else
  
  messagebox('erreur',)
  
End If

définition MSDN de WTSEnumerateSessions

je me suis inspiré de cet exemple de code VB : http://support.microsoft.com/kb/291789
le WTSEnumerateSessionsW fonctionne mais ensuite je ne vois pas comment faire pour récupérer le tableau de WTS_SESSION_INFO à partir du pointeur

Code: vb

Option Explicit

Private Const WTS_CURRENT_SERVER_HANDLE = 0&

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

Private Type WTS_SESSION_INFO
    SessionID As Long
    pWinStationName As Long
    state As WTS_CONNECTSTATE_CLASS
End Type

Private Declare Function WTSEnumerateSessions _
    Lib "wtsapi32.dll" Alias "WTSEnumerateSessionsA" ( _
    ByVal hServer As Long, ByVal Reserved As Long, _
    ByVal Version As Long, ByRef ppSessionInfo As Long, _
    ByRef pCount As Long _
    ) As Long
    
Private Declare Sub WTSFreeMemory Lib "wtsapi32.dll" ( _
    ByVal pMemory As Long)

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    Destination As Any, Source As Any, ByVal length As Long)

Private Declare Function lstrlenA Lib "kernel32" ( _
    ByVal lpString As String) As Long

Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" ( _
    ByVal lpString1 As String, ByVal lpString2 As Long) As Long

Private arrWTSSessions() As WTS_SESSION_INFO

Private Function GetWTSSessions() As WTS_SESSION_INFO()
    Dim RetVal As Long
    Dim lpBuffer As Long
    Dim Count As Long
    Dim p As Long
    Dim arrSessionInfo() As WTS_SESSION_INFO
    
    RetVal = WTSEnumerateSessions(WTS_CURRENT_SERVER_HANDLE, _
                                   0&, _
                                   1, _
                                   lpBuffer, _
                                   Count)
    If RetVal Then
        ' WTSEnumerateProcesses was successful.
        
        p = lpBuffer
        ReDim arrSessionInfo(Count - 1)
        CopyMemory arrSessionInfo(0), ByVal p, _
           Count * LenB(arrSessionInfo(0))
        ' Free the memory buffer.
        WTSFreeMemory lpBuffer
    
     Else
        ' Error occurred calling WTSEnumerateProcesses.
        ' Check Err.LastDllError for error code.
        MsgBox "An error occurred calling WTSEnumerateProcesses.  " & _
        "Check the Platform SDK error codes in the MSDN Documentation " & _
        "for more information.", vbCritical, "ERROR " & Err.LastDllError
    End If
    GetWTSSessions = arrSessionInfo
End Function

Private Sub Command1_Click()
    Dim i As Integer
    
    arrWTSSessions = GetWTSSessions
    For i = LBound(arrWTSSessions) To UBound(arrWTSSessions)
        Debug.Print "Session ID: " & arrWTSSessions(i).SessionID
        Debug.Print "Machine Name: " & _
           PointerToStringA(arrWTSSessions(i).pWinStationName)
        Debug.Print "Connect State: " & arrWTSSessions(i).state
        Debug.Print "***********"
    Next i
End Sub

Public Function PointerToStringA(ByVal lpStringA As Long) As String
   Dim nLen As Long
   Dim sTemp As String

   If lpStringA Then
      nLen = lstrlenA(ByVal lpStringA)
      If nLen Then
         sTemp = String(nLen, vbNullChar)
         lstrcpy sTemp, ByVal lpStringA
         PointerToStringA = sTemp
      End If
   End If
End Function

Cortex · 30-07-2008 07:42:57

Alors, deja, j'ai eu un semblant de reussite!

J'ai simplement remplace le pointeur par un tableau de structure:

Code: pb

Function Boolean WTSEnumerateSessionsW( Ulong hServer, Ulong Reserved, Ulong Version, ref WTS_SESSION_INFO ppSessionInfo[], Ref Ulong pCount ) Library 'Wtsapi32.dll'

Ca, en principe, ca marche dans la majorite des cas, c'est une super feature de PB... (comme si ca avait ete fait expres)

Mais bon, parfois, ca suffit pas... Et ici, y a comme un leger soucis: Ca me renvoie bien des structures dans mon tableau, mais 1 seule, alors que le count renvoie par WTSEnumerateSessionsW est de 2. Bref, j'ai un doute.
Essaie deja cette solution la, on sait jamais, sur un malentendu, ca peut marcher...

Mais bon, au pire, tu devrais essayer de convertir ton code VB a 100%, il m'a l'air bien pense. Ca donnerait quelque chose comme:

Code: pb

Subroutine CopyMemory ( WTS_SESSION_INFO Destination, ulong Source, long length) Library 'kernel32.dll' ALIAS FOR RtlMoveMemory

Et il te restera a modifier ton appel:

Code: pb

ulong ll_count, ll_pointer 
Boolean lb_ok  
WTS_SESSION_INFO lst_tab_session[], lst_dummy
long ll_i

lb_ok = WTSEnumerateSessionsW( 0, 0, 1, ll_pointer, ll_count )
If lb_ok Then

  // on redimensionne la structure
  lst_tab_session[ll_count] = lst_dummy
  
  CopyMemory(lst_tab_session[1], ll_pointer, ll_count * 12 ) // 12 bytes devrait etre la taille de la structure en memoire (2 long + 1 string)

  // ...etc

Et la, en principe, soit tu as un gros plantage pour cause d'acces pas glop a la memoire, soit tu as ton tableu de structures...

erasorz · 30-07-2008 09:28:00

Cortex a écrit:
J'ai simplement remplace le pointeur par un tableau de structure:
Code: pb
Function Boolean WTSEnumerateSessionsW( Ulong hServer, Ulong Reserved, Ulong Version, ref WTS_SESSION_INFO ppSessionInfo[], Ref Ulong pCount ) Library 'Wtsapi32.dll'
Ca, en principe, ca marche dans la majorite des cas, c'est une super feature de PB... (comme si ca avait ete fait expres)

Mais bon, parfois, ca suffit pas... Et ici, y a comme un leger soucis: Ca me renvoie bien des structures dans mon tableau, mais 1 seule, alors que le count renvoie par WTSEnumerateSessionsW est de 2. Bref, j'ai un doute.
Essaie deja cette solution la, on sait jamais, sur un malentendu, ca peut marcher...

Salut Cortex, merci de ta réponse, mais effectivement ça ne renvoie qu'une structure à chaque fois...

Je vais passer par RtlMoveMemory.

NB :

erasorz · 30-07-2008 11:56:30

bon c'est résolu

je poste ici une tout première ébauche de NVO, adaptation à la sauce Terminal Server d'un NVO pour Citrix gracieusement fourni par Roland Smith (http://www.topwizprogramming.com/) que je posterai s'il veut bien.

Code: pb

forward
global type n_ts from nonvisualobject
end type
end forward

global type n_ts from nonvisualobject autoinstantiate
end type

type prototypes

Function Boolean WTSEnumerateSessions ( &
  ULong hServer, ULong Reserved, ULong Version, &
  Ref ULong  ppSessionInfo, Ref ULong pCount &
  ) Library 'Wtsapi32.dll' Alias For 'WTSEnumerateSessionsW'

Function Boolean WTSQuerySessionInformation(  &
  ULong hServer, &
  ULong SessionId, &
  ULong WTSInfoClass, &
  Ref ULong  ppBuffer, &
  Ref ULong pBytesReturned &
  ) Library 'Wtsapi32.dll' Alias For 'WTSQuerySessionInformationW'
  
Function ULong RtlMoveMemoryPtr( &
  Ref ULong dest, &
  ULong source, &
  ULong size &
  ) Library 'kernel32.dll' Alias For 'RtlMoveMemory'

Function ULong RtlMoveMemoryStr( &
  Ref string dest, &
  ULong source, &
  ULong size &
  ) Library 'kernel32.dll' Alias For 'RtlMoveMemory'  

Subroutine WTSFreeMemory( &
  ULong pMemory &
  ) Library 'Wtsapi32.dll'



end prototypes
type variables
Private Constant ULong WTS_CURRENT_SERVER_HANDLE = 0
Private Constant ULong WTS_CURRENT_SESSION = -1


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



end variables

forward prototypes
public function unsignedlong of_getpointer (unsignedlong aul_baseptr, unsignedinteger ai_ptrnum, unsignedinteger ai_arraynum, unsignedinteger ai_ptrcnt)
public function string of_wtsquerysessioninformation (unsignedlong aul_hserver, unsignedlong aul_sessionid, unsignedlong aul_infoclass)
public function string of_get_sessions_infos ()
public function string of_get_current_host ()
end prototypes

public function unsignedlong of_getpointer (unsignedlong aul_baseptr, unsignedinteger ai_ptrnum, unsignedinteger ai_arraynum, unsignedinteger ai_ptrcnt);ULong lul_bufptr, lul_strptr

// calculate memory location
lul_bufptr = aul_baseptr + ((ai_arraynum - 1) * (ai_ptrcnt * 4)) + ((ai_ptrnum - 1) * 4)

// copy pointer into local variable
RtlMoveMemoryPtr(lul_strptr, lul_bufptr, 4)


Return lul_strptr
end function

public function string of_wtsquerysessioninformation (unsignedlong aul_hserver, unsignedlong aul_sessionid, unsignedlong aul_infoclass);ULong lul_ppBuffer, lul_pBytesReturned, lul_strptr
String ls_infovalue

ls_infovalue=Space(256)

Choose Case aul_infoclass
    
    Case WTSInitialProgram, WTSApplicationName, WTSWorkingDirectory, WTSClientName, &
      WTSUserName, WTSWinStationName, WTSDomainName, WTSClientDirectory
      
    If WTSQuerySessionInformation(aul_hserver, aul_sessionid, &
        aul_infoclass, lul_ppBuffer, lul_pBytesReturned) Then
        
      If lul_pBytesReturned > 0 Then
        
        ls_infovalue = String(lul_ppBuffer, 'address')
        
      End If
      
    End If

  Case Else
    
    ls_infovalue = 'not coded'
    
End Choose
    
WTSFreeMemory(lul_ppBuffer)


Return ls_infovalue
end function

public function string of_get_sessions_infos ();// renvoie les infos de toutes les sessions
ULong   lul_ppSessionInfo, lul_count, lul_cpt, lul_SessionId, lul_strptr
String  ls_WinStationName, ls_log = ''
Boolean lb_ok  

lb_ok = WTSEnumerateSessions( WTS_CURRENT_SERVER_HANDLE, 0, 1, lul_ppSessionInfo, lul_count )

If Not lb_ok Then

  messagebox('erreur',)

Else
  
  For lul_cpt = 1 To lul_count
    
        lul_SessionId = This.of_getpointer(lul_ppSessionInfo, 1, lul_cpt, 3)
    lul_strptr = This.of_getpointer(lul_ppSessionInfo, 2, lul_cpt, 3)
    ls_WinStationName = String(lul_strptr, 'address')
    
    ls_log += string(lul_cpt) + '-sessionId='+string(lul_SessionId)&
                             +'-pWinStationName='+ls_WinStationName + '~r~n'
                     
        ls_log += 'WTSUserName=' + This.of_wtsquerysessioninformation( 0, lul_SessionId, WTSUserName)
    ls_log += '-WTSClientName=' + This.of_wtsquerysessioninformation( 0, lul_SessionId, WTSClientName)
    
    ls_log += '~r~n'
    ls_log += '~r~n'
    
  Next
  
  
End If
  
WTSFreeMemory(lul_ppSessionInfo)



Return ls_log
end function

public function string of_get_current_host ();String ls_host


ls_host = This.of_wtsquerysessioninformation( WTS_CURRENT_SERVER_HANDLE, &
                                              WTS_CURRENT_SESSION, WTSClientName )


Return ls_host
end function

on n_ts.create
call super::create
TriggerEvent( this, "constructor" )
end on

on n_ts.destroy
TriggerEvent( this, "destructor" )
call super::destroy
end on

me renvoie ça, ensuite il faut filtrer la console, le listener RDP-Tcp en 65536

1-sessionId=0-pWinStationName=Console
WTSUserName=comandinicy-WTSClientName=

2-sessionId=65536-pWinStationName=RDP-Tcp
WTSUserName=-WTSClientName=

3-sessionId=3-pWinStationName=RDP-Tcp#939
WTSUserName=sdc_user-WTSClientName=6S29KN8ZM1BR

4-sessionId=4-pWinStationName=RDP-Tcp#940
WTSUserName=sdc_admin-WTSClientName=4CLL2KJ

5-sessionId=1-pWinStationName=RDP-Tcp#943
WTSUserName=sdc_user-WTSClientName=PC279811547580