Jump to content

Recommended Posts

Good morning Forums :bye:
In these days, I am working on a project that involved me to use some Windows APIs to obtain some information about Terminal Servers.
I'm doing this using wtsapi32.dll in a VBA Project, but, the lack of knowledge about few things threated in the articles make this quite difficult to
implement and understand at the same time.
The most difficult thing I'm facing is "translating" C/C++ functions or struct in VBA when pointers are used, or pointers of pointers, and so on.
Since VBA seems to not have a pointer type, to make those functions work I need to implement other functions taken from other DLLs, and this confuses me a lot.
For example, starting from this code, I splitted all the functions and all the definitions to understand why they are there, and why I need to use them.
At the end, I've found out that the code I was going to implement starting from the functions provided in the Microsoft Docs won't be ever be able to work without some supplementary functions which are not mentioned anywhere.
So, I was wondering if someone would please point me out to a good and practical exaplanation about pointers (in general) or specifically for VBA, because I need to use them quite often in these days, and I'd like to understand what I am doing.
Thanks in advance.

Best Regards and Stay at home 🏡
 

Edited by FrancescoDiMuro

Click here to see my signature:

Spoiler

ALWAYS GOOD TO READ:

 

Link to post
Share on other sites

Good afternoon @Danyfirex :)
I looked at the links you provided to me, and they have been really helpful about the topic, but, I have a question I can't find an answer for.
Let me show you some code:

Spoiler

Sub StringPointer()

	Dim lngServer As Long			'Server Handle
    Dim lngSessionId As Long		'SessionId
	Dim lngBuffer As Long			'Buffer to the pointer of the information
    Dim lngBytes As Long			'Lenght (in Bytes) of the information returned by 
    Dim strWTSUserName As String
    
    
    'Obtaining Server Handle
    lngServer = WTSOpenServerA("") 'Insert the name of your PC here, or skip this function call and use 0& in WTSQuerySessionInformationA call
   
    'If the handle of the Server is valid
	If lngServer Then

		'Set the SessionId for the Query
		lngSessionId = 0& 'Insert the SessionId by going to Task Manager -> Users -> right-click on columns -> show column "ID"
        
        'Checking for a valid return value of WTSQuerySessionInformationA
		'I'm calling lngBuffer and lngBytes since they are two pointers
		If WTSQuerySessionInformationA(ByVal lngServer, ByVal lngSessionId, ByVal WTSUserName, lngBuffer, lngBytes)
    
            'Buffer address and size (in Bytes) of the information WTSUserName
            Debug.Print "Buffer          : " & lngBuffer & vbNewLine & _
                        "Bytes del buffer: " & lngBytes
            
            'Output of the converted WTSUserName
            Debug.Print "WTSUserName: " & PointerToStringA(lngBuffer)
            
            'Buffer clean-up
            WTSFreeMemory lngBuffer
            
            'Closing server handle
            WTSCloseServer lngServer
            
        End If
    End If

End Sub

 

If you run this function on your PC, you'd probably note that the value of lngBytes is not the lenght in Bytes of the information returned, but the lenght in characters of that, and I've found it strange since in the documentation about WTSQuerySessionInformationA() it says that pBytes stores the lenght in Bytes of the information returned.
Said that, let's see the PointerToStringA() function:

Spoiler

Function PointerToStringA(ByVal lngStringPointer As Long)
    
    Dim lngTempBuffer() As Byte 'Temporary buffer
    Dim lngStringLenght As Long 'String lenght (expressed in number of characters)
    Dim strString As String     'Output string
    
    'Obtaining the number of characters of the string (without the null character at the end of the string)
    lngStringLenght = lstrlenA(lngStringPointer)
    
    'Buffer ReDim
    ReDim lngTempBuffer(lngStringLenght)
    
    'Content string copy [0000]([X])[\0] starting from the first element of the Bytes array, of lngStringLenght Bytes
    CopyMemory lngTempBuffer(0&), ByVal lngStringPointer, lngStringLenght
    
    'For each element in the Bytes array, convert it to Char and compose the string
    For i = 0 To lngStringLenght - 1 Step 1
        strString = strString & Chr(lngTempBuffer(i))
    Next
    
    'Return value of PointerToStringA
    PointerToStringA = strString
    
End Function

 

From here too, I am a little confused.
Since a string in VBA is a pointer to a BSTR data type, couldn't I get the lenght of the string returned by WTSQuerySessionInformationA taking the 4 Bytes data before the start of the string content?
Practically, no, but why?
Then, when I ReDim the Bytes array, shouldn't I use the lenght of the string in characters * the number of Bytes of each character in a VB String (2 Bytes)?
Here too, the answer is "Practically no", but I tried to modify the above code to what "theory says", and the app crashes.
I am asking these questions just to "completely" understand what's going on when strings and pointers are used in VB.

Here it is the Wtsapi32 Module:

Spoiler

Enum WTS_CONNECTSTATE
    '[_First] => Se non viene specificato, il valore di [_First] e' 0
    WTSActive
    WTSConnected
    WTSConnectQuery
    WTSShadow
    WTSDisconnected
    WTSIdle
    WTSListen
    WTSReset
    WTSDown
    WTSInit
    '[_Last]
End Enum

Type WTS_SESSION_INFOA
    SessionId As Long
    pWinStationName As Long
    State As WTS_CONNECTSTATE
End Type

Enum WTS_INFO_CLASS
    WTSInitialProgram
    WTSApplicationName
    WTSWorkingDirectory
    WTSOEMId
    WTSSessionId
    WTSUserName
    WTSWinStationName
    WTSDomainName
    WTSConnectState
    WTSClientBuildNumber
    WTSClientName
    WTSClientDirectory
    WTSClientProductId
    WTSClientHardwareId
    WTSClientAddress
    WTSClientDisplay
    WTSClientProtocolType
    WTSIdleTime
    WTSLogonTime
    WTSIncomingBytes
    WTSOutgoingBytes
    WTSIncomingFrames
    WTSOutgoingFrames
    WTSClientInfo
    WTSSessionInfo
    WTSSessionInfoEx
    WTSConfigInfo
    WTSValidationInfo
    WTSSessionAddressV4
    WTSIsRemoteSession
End Enum

'typedef struct _WTSINFOA {
'  WTS_CONNECTSTATE_CLASS State;
'  DWORD                  SessionId;
'  DWORD                  IncomingBytes;
'  DWORD                  OutgoingBytes;
'  DWORD                  IncomingFrames;
'  DWORD                  OutgoingFrames;
'  DWORD                  IncomingCompressedBytes;
'  DWORD                  OutgoingCompressedBy;
'  CHAR                   WinStationName[WINSTATIONNAME_LENGTH];
'  CHAR                   Domain[DOMAIN_LENGTH];
'  CHAR                   UserName[USERNAME_LENGTH + 1];
'  LARGE_INTEGER          ConnectTime;
'  LARGE_INTEGER          DisconnectTime;
'  LARGE_INTEGER          LastInputTime;
'  LARGE_INTEGER          LogonTime;
'  LARGE_INTEGER          CurrentTime;
'} WTSINFOA, *PWTSINFOA;

Type WTSINFOA
    State As WTS_CONNECTSTATE
    SessionId As Long
    IncomingBytes As Long
    OutgoingBytes As Long
    IncomingFrames As Long
    OutgoingFrames As Long
    IncomingCompressedBytes As Long
    OutgoingCompressedBy As Long
    WinStationName As Long
    Domain As Long
    UserName As Long
    ConnectTime As LongPtr
    DisconnectTime As LongPtr
    LastInputTime As LongPtr
    LogonTime As LongPtr
    CurrentTime As LongPtr
End Type

Public Declare Function WTSOpenServerA Lib "Wtsapi32.dll" (ByVal pServerName As String) As Long

'****************************************************************************************************
'
'BOOL WTSEnumerateSessionsA(
'  IN HANDLE          hServer,
'  IN DWORD           Reserved,
'  IN DWORD           Version,
'  PWTS_SESSION_INFOA *ppSessionInfo,
'  DWORD              *pCount
');

Public Declare Function WTSEnumerateSessionsA Lib "Wtsapi32.dll" _
(ByVal lngServer As Long, _
 ByVal Reserved As Integer, _
 ByVal Version As Integer, _
 ppSessionInfo As Long, _
 pCount As Long) As Boolean
 
'****************************************************************************************************
'
'BOOL WTSQuerySessionInformationA(
'  IN HANDLE         hServer,
'  IN DWORD          SessionId,
'  IN WTS_INFO_CLASS WTSInfoClass,
'  LPSTR             *ppBuffer,
'  DWORD             *pBytesReturned
');

Public Declare Function WTSQuerySessionInformationA Lib "Wtsapi32.dll" _
(ByVal hServer As Long, _
 ByVal SessionId As Long, _
 ByVal WTSInfoClass As WTS_INFO_CLASS, _
 ppBuffer As Long, _
 pBytesReturned As Long) As Boolean

'****************************************************************************************************
 
Public Declare Sub WTSCloseServer Lib "Wtsapi32.dll" (ByVal hServer As Long)

Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
       (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Public Declare Sub WTSFreeMemory Lib "Wtsapi32.dll" (ByVal pMemory As Long)
       
Public Declare PtrSafe Function lstrlenA Lib "kernel32.dll" (ByVal lpString As LongPtr) As Long

 

Could you (or anyone) please answer me, even with an example, to those questions?

EDIT: Added a string test.

Spoiler

Sub TestString()

    Dim strTestString As String
    Dim ptrBSTR As Long
    Dim ptrString As Long
    Dim lngStringLenght As Long
    Dim arrBuffer() As Byte
    Dim strStringFromBufferANSI As String: strStringFromBufferANSI = ""
    Dim strStringFromBufferUNICODE As String: strStringFromBufferUNICODE = ""
    
    'Setting a test string
    strTestString = "This is a test string"
    
    'Pointer to the BSTR Data Type
    ptrBSTR = VarPtr(strTestString)
    
    'Pointer to the start of the string and the ending vbNull character
    ptrString = StrPtr(strTestString)
    
    'Lenght of the string directly from the string (In Bytes)
    CopyMemory lngStringLenght, ByVal ptrString - 4&, 4
    
    'ReDim of the Buffer array
    ReDim arrBuffer(lngStringLenght) As Byte
    
    'Copy the content of the string and the ending vbNull character
    CopyMemory arrBuffer(0&), ByVal ptrString, lngStringLenght
    
    'Creating the string in ANSI format (from the 0th element to the i - 2)    => 2 Bytes vbNull ?
    For i = 0 To UBound(arrBuffer) - 2 Step 1
        strStringFromBufferANSI = strStringFromBufferANSI & Chr(arrBuffer(i))
    Next
    
    'Creating the string in Unicode format (from the 0th element to the i - 1) => 1 Byte vbNull ?
    For i = 0 To UBound(arrBuffer) - 1 Step 2
        strStringFromBufferUNICODE = strStringFromBufferUNICODE & Chr(arrBuffer(i))
    Next
    
    'Output some information
    Debug.Print "The string is                      : " & strTestString & vbNewLine & _
                "The pointer to the BSTR is         : " & ptrBSTR & vbNewLine & _
                "The pointer to the string is       : " & ptrString & vbNewLine & _
                "The lenght of the string is        : " & lngStringLenght & " [Bytes]" & vbNewLine & _
                "The actual lenght of the string is : " & lngStringLenght / 2 & " [Characters]" & vbNewLine & _
                "The first Byte of the array is     : " & arrBuffer(0) & ", which is the character '" & Chr(arrBuffer(0)) & "'" & vbNewLine & _
                "The string from the buffer is      : '" & strStringFromBufferANSI & "' [ANSI]" & vbNewLine & _
                "The string from the buffer is      : '" & strStringFromBufferUNICODE & "' [UNICODE]"

End Sub

 

P.S.: To the reader:

Spoiler

I kindly ask you sorry if some question may be "absurd", and this is the reason why I am here asking you these questions :)

Thanks in advance :)

Edited by FrancescoDiMuro
Added string test

Click here to see my signature:

Spoiler

ALWAYS GOOD TO READ:

 

Link to post
Share on other sites

Hello. 

Quote

Since a string in VBA is a pointer to a BSTR data type, couldn't I get the length of the string returned by WTSQuerySessionInformationA taking the 4 Bytes data before the start of the string content?

yes You can get the length of a string from the BSTR structure But It's not the right/correct way. But using WTSQuerySessionInformationA you will get the length in lngBytes in bytes. So If you use WTSQuerySessionInformationW You will get lngBytes * 2

Quote

Then, when I ReDim the Bytes array, shouldn't I use the lenght of the string in characters * the number of Bytes of each character in a VB String (2 Bytes)?
Here too, the answer is "Practically no", but I tried to modify the above code to what "theory says", and the app crashes.
I am asking these questions just to "completely" understand what's going on when strings and pointers are used in VB.

 

It's correct you can use the lngBytes for redim and subtract 2,  (1 for NULL Char at the end of the string and the other because vba array bound starts from 0.) It's what lstrlenA does.

in your code you could do this instead using PointerToStringA.

Dim aByteArray() As Byte
ReDim aByteArray(lngBytes - 2)
CopyMemory aByteArray(0), ByVal lngBuffer, lngBytes - 1
Dim sStr As String
sStr = StrConv(aByteArray, vbUnicode)

 

Saludos

 

 

Link to post
Share on other sites
2 hours ago, Danyfirex said:

So If you use WTSQuerySessionInformationW You will get lngBytes * 2

Now it is much clearer.

I didn't know the difference between A (ANSI) and W (Wide Char or Unicode).

By default, I saw that VBA uses ANSI format for strings, so better to use all the functions and structures with the final "A" in order to don't have any problem of conversion from/to Unicode format.

Is it a Wise choice? :D

I'm gonna read some articles about ANSI and Unicode to understand the difference.

For the code you posted, I will try ASAP and let you know the results.

As always, thanks dear @Danyfirex :)

P.S.: your dog looks amazing!

Click here to see my signature:

Spoiler

ALWAYS GOOD TO READ:

 

Link to post
Share on other sites

Good morning :)
I just tested the WTSOpenServerW, and, even if it returns a Long variable, it doesn't work when used with WTSQuerySessionInformationW; I had to use 0& when calling WTSQuerySessionInformationW, but seems that it loads a little bit more then the *A functions (~1 second more).
The discussion about A and W is not very clear on these functions.
I have to study more, but, for now, I think that I'm going to use A functions and structures, even if they are stangely faster than then W ones.

Click here to see my signature:

Spoiler

ALWAYS GOOD TO READ:

 

Link to post
Share on other sites

The reason that You don't get working the Wide version is because You'll need to copy the Unicode string directly to your vba string. Like this way.

 

Dim sStr As String
sStr = String((lngBytes / 2) - 1, vbNullChar)
CopyMemory ByVal StrPtr(sStr), ByVal lngBuffer, lngBytes - 2

Saludos

Link to post
Share on other sites

@Danyfirex
Thanks for the reply as always.

The part that it's not working is the one with WTSQuerySessionInformationW() function, which is returning 0.
To get the handle of the Server, I used WTSOpenServerW, which takes a string as input, and it does return an handle, so, the problem seems to be (and practically too) with WTSQuerySessionInformationW() function.
I feel quite confident with Bytes array and CopyMemory for now.
Later I am going to test these functions in a big environment, and try to catch the LogonTime of the Session.
There are a lot of things that I'm learning right now, and I feel quite confused about all of these information, and even a bit struggled.
 

Click here to see my signature:

Spoiler

ALWAYS GOOD TO READ:

 

Link to post
Share on other sites

Hello. W API works correctly for me. Let me know your result when you do your tests.

 

Saludos

Link to post
Share on other sites

Hey @Danyfirex :)
I finally got the *W functions working.
The error was on the function WTSOpenServerW(), which takes as "in parameter" a pointer to a Wide String, and so, I had to convert the string parameter in Unicode:

Spoiler

Public Declare Function WTSOpenServerW Lib "Wtsapi32.dll" (ByVal pServerName As String) As Long

'Getting the Server Handle
lngServer = WTSOpenServerW(StrConv("MyPCName", vbUnicode))

 

But, this lead me to make another question...
Why did I have to convert the string in Unicode, if VBA handles the string in Unicode format natively?
Because I modified the StringFromPointerW() function like this:

Spoiler

Public Function StringFromPointerW(lngStringPointer As LongPtr) As String
    
    Dim byteTempBuffer() As Byte
    Dim lngBytesCount As Long
    
    lngBytesCount = lstrlenW(lngStringPointer)
    
    If lngBytesCount > 0 Then
        
        ReDim byteTempBuffer(0 To lngBytesCount * 2 - 1) As Byte
        
        CopyMemory VarPtr(byteTempBuffer(0&)), ByVal lngStringPointer, lngBytesCount * 2
        
        StringFromPointerW = byteTempBuffer
        
    End If
    
End Function

 

and you can see that I'm assigning the value of Byte array directly to the function return's value, so, how strings in VBA are handled?
Did you have to pass an Unicode string as parameter of WTSOpenServerW() in order to have it working, and how did you handle the obtainment of the value of the string from the pointer?
Thank you and have a good day :)

Best Regards.

Edited by FrancescoDiMuro

Click here to see my signature:

Spoiler

ALWAYS GOOD TO READ:

 

Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
  • Recently Browsing   0 members

    No registered users viewing this page.

  • Similar Content

    • By DevMode
      welcome
      I need help dealing with a C++ DLL
      Specify that I need help with how to use this function
      struct libusb_device; typedef struct libusb_context libusb_context; ssize_t LIBUSB_CALL libusb_get_device_list(libusb_context *ctx,libusb_device ***list); My problem is how to deal with "libusb_device ***list"
      my code 
      $libusb_device = DllStructCreate("PTR") Func libusb_init() $Var = DllCall($libusb0, "ptr", "libusb_init",'ptr',$_libusb_device_handle_Ptr) If @error Then Return False Return $Var[1] EndFunc Func libusb_get_device_list() MsgBox(0,VarGetType($_libusb_device_handle_Ptr),$_libusb_device_handle_Ptr) $Var = DllCall($libusb0, "int", "libusb_get_device_list","ptr",$_libusb_device_handle_Ptr,"ptr*",POINTER(POINTER($libusb_device))) $Error = @error If $Error Then Return False MsgBox(0,VarGetType($Var),$Error&@CRLF&$Var) _ArrayDisplay($Var) Return $Var[1] EndFunc  
      Thank you
      iLibUSB.dll iLibUSB_32.dll libusb.h
    • By bobflumox
      Hi all,
      My programming knowledge is very basic.
      I have an old script that creates shares and assign permissions. It normally registers SetAcl.ocx if necessary and creates an object to assign permissions.
      The command that registers SetAcl was apparently working fine under Windows 7 but is not working under Windows 10.
      RunWait("regsvr32.exe path\to\setacl.ocx /s", "", @SW_HIDE) As I'm logged in as admin, I changed this command to :
      RunAsWait(@UserName, "", "", 0, "regsvr32.exe path\to\setacl.ocx /s", "", @SW_HIDE) It seems to terminate correctly but the script still doesn't work as expected.
      To check that, I've created that small script :
      Local $objSetAcl = ObjCreate("SETACL.SetACLCtrl.1") If IsObj($objSetAcl) Then ConsoleWrite("Object successfully created." & @CRLF) Else ConsoleWrite("Object not created. Registering SetAcl.ocx" & @CRLF) Local $result = RunAsWait(@UserName, "", "", 0, "regsvr32.exe path\to\setacl.ocx /s", "", @SW_HIDE); Use of my admin username to elevate CMD ConsoleWrite("Return code : " & $result & @CRLF) ConsoleWrite("Creating object" & @CRLF) $objSetAcl = ObjCreate("SETACL.SetACLCtrl.1") If IsObj($objSetAcl) Then ConsoleWrite("Object successfully created." & @CRLF) Else ConsoleWrite("Object creation failed." & @CRLF) EndIf EndIf It tries to register SetAcl.ocx, return code 0 seems to be fine but still can't use SetAcl.
      But if I go to CMD as admin, run the regsvr32 command and restart my script, it can create the object without issue.
      I know my poor knowledge makes me miss something. Anyone can help me figure this out ?
    • By Page2PagePro
      Excel VBA's IDE registers a Control-y as "cut this line of code".
      For those prone to Undo/Redo (Ctrl+Z/Ctrl+Y) you may find frustration when your code in the editor does not redo, but in fact clears your active line of code while killing redo history.
      Though not perfect, I keep this tool running in background on startup.
      The purpose is to allow Cltr+Y to act normally throughout Windows and Office and only interact *differently* with the "Microsoft Visual Basic for Applications" window that is active.
      If the Standard Menu bar exists, it'll try to click the ReDo (Blue Arrow to the right), else "Alt+e, r" keystrokes (less desired).
       
      Here's the code:
      Opt('MustDeclareVars', 1) Opt("WinTitleMatchMode", 1) HotKeySet("^y", "TriggerRedo") While 1 Sleep(10) WEnd Func TriggerRedo() ConsoleWrite("TriggerRedo()" & @CRLF) Local $title = "Microsoft Visual Basic for Applications - " Local $hWnd If WinExists($title) And WinActive($title) Then ;~ Parent Window Handle $hWnd = WinGetHandle($title) Local $aWindowPos = WinGetPos($hWnd) ;~ Control Bar Handle, Position and If Visible Local $sControlID = "[CLASS:MsoCommandBar; TEXT:Standard;]" Local $hStandardBar = ControlGetHandle($hWnd, "", $sControlID) Local $bIsVisible = ControlCommand($hWnd, "", $sControlID, "IsVisible") If $hStandardBar And $bIsVisible Then ConsoleWrite("Using Mouse Click." & @CRLF) ;~ Determine Redo button location on visible Control Bar Local $aBarPos = ControlGetPos($hWnd, "", $sControlID) Local $mX = $aWindowPos[0] + $aBarPos[0] + 217 + Int(23/2) Local $mY = $aWindowPos[1] + $aBarPos[1] + 27 + Int(22/2) MouseClick("Left", $mX, $mY, 1, 0) Else ConsoleWrite("Using VBA Send Keys." & @CRLF) $sControlID = "[CLASS:MsoCommandBar; TEXT:Menu Bar;]" Local $hMenuBar = ControlGetHandle($hWnd, "", $sControlID) ControlSend($hWnd, "", $hMenuBar, "!e") ;~ Send("r") $sControlID = "[CLASS:MsoCommandBarPopup; TEXT:Edit;]" Local $hPopupBar = ControlGetHandle($hWnd, "", $sControlID) ControlSend($hWnd, "", $hPopupBar, "r") EndIf Else ConsoleWrite("Using NATIVE Send Keys." & @CRLF) HotKeySet("^y") Send("^y") ;~ may cause "yyy..." when held HotKeySet("^y", "TriggerRedo") EndIf EndFunc ;==>TriggerRedo Hope this inspires someone.
       
       
    • By Gowrisankar
      Dear members of the forum,
      I'm working on a project in which I have to use Image recognition technique. 
      Due to client restrictions, I couldn't use AutoIt for this project. 
      Is there a way to use this DLL "ImageSearchDLL.dll" (which is used to do image recognition steps in AutoIt) in VB.Net to achieve the same result? 
      I have used this DLL few years before and got good results. If there is a latest version of this DLL and if you can share it, that will be helpful too.
      Any guidance is deeply appreciated.
    • By Colduction
      Hi AutoIt Scripters/Programmers. I have a question about MIME Tools for Notepad++:
      I've recently found a UDF about Base64 in forum, but they can't decode\encode correctly some emojis , other UTFs and etc. so i decided to use mimeTools.dll of Notepad++ or main site
      My problem is how to use this dll in AutoIt Language?

      I will be happy with your comments and answers❤ Thanks.
×
×
  • Create New...