I work with a relay module that I normaly connect via USB. That all works perfectly. Now I would like to connect it via the network. All manufacturer's VB.NET code works in vba except for accessing this module over the network.
Public Declare PtrSafe Function DapiOpenModuleEx Lib "DELIB64" (ByVal moduleID As Long, ByVal nr As Long, ByRef exbuffer As DAPI_OPENMODULEEX_STRUCT, ByVal open_options As Long) As Long
' Definitions for DapiOpenEx
Public Type DAPI_OPENMODULEEX_STRUCT
address(255) As Byte
timeout As Long
portno As Long
encryption_type As Long
encryption_password(31) As Byte
End Type
'Open ETH-Module with parameter
Dim handle as Ulong
Dim MyModuleID As UInt32
MyModuleID = 42
Dim open_buffer As New DELib64.DAPI_OPENMODULEEX_STRUCT
open_buffer.address = System.String.Copy(192.168.1.1 As String) As String
open_buffer.portno = 0
handle = DELib.DapiOpenModuleEx(MyModuleID, 0, open_buffer)
I am getting an error "open_buffer.address = System.String.Copy(192.168.1.1 As String) As String "
Can someone help me with what i need to change here?
Dim handle as LongLong
Dim MyModuleID As Long
MyModuleID = 42
Dim open_buffer As Delib64.DAPI_OPENMODULEEX_STRUCT
open_buffer.address = system.String.Copy("192.168.1.1" AS String) As String
open_buffer.portno = 0
handle1 = DapiOpenModuleEx(MyModuleID, 0, open_buffer, 0)
According to your comment, the original line of code is
strcpy((char*) open_buffer.address, "192.168.1.10");
So you need to copy the ASCII (single-byte) string "192.168.1.10" into a VBA byte array. This is surprisingly hard, since the obvious approach of open_buffer.address = StrConv("192.168.1.10", vbFromUnicode) won't work (you can't assign to a fixed-size array that's part of a type).
One obvious solution would be to make a Windows API call to CopyMemory, but if we want a VBA-only solution, a simple loop should suffice:
Dim i As Long
Dim b() As Byte
b = StrConv("192.168.1.10", vbFromUnicode)
For i = 0 To UBound(b)
open_buffer.address(i) = b(i)
Next
open_buffer.address(UBound(b) + 1) = 0 ' C-strings need to be 0-terminated
(I do have the feeling that this should be easier, so I'll gladly upvote competing, simpler answers.)
I want to store and compare hashed passwords in VBA.
I've read How do I properly implement Unicode passwords?, but I have no clue about where to start.
How do I normalize a unicode string in VBA?
Preferably, I'd do this without downloading the ICU the linked post refers to, because I'd like my project not to be dependent on external code.
Windows provides a built-in for normalizing strings, the NormalizeString function. However, it can be a bit tricky to use.
Here is an implementation, based on the C example in the docs provided above:
'Declare the function
Public Declare PtrSafe Function NormalizeString Lib "Normaliz.dll" (ByVal NormForm As Byte, ByVal lpSrcString As LongPtr, ByVal cwSrcLength As Long, ByVal lpDstString As LongPtr, ByVal cwDstLength As Long) As Long
'And a relevant error code
Const ERROR_INSUFFICIENT_BUFFER = 122
'And a helper enum
Public Enum NORM_FORM
NormalizationC = &H1
NormalizationD = &H2
NormalizationKC = &H5
NormalizationKD = &H6
End Enum
'Available normalization forms can be found under https://learn.microsoft.com/en-us/windows/win32/api/winnls/ne-winnls-norm_form
'KD normalization is preferred(https://stackoverflow.com/a/16173329/7296893) when hashing characters
'If you already have hashes stored, C normalization is least likely to break them
Public Function UnicodeNormalizeString(str As String, Optional norm_form As Byte = NormalizationKD) As String
If Len(str) = 0 Then 'Zero-length strings can't be normalized
UnicodeNormalizeString = str
Exit Function
End If
Dim outlenestimate As Long
'Get an initial length estimate for the string
outlenestimate = NormalizeString(norm_form, StrPtr(str), Len(str), 0, 0)
Dim i As Long
'Try 10 times
For i = 1 To 10
'Initialize buffer
UnicodeNormalizeString = String(outlenestimate, vbNullChar)
'Get either the normalized string, or a new length estimate
outlenestimate = NormalizeString(norm_form, StrPtr(str), Len(str), StrPtr(UnicodeNormalizeString), outlenestimate)
If outlenestimate > 0 Then 'We got the normalized string
'Truncate off the unused characters
UnicodeNormalizeString = Left(UnicodeNormalizeString, outlenestimate)
Exit Function
Else
If Err.LastDllError <> ERROR_INSUFFICIENT_BUFFER Then
Exit For 'An unexpected error occurred
End If
outlenestimate = outlenestimate * -1 'Use the new length estimate, try again
End If
Next
Err.Raise 5000, Description:="Failure to normalize unicode string"
End Function
Once you have declared the normalization function, always run your password through it before hashing:
If SomeHashFun(UnicodeNormalizeString(MyPassword)) = SomeHashedPassword Then
'We are in!
End If
I have a little class that can uncompress a byte array with zlib. Here it is :
<Runtime.InteropServices.DllImport("zlib1.DLL", CallingConvention:=Runtime.InteropServices.CallingConvention.Cdecl, EntryPoint:="compress2", charset:=Runtime.InteropServices.CharSet.Auto)> _
Private Shared Function CompressByteArray2(ByVal dest As Byte(), ByRef destLen As Integer, ByVal src As Byte(), ByVal srcLen As Integer, ByVal level As Integer) As Integer
End Function
Public Shared Function DeCompressBytes(ByVal Bytes() As Byte) As Byte()
Dim OrigSize As Integer = BitConverter.ToUInt32(Bytes, 0)
Dim Data(Bytes.Length - 5) As Byte
Array.Copy(Bytes, 4, Data, 0, Bytes.Length - 4)
Dim DLLfunctionResult As Integer
Dim bResult(CInt(OrigSize + (OrigSize * 0.01) + 12)) As Byte
DLLfunctionResult = UncompressByteArray(bResult, OrigSize, Data, Data.Length)
If DLLfunctionResult = 0 Then
ReDim Preserve bResult(OrigSize - 1)
Return bResult
Else
Return Bytes
End If
End Function
It Works, no problem.
I would like to know if it's possible to uncompress from a stream instead of a byte array. Because right now, I have to read the stream and put it in a variable, then uncompress it and put the new result in a variable. The purpose is to accelerate the process. Maybe it will not do that, but I would still like to know about
(French here, sorry for my english)
I am working in Access 2013 and try to get GetRawInputDeviceList, GetRawInputDeviceInfo, RegisterRawInputDevices and GetRawInputData equivalents for VBA with no success. I have also searched in vain for a procedure, function or module to get a list of connected HID devices to a computer to pick out a barcode scanner. This is the beginning of the third week so I am on my knees begging for assistance. Do any of you all have a module you're willing to share, a link to a website where this is dealt with? Any help is greatly appreciated.
Using the GetRawInputDeviceList API from VBA would be pretty tricky because of the pRawInputDeviceList parameter. Unless you're willing to jump through a ton of hoops to manage your own memory and manually handle the resulting array of RAWINPUTDEVICELIST in raw memory, you'll be better off coming at this from another direction.
Most barcode scanners I've dealt with present themselves to Windows as a keyboard. One possible solution would be to use a WMI query to enumerate attached Win32_Keyboard devices:
Private Sub ShowKeyboardInfo()
Dim WmiServer As Object
Dim ResultSet As Object
Dim Keyboard As Object
Dim Query As String
Query = "SELECT * From Win32_Keyboard"
Set WmiServer = GetObject("winmgmts:root/CIMV2")
Set ResultSet = WmiServer.ExecQuery(Query)
For Each Keyboard In ResultSet
Debug.Print Keyboard.Name & vbTab & _
Keyboard.Description & vbTab & _
Keyboard.DeviceID & vbTab & _
Keyboard.Status
Next Keyboard
End Sub
Note: If it doesn't turn up there, you can enumerate all of the USB devices by querying CIM_USBDevice: Query = "SELECT * From Win32_Keyboard"
EDIT: Per the comments, the above code won't return the handle needed to register to receive raw input events. This should get you started though - the RegisterRawInputDevices and GetRawInputData aspects are beyond the scope of what will easily go in an answer. Take a hack at it, and if you run into any problems post your code in another question.
Declarations:
Private Type RawInputDeviceList
hDevice As Long
dwType As Long
End Type
Private Type RidKeyboardInfo
cbSize As Long
dwType As Long
dwKeyboardMode As Long
dwNumberOfFunctionKeys As Long
dwNumberOfIndicators As Long
dwNumberOfKeysTotal As Long
End Type
Private Enum DeviceType
TypeMouse = 0
TypeKeyboard = 1
TypeHID = 2
End Enum
Private Enum DeviceCommand
DeviceName = &H20000007
DeviceInfo = &H2000000B
PreParseData = &H20000005
End Enum
Private Declare Function GetRawInputDeviceList Lib "user32" ( _
ByVal pRawInputDeviceList As Long, _
ByRef puiNumDevices As Long, _
ByVal cbSize As Long) As Long
Private Declare Function GetRawInputDeviceInfo Lib "user32" Alias "GetRawInputDeviceInfoW" ( _
ByVal hDevice As Long, _
ByVal uiCommand As Long, _
ByVal pData As Long, _
ByRef pcbSize As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Sample of retrieving device names with GetRawInputDeviceInfo:
Private Sub SampleCode()
Dim devices() As RawInputDeviceList
devices = GetRawInputDevices
Dim i As Long
For i = 0 To UBound(devices)
'Inspect the type - only looking for a keyboard.
If devices(i).dwType = TypeKeyboard Then
Dim buffer As String
Dim size As Long
'First call with a null pointer returns the string length in size.
If GetRawInputDeviceInfo(devices(i).hDevice, DeviceName, 0&, size) = -1 Then
Debug.Print "GetRawInputDeviceInfo error " & GetLastError()
Else
'Size the string buffer.
buffer = String(size, Chr$(0))
'The second call copies the name into the passed buffer.
If GetRawInputDeviceInfo(devices(i).hDevice, DeviceName, StrPtr(buffer), size) = -1 Then
Debug.Print "GetRawInputDeviceInfo error " & GetLastError()
Else
Debug.Print buffer
End If
End If
End If
Next i
End Sub
Private Function GetRawInputDevices() As RawInputDeviceList()
Dim devs As Long
Dim output() As RawInputDeviceList
'First call with a null pointer returns the number of devices in devs
If GetRawInputDeviceList(0&, devs, LenB(output(0))) = -1 Then
Debug.Print "GetRawInputDeviceList error " & GetLastError()
Else
'Size the output array.
ReDim output(devs - 1)
'Second call actually fills the array.
If GetRawInputDeviceList(VarPtr(output(0)), devs, LenB(output(0))) = -1 Then
Debug.Print "GetRawInputDeviceList error " & GetLastError()
Else
GetRawInputDevices = output
End If
End If
End Function
Sorry about the side scrolling.
I have an array (that comes from SQL) and can potentially have one or more rows.
I want to be able to figure out if the array has just one row.
UBound doesn't seem to be helpful. For 2-dimensional arrays UBound(A,1) and UBound(A,2) returns the number of rows and columns respectively, but when the array has only one row, UBound(A,1) returns the number of columns and UBound(A,2) returns a <Subscript out of range>.
I have also seen this Microsoft help page for determining the number of dimensions in an array. It is a very horrifying solution that involves using the error handler.
How can I determine whether the array has just one row (hopefully without using the error handler)?
If you REALLY want to avoid using On Error, you can use knowledge of the SAFEARRAY and VARIANT structures used to store arrays under the covers to extract the dimension information from where it's actually stored in memory. Place the following in a module called mdlSAFEARRAY
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Integer)
Private Type SAFEARRAY
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
End Type
Private Type ARRAY_VARIANT
vt As Integer
wReserved1 As Integer
wReserved2 As Integer
wReserved3 As Integer
lpSAFEARRAY As Long
data(4) As Byte
End Type
Private Enum tagVARENUM
VT_EMPTY = &H0
VT_NULL
VT_I2
VT_I4
VT_R4
VT_R8
VT_CY
VT_DATE
VT_BSTR
VT_DISPATCH
VT_ERROR
VT_BOOL
VT_VARIANT
VT_UNKNOWN
VT_DECIMAL
VT_I1 = &H10
VT_UI1
VT_UI2
VT_I8
VT_UI8
VT_INT
VT_VOID
VT_HRESULT
VT_PTR
VT_SAFEARRAY
VT_CARRAY
VT_USERDEFINED
VT_LPSTR
VT_LPWSTR
VT_RECORD = &H24
VT_INT_PTR
VT_UINT_PTR
VT_ARRAY = &H2000
VT_BYREF = &H4000
End Enum
Public Function GetDims(VarSafeArray As Variant) As Integer
Dim varArray As ARRAY_VARIANT
Dim lpSAFEARRAY As Long
Dim sArr As SAFEARRAY
CopyMemory VarPtr(varArray.vt), VarPtr(VarSafeArray), 16&
If varArray.vt And (tagVARENUM.VT_ARRAY Or tagVARENUM.VT_BYREF) Then
CopyMemory VarPtr(lpSAFEARRAY), varArray.lpSAFEARRAY, 4&
If Not lpSAFEARRAY = 0 Then
CopyMemory VarPtr(sArr), lpSAFEARRAY, LenB(sArr)
GetDims = sArr.cDims
Else
GetDims = 0 'The array is uninitialized
End If
Else
GetDims = 0 'Not an array - might want an error instead
End If
End Function
Here is a quick test function to show usage:
Public Sub testdims()
Dim anotherarr(1, 2, 3) As Byte
Dim myarr() As Long
Dim strArr() As String
ReDim myarr(9)
ReDim strArr(12)
Debug.Print GetDims(myarr)
Debug.Print GetDims(anotherarr)
Debug.Print GetDims(strArr)
End Sub
I know you want to avoid using the error handler, but if it's good enough for Chip Pearson, it's good enough for me. This code (as well as a number of other very helpful array functions) can be found on his site:
http://www.cpearson.com/excel/vbaarrays.htm
Create a custom function:
Function IsArrayOneDimensional(arr as Variant) As Boolean
IsArrayOneDimensional = (NumberOfArrayDimensions(arr) = 1)
End Function
Which calls Chip's function:
Public Function NumberOfArrayDimensions(arr As Variant) As Integer
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' NumberOfArrayDimensions
' This function returns the number of dimensions of an array. An unallocated dynamic array
' has 0 dimensions. This condition can also be tested with IsArrayEmpty.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Ndx As Integer
Dim Res As Integer
On Error Resume Next
' Loop, increasing the dimension index Ndx, until an error occurs.
' An error will occur when Ndx exceeds the number of dimension
' in the array. Return Ndx - 1.
Do
Ndx = Ndx + 1
Res = UBound(arr, Ndx)
Loop Until Err.Number <> 0
Err.Clear
NumberOfArrayDimensions = Ndx - 1
End Function
I realized that my original answer can be simplified - rather than having the VARIANT and SAFEARRAY structures defined as VBA Types, all that is needed is a few CopyMemorys to get the pointers and finally the Integer result.
UPDATE: This version should work on both 32 bit and 64 bit systems (original preserved below the break for posterity):
Option Explicit
Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As LongPtr, ByVal Source As LongPtr, ByVal Length As Integer)
Public Function GetDims(VarSafeArray As Variant) As Integer
Dim variantType As Integer
Dim pointer As LongPtr
Dim arrayDims As Integer
CopyMemory VarPtr(variantType), VarPtr(VarSafeArray), 2& 'the first 2 bytes of the VARIANT structure contain the type
If (variantType And &H2000) > 0 Then 'Array (&H2000)
'If the Variant contains an array or ByRef array, a pointer for the SAFEARRAY or array ByRef variant is located at VarPtr(VarSafeArray) + 8
CopyMemory VarPtr(pointer), VarPtr(VarSafeArray) + 8, LenB(pointer)
'If the array is ByRef, there is an additional layer of indirection through another Variant (this is what allows ByRef calls to modify the calling scope).
'Thus it must be dereferenced to get the SAFEARRAY structure
If (variantType And &H4000) > 0 Then 'ByRef (&H4000)
'dereference the pointer to pointer to get the actual pointer to the SAFEARRAY
CopyMemory VarPtr(pointer), pointer, LenB(pointer)
End If
'The pointer will be 0 if the array hasn't been initialized
If Not pointer = 0 Then
'If it HAS been initialized, we can pull the number of dimensions directly from the pointer, since it's the first member in the SAFEARRAY struct
CopyMemory VarPtr(arrayDims), pointer, 2&
GetDims = arrayDims
Else
GetDims = 0 'Array not initialized
End If
Else
GetDims = 0 'It's not an array... Type mismatch maybe?
End If
End Function
Here is the simplest complete GetDims that checks the dimensions directly through the variables in memory:
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Integer)
Public Function GetDims(VarSafeArray As Variant) As Integer
Dim variantType As Integer
Dim pointer As Long
Dim arrayDims As Integer
CopyMemory VarPtr(variantType), VarPtr(VarSafeArray), 2& 'the first 2 bytes of the VARIANT structure contain the type
If (variantType And &H2000) > 0 Then 'Array (&H2000)
'If the Variant contains an array or ByRef array, a pointer for the SAFEARRAY or array ByRef variant is located at VarPtr(VarSafeArray) + 8
CopyMemory VarPtr(pointer), VarPtr(VarSafeArray) + 8, 4&
'If the array is ByRef, there is an additional layer of indirection through another Variant (this is what allows ByRef calls to modify the calling scope).
'Thus it must be dereferenced to get the SAFEARRAY structure
If (variantType And &H4000) > 0 Then 'ByRef (&H4000)
'dereference the pointer to pointer to get the actual pointer to the SAFEARRAY
CopyMemory VarPtr(pointer), pointer, 4&
End If
'The pointer will be 0 if the array hasn't been initialized
If Not pointer = 0 Then
'If it HAS been initialized, we can pull the number of dimensions directly from the pointer, since it's the first member in the SAFEARRAY struct
CopyMemory VarPtr(arrayDims), pointer, 2&
GetDims = arrayDims
Else
GetDims = 0 'Array not initialized
End If
Else
GetDims = 0 'It's not an array... Type mismatch maybe?
End If
End Function
For a 2D array (or more dimensions), use this function:
Function is2d(a As Variant) As Boolean
Dim l As Long
On Error Resume Next
l = LBound(a, 2)
is2d = Err = 0
End Function
which gives :
Sub test()
Dim d1(2) As Integer, d2(2, 2) As Integer,d3(2, 2, 2) As Integer
Dim b1, b2, b3 As Boolean
b1 = is2d(d1) ' False
b2 = is2d(d2) ' True
b3 = is2d(d3) ' True
Stop
End Sub
I found Blackhawks's accepted and revised answer very instructive, so I played around with it and learned some useful things from it. Here's a slightly modified version of that code that includes a test sub at the bottom.
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
ByVal Destination As Long, ByVal Source As Long, ByVal Length As Integer)
Public Function GetDims(VarSafeArray As Variant) As Integer
Dim variantType As Integer
Dim pointer As Long
Dim arrayDims As Integer
'The first 2 bytes of the VARIANT structure contain the type:
CopyMemory VarPtr(variantType), VarPtr(VarSafeArray), 2&
If Not (variantType And &H2000) > 0 Then
'It's not an array. Raise type mismatch.
Err.Raise (13)
End If
'If the Variant contains an array or ByRef array, a pointer for the _
SAFEARRAY or array ByRef variant is located at VarPtr(VarSafeArray) + 8:
CopyMemory VarPtr(pointer), VarPtr(VarSafeArray) + 8, 4&
'If the array is ByRef, there is an additional layer of indirection through_
'another Variant (this is what allows ByRef calls to modify the calling scope).
'Thus it must be dereferenced to get the SAFEARRAY structure:
If (variantType And &H4000) > 0 Then 'ByRef (&H4000)
'dereference the pointer to pointer to get actual pointer to the SAFEARRAY
CopyMemory VarPtr(pointer), pointer, 4&
End If
'The pointer will be 0 if the array hasn't been initialized
If Not pointer = 0 Then
'If it HAS been initialized, we can pull the number of dimensions directly _
from the pointer, since it's the first member in the SAFEARRAY struct:
CopyMemory VarPtr(arrayDims), pointer, 2&
GetDims = arrayDims
Else
GetDims = 0 'Array not initialized
End If
End Function
Sub TestGetDims()
' Tests GetDims(). Should produce the following output to Immediate Window:
'
' 1 One
' 2 Two
' Number of array dimensions: 2
Dim myArray(2, 2) As Variant
Dim iResult As Integer
myArray(0, 0) = 1
myArray(1, 0) = "One"
myArray(0, 1) = 2
myArray(1, 1) = "Two"
Debug.Print myArray(0, 0), myArray(1, 0)
Debug.Print myArray(0, 1), myArray(1, 1)
iResult = GetDims(myArray)
Debug.Print "Number of array dimensions: " & iResult
End Sub
Identify 1-row arrays without Error handling or API functions
"I want to be able to figure out if the array has just one row."
To solve OP's requirement focussing on arrays already dimensioned as 1- and 2-dim arrays,
it isn't necessary to determine the array's actual dimension, it suffices
to get the number of its "rows".
So I came across the following surprisingly simple solution considering the following:
It's possible to slice 1-dim or 2-dim arrays to isolate their first "column" via
Application.Index(arr, 0, 1).
An eventual UBound now will show the correct number of rows,
especially for the asked one-row case.
Function UBndOne(arr) As Long
'Purp: get rows count of (array) input
'Note: returns 1 as the function result for
' a) one-dimensional arrays
' b) 2-dim arrays with only one row
' UBound(arr,1) isn't helpful for 1-dim array as it would return the number of elements
UBndOne = UBound(Application.Index(arr, 0, 1))
End Function
Side note: The combined code UBound(Application.Index(arr, 0, 1)) could be applied even upon other data types than arrays, returning as well 1 as function result.