Skip to content

Instantly share code, notes, and snippets.

@jeff123wang
Created April 17, 2022 14:07
Show Gist options
  • Save jeff123wang/a08e9a920c3e3ad298955fcb3da2f140 to your computer and use it in GitHub Desktop.
Save jeff123wang/a08e9a920c3e3ad298955fcb3da2f140 to your computer and use it in GitHub Desktop.
another example load C_C++ dll from memory.
Private Declare PtrSafe Function MemoryLoadLibrary Lib "MemoryModule.dll" _
(lpBytes As Byte, ByVal nCount As Long) As LongPtr
Private Declare PtrSafe Function MemoryGetProcAddress Lib "MemoryModule.dll" _
(ByVal hModule As LongPtr, ByVal lpProcName As String) As LongPtr
Private Declare PtrSafe Sub MemoryFreeLibrary Lib "MemoryModule.dll" _
(ByVal hLibModule As Long)
Private Declare PtrSafe Function SetDllDirectoryA Lib "kernel32" _
(ByVal lpPathName As String) As Boolean
Private Declare PtrSafe Function DispCallFunc Lib "oleaut32" _
(ByVal pvInstance As Long, _
ByVal offsetinVft As LongPtr, _
ByVal CallConv As Long, _
ByVal retTYP As Integer, _
ByVal paCNT As Long, _
ByRef paTypes As Integer, _
ByRef paValues As LongPtr, _
ByRef retVAR As Variant) As Long
Const CC_STDCALL = 4
Sub test()
Dim dllBytes() As Byte
Dim dllPointer As LongPtr
Dim addNumber As LongPtr
dllBytes = readLibrary(ThisWorkbook.path & "\test.dll")
SetDllDirectoryA (ThisWorkbook.path)
dllPointer = MemoryLoadLibrary(dllBytes(0), UBound(dllBytes) + 1)
addNumber = MemoryGetProcAddress(dllPointer, "add")
Debug.Print CallCDeclW(addNumber, vbInteger, 4, 2)
MemoryFreeLibrary dllPointers
End Sub
Function readLibrary(path As String) As Byte()
Dim f As Long
Dim b() As Byte
f = FreeFile
Open path For Binary As f
ReDim b(LOF(f))
Get f, , b()
Close f
readLibrary = b
End Function
'https://github.com/tannerhelland/VB6-Compression/blob/master/pdCompressLz4.cls
'DispCallFunc wrapper originally by Olaf Schmidt, with a few minor modifications; see the top of this class
'for a link to his original, unmodified version
Private Function CallCDeclW(ByVal lProc As LongPtr, ByVal fRetType As VbVarType, ParamArray pA() As Variant)
Dim i As Long, pFunc As Long, vTemp() As Variant, hResult As Long
Dim m_vType(0 To 63) As Integer, m_vPtr(0 To 63) As LongPtr
Dim numParams As Long
If (UBound(pA) < LBound(pA)) Then numParams = 0 Else numParams = UBound(pA) + 1
vTemp = pA 'make a copy of the params, to prevent problems with VT_Byref-Members in the ParamArray
For i = 0 To numParams - 1
If VarType(pA(i)) = vbString Then vTemp(i) = StrPtr(pA(i))
m_vType(i) = VarType(vTemp(i))
m_vPtr(i) = VarPtr(vTemp(i))
Next i
' 4 i standard call
hResult = DispCallFunc(0, lProc, CLng(4), fRetType, i, m_vType(0), m_vPtr(0), CallCDeclW)
If hResult Then Err.Raise hResult
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment