模块已经加载但找不到入口点(模块buddha.dll加载失败)

2023-12-27 10:15 星期三 107点热度 0人点赞

模块已经加载但找不到入口点(模块buddha.dll加载失败)插图

总共就两个部分,第一部分说几个声明API并使用的技巧,第二部分简单讲一下怎么动态调用DLL

玩API的人看到前面的描述肯定会心里MMP,废话少说,看内容。

1、相对路径声明

这个最好理解

普通的API声明长这样:

Declare Function LZ4_versionNumber Lib "liblz4" Alias "_LZ4_versionNumber@0" () As Long

下面是其FullPath版本的声明:

Declare Function LZ4_versionNumber Lib "c:\liblz4.dll" Alias "_LZ4_versionNumber@0" () As Long

下面是其相对路径版本的声明:

Declare Function LZ4_versionNumber Lib "..\Plugins\liblz4" Alias "_LZ4_versionNumber@0" () As Long

这特么怎么这么复杂呢,这三种都可以?下面也就简单一解释,不做深入研究,各位看官也就看看就好,能记住就记住。

先说FullPath版本,这是最低级的使用方法,一般人不会这么用;还有一种方法也可以指定FullPath,那就是使用manifest,manifest是个好东西,这个以后再扒。

然后是普通的API和相对路径的API,这俩其实是一个原理:

对于VB6,怎么检索DLL呢,当然是先检索App.Path(1、不检索子目录;2、VBA里对应Application.Path)

然后再检索环境变量目录

很多人不知道怎么看环境变量,Win+R,cmd,输入set,enter,就看到了所有环境变量

上述DLL静态声明,会在当前目录和所有环境变量目录,以相对路径检索DLL(如果多个路径都检索到,这个要应用检索规则,这里也不扒了)

假设环境变量中有一个路径:c:\xxx

那么API中的”..\Plugins\liblz4″和”liblz4″,就分别对应了路径:

“c:\xxx\..\Plugins\liblz4.dll”和”c:\xxx\liblz4.dll”

上面”..”的意思是指上一级目录,也即

“c:\xxx\..\Plugins\liblz4.dll” = “c:\Plugins\liblz4.dll”

2、动态路径

先说怎么用,声明就跟普通声明方式一样:

Declare Function LZ4_versionNumber Lib "liblz4" Alias "_LZ4_versionNumber@0" () As Long

但是,如果这时候在环境变量目录下都没有这个dll的话

在使用这个dll之前,我们可以用LoadLibrary这个API来加载一下dll,就可以调用”LZ4_versionNumber”了

Declare声明函数时,是声明函数指针,并指明入口点,VB6会通过内部函数DllFunctionCall(该函数会调用LoadLibraryA)来调用外部API

如果Declare时,在所有路径都找不到DLL,而这时候,你主动使用LoadLibrary加载了该DLL

这时候,就解决了加载DLL的问题,相当于运行时重定向DLL

3、修改环境变量

VB6程序在加载时,会优先加载App.Path

然后会加载进程环境变量,进程环境变量

这里相关的API有5个,这里用到的就前2个:

Declare Function GetEnvironmentVariableA Lib "kernel32" (ByVal lpName As String, ByVal lpBuffer As String, ByVal nSize As Long) As Long 单个获取进程环境变量

Declare Function SetEnvironmentVariableA Lib "kernel32" (ByVal lpName As String, ByVal lpValue As String) As Long 单个设置进程环境变量

Declare Function GetEnvironmentStringsA Lib "kernel32" () As Long 获取当前进程所有环境变量

Public Declare Function SetEnvironmentStringsA Lib "kernel32" (ByVal lpszEnvironmentBlock As Long) As Long 设置当前进程所有环境变量

Public Declare Function FreeEnvironmentStringsA Lib "kernel32" (ByVal lpszEnvironmentBlock As Long) As Long 清理临时指针

然后加环境变量就是这样操作:

Dim lngRet As Long

Dim strDest As String

Dim arr() As String, i As Long

Dim boolIn As Boolean 路径是否在环境变量中

Const MAX_BUFFER = 9000&

strDest = String$(MAX_BUFFER, Chr(0))

GetEnvironmentVariableA "Path", strDest, MAX_BUFFER + 1 获取当前进程的Path环境变量

lngRet = InStr(strDest, Chr(0))

strDest = Left(strDest, lngRet - 1) 清掉缓存字符

arr = Split(strDest, ";") 判断路径是否已经在环境变量中

For i = LBound(arr) To UBound(arr)

If arr(i) = strMatch Then

boolIn = True

Exit For

End If

Next i

If boolIn = False Then

SetEnvironmentVariableA "Path", strDllPath & ";" & strDest 设置当前进程的Path环境变量,加在最前面

End If

这样设置之后,检测DLL的时候,就多了一个自定义设置的strDllPath路径了

以下内容多且复杂,初学者直接跳过,由于这里对外链卡得比较严,我就只敢贴代码。

所以,需要探讨的,在评论里交流

很多时候,开发者不想写那么多Declare,就论这个问题,其实有两个解决方案。

一个是使用tlb,现在有很多包含win32api的tlb文件,tlb文件制作简单,在编写代码时引用到工程里,发布程序时不需要附带tlb文件

还有一种方案就是动态调用:

说起来方法其实很简单

第1步:LoadLibrary,加载DLL模块到内存

第2步:GetProcAddress,获取DLL里的API函数指针

第3步:CallWindowProc或者DispCallFunc,调用函数

第4步:FreeLibrary,用完了释放函数

但是如果真的要自己去研究,而且要支持多种调用约定的话,就比较麻烦了。

像CallWindowProc,在不写汇编代码的情况下,只能支撑有4个参数的API

这里当然不会讲怎么写汇编代码,所以这里推荐几个已有的轮子:

不用知其所以然,只用知道怎么用就好。

第1个:DispCallFunc方案

vbforums论坛高人Lavolpe写的类cUniversalDLLCalls.cls,理论上支持9种调用约定

‘ for documentation on the main API DispCallFunc… http://msdn.microsoft.com/en-us/library/windows/desktop/ms221473%28v=vs.85%29.aspx

Private Declare Function DispCallFunc Lib “oleaut32.dll” (ByVal pvInstance As Long, ByVal offsetinVft As Long, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As Long, ByRef retVAR As Variant) As Long

Private Declare Function GetModuleHandle Lib “kernel32.dll” Alias “GetModuleHandleA” (ByVal lpModuleName As String) As Long

Private Declare Function GetProcAddress Lib “kernel32.dll” (ByVal hModule As Long, ByVal lpProcName As String) As Long

Private Declare Function LoadLibrary Lib “kernel32.dll” Alias “LoadLibraryA” (ByVal lpLibFileName As String) As Long

Private Declare Function FreeLibrary Lib “kernel32.dll” (ByVal hLibModule As Long) As Long

Private Declare Sub CopyMemory Lib “kernel32.dll” Alias “RtlMoveMemory” (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Declare Sub FillMemory Lib “kernel32.dll” Alias “RtlFillMemory” (ByRef Destination As Any, ByVal Length As Long, ByVal Fill As Byte)

Private Declare Sub SetLastError Lib “kernel32.dll” (ByVal dwErrCode As Long)

Private Declare Function lstrlenA Lib “kernel32.dll” (ByVal lpString As Long) As Long

Private Declare Function lstrlenW Lib “kernel32.dll” (ByVal lpString As Long) As Long

‘ APIs used for _CDecl callback workarounds. See ThunkFor_CDeclCallbackToVB & ThunkRelease_CDECL

Private Declare Function VirtualAlloc Lib “kernel32” (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long

Private Declare Function VirtualFree Lib “kernel32” (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long

Public Enum CALLINGCONVENTION_ENUM

‘ http://msdn.microsoft.com/en-us/library/system.runtime.interopservices.comtypes.callconv%28v=vs.110%29.aspx

CC_FASTCALL = 0&

CC_CDECL

CC_PASCAL

CC_MACPASCAL

CC_STDCALL ‘ typical windows APIs

CC_FPFASTCALL

CC_SYSCALL

CC_MPWCDECL

CC_MPWPASCAL

End Enum

Public Enum CALLRETURNTUYPE_ENUM

CR_None = vbEmpty

CR_LONG = vbLong

CR_BYTE = vbByte

CR_INTEGER = vbInteger

CR_SINGLE = vbSingle

CR_DOUBLE = vbDouble

CR_CURRENCY = vbCurrency

‘ if the value you need isn’t in above list, you can pass the value manually to the

‘ CallFunction_DLL method below. For additional values, see:

‘ http://msdn.microsoft.com/en-us/library/cc237865.aspx

End Enum

Public Enum STRINGPARAMS_ENUM

STR_NONE = 0&

STR_ANSI

STR_UNICODE

End Enum

Private m_DLLname As String ‘ track last DLL loaded by this class

Private m_Mod As Long ‘ reference to loaded module

Private m_Release As Boolean ‘ whether or not we unload the module/dll

Public Function CallFunction_DLL(ByVal LibName As String, ByVal FunctionName As String, _

ByVal HasStringParams As STRINGPARAMS_ENUM, _

ByVal FunctionReturnType As CALLRETURNTUYPE_ENUM, _

ByVal CallConvention As CALLINGCONVENTION_ENUM, _

ParamArray FunctionParameters() As Variant) As Variant

‘ Used to call standard dlls, not active-x or COM objects

‘ Return value. Will be a variant containing a value of FunctionReturnType

‘ If this method fails, the return value will always be Empty. This can be verified by checking

‘ the Err.LastDLLError value. It will be non-zero if the function failed else zero.

‘ If the method succeeds, there is no guarantee that the function you called succeeded. The

‘ success/failure of that function would be indicated by this method’s return value.

‘ If calling a sub vs function & this method succeeds, the return value will be zero.

‘ Summarizing: if method fails to execute, Err.LastDLLError value will be non-zero

‘ If method executes ok, return value is from the DLL you called

‘ Parameters:

‘ LibName. The dll name. You should always include the extension else DLL is used

‘ See LoadLibrary documentation for more: http://msdn.microsoft.com/en-us/library/windows/desktop/ms684175%28v=vs.85%29.aspx

‘ FunctionName. The DLL function to call. This is case-senstiive

‘ To call a function by ordinal, prefix it with a hash symbol, i.e., #124

‘ HasStringParams. Provide one of the 3 available values

‘ STR_NONE. No parameters are strings or all strings are passed via StrPtr()

‘ STR_UNICODE. Any passed string values are for a Unicode function, i.e., SetWindowTextW

‘ STR_ANSI. Any passed string values are for an ANSI function, i.e., SetWindowTextA

‘ Important: If you pass one of FunctionParameters a String variable, you must include

‘ STR_UNICODE or STR_ANSI depending on what version function you are calling

‘ See the FunctionParameters section below for more

‘ FunctionReturnType. Describes what variant type the called function returns

‘ If calling a subroutine that does not return a value, use CR_None

‘ CallConvention. One of various DLL calling conventions

‘ You must know the calling convention of the function you are calling and the number

‘ of parameters, along with the parameter variable type

‘ FunctionParameters. The values and variant type for each value as required by the function

‘ you are calling. This is important. Passing incorrect variable types can cause crashes.

‘ There is no auto-conversion like VB would do for you if you were to call an API function.

‘ To ensure you pass the correct variable type, use VBs conversion routines:

‘ Passing a Long? CLng(10), CLng(x). Passing an Integer? CInt(10), CInt(x)

‘ Special cases:

‘ UDTs (structures). Pass these using VarPtr(), i.e., VarPtr(uRect)

‘ If UDT members contain static size strings, you should declare those string members

‘ as Byte arrays instead. When array is filled in by the function you called,

‘ you can use StrConv() to convert array to string.

‘ If UDT members contain dynamic size strings, you should declare those as Long.

‘ When the function returns, you can use built-in functions within this class to

‘ retrieve the string from the pointer provided to your UDT.

‘ Arrays. DO NOT pass the array. Pass only a pointer to the first member of the array,

‘ i.e., VarPtr(myArray(0)), VarPtr(myArray(0,0)), etc

‘ Strings for ANSI functions.

‘ 1) Passing by variable name or value? i.e., strContent, “Edit”, etc

‘ The string needs to be converted to ANSI, and this class will do that for you

‘ if you also pass HasStringParams as STR_ANSI. Otherwise, do NOT pass strings

‘ for ANSI functions by variable name or value. When passed by variable name,

‘ the variable contents are changed to 1 byte per character. To prevent this,

‘ pass the variable name inside parentheses, i.e., (myVariable)

‘ 2) Passing by StrPtr()? i.e, StrPtr(strContent), StrPtr(“Edit”)

‘ If the function you are calling needs the string contents, then do NOT pass

‘ the string this way. You must first convert it to ANSI. Else, you could

‘ pass it as desribed in #1 above.

‘ Rule-of-Thumb. If string is just a buffer, pass it by StrPtr(), then on return,

‘ use VB’s StrConv() to convert it from ANSI to unicode. Otherwise, pass the

‘ string by variable name or value

‘ Strings for Unicode functions

‘ 1) Passing by variable name or value? i.e., strContent, “Edit”, etc

‘ Internally, the string must be passed to the function ByVal via StrPtr().

‘ This class will do that, but it is faster (less code) if you pass all strings

‘ for unicode functions via StrPtr()

‘ 2) Passing by StrPtr()? i.e, StrPtr(strContent), StrPtr(“Edit”)

‘ Less code required, fastest method, no conversions required at all

‘ Rule-of-Thumb. All strings for unicode functions should be passed via StrPtr()

‘ Numeric values vs. variables. Be aware of the variable type of the number you pass.

‘ Depending on the value of the number, it may be Integer, Long, Double, etc.

‘ Numbers in range -32768 to 32767 are Integer, from -2147483648 to 2147483647 are Long

‘ Fractional/decimal numbers are Double

‘ If function parameter expects Long, don’t pass just 5, pass 5& or CLng(5)

‘ Numbers as variables. Be sure the variable type matches the parameter type, i.e.,

‘ dont pass variables declared as Variant to a function expecting Long

‘// minimal sanity check for these 4 parameters:

If LibName = vbNullString Then Exit Function

If FunctionName = vbNullString Then Exit Function

If Not (FunctionReturnType And &HFFFF0000) = 0& Then Exit Function ‘ can only be 4 bytes

If HasStringParams < STR_NONE Or HasStringParams > STR_UNICODE Then Exit Function

Dim sText As String, lStrPtr As Long, lValue As Long

Const VT_BYREF As Long = &H4000&

Dim hMod As Long, fPtr As Long

Dim pIndex As Long, pCount As Long

Dim vParamPtr() As Long, vParamType() As Integer

Dim vRtn As Variant, vParams() As Variant

‘// determine if we will be loading this or already loaded

If LibName = m_DLLname Then

hMod = m_Mod ‘ already loaded

Else

If Not m_Mod = 0& Then ‘ reset m_Mod & m_Release

If m_Release = True Then FreeLibrary m_Mod

m_Mod = 0&: m_Release = False

End If

hMod = GetModuleHandle(LibName) ‘ loaded in process already?

If hMod = 0& Then ‘ if not, load it now

hMod = LoadLibrary(LibName)

If hMod = 0& Then Exit Function

m_Release = True ‘ need to use FreeLibrary at some point

End If

m_Mod = hMod ‘ cache hMod & LibName

m_DLLname = LibName

End If

fPtr = GetProcAddress(hMod, FunctionName) ‘ get the function pointer (Case-Sensitive)

If fPtr = 0& Then Exit Function ‘ abort if failure

vParams() = FunctionParameters() ‘ copy passed parameters, if any

pCount = Abs(UBound(vParams) – LBound(vParams) + 1&)

If HasStringParams > STR_NONE Then ‘ patch to ensure Strings passed as handles

For pIndex = 0& To pCount – 1& ‘ for each string param, get its StrPtr

If VarType(FunctionParameters(pIndex)) = vbString Then

CopyMemory lValue, ByVal VarPtr(FunctionParameters(pIndex)), 2&

If (lValue And VT_BYREF) = 0& Then ‘ else variant has pointer to StrPtr

lValue = VarPtr(FunctionParameters(pIndex)) + 8&

Else

CopyMemory lValue, ByVal VarPtr(FunctionParameters(pIndex)) + 8&, 4&

End If

CopyMemory lStrPtr, ByVal lValue, 4& ‘ get the StrPtr

If lStrPtr > 0& Then ‘ if not null then

If HasStringParams = STR_ANSI Then ‘ convert Unicode to ANSI

sText = FunctionParameters(pIndex) ‘ then re-write the passd String to ANSI

FillMemory ByVal lStrPtr, LenB(sText), 0

sText = StrConv(sText, vbFromUnicode)

CopyMemory ByVal lStrPtr, ByVal StrPtr(sText), LenB(sText)

End If

End If

vParams(pIndex) = lStrPtr ‘ reference the StrPtr

End If

Next

End If

‘ fill in rest of APIs parameters

If pCount = 0& Then ‘ no return value (sub vs function)

ReDim vParamPtr(0 To 0)

ReDim vParamType(0 To 0)

Else

ReDim vParamPtr(0 To pCount – 1&) ‘ need matching array of parameter types

ReDim vParamType(0 To pCount – 1&) ‘ and pointers to the parameters

For pIndex = 0& To pCount – 1&

vParamPtr(pIndex) = VarPtr(vParams(pIndex))

vParamType(pIndex) = VarType(vParams(pIndex))

Next

End If

‘ call the function now

lValue = DispCallFunc(0&, fPtr, CallConvention, FunctionReturnType, _

pCount, vParamType(0), vParamPtr(0), vRtn)

If lValue = 0& Then ‘ 0 = S_OK

If FunctionReturnType = CR_None Then

CallFunction_DLL = lValue

Else

CallFunction_DLL = vRtn ‘ return result

End If

Else

SetLastError lValue ‘ set error & return Empty

End If

End Function

Public Function CallFunction_COM(ByVal InterfacePointer As Long, ByVal VTableOffset As Long, _

ByVal FunctionReturnType As CALLRETURNTUYPE_ENUM, _

ByVal CallConvention As CALLINGCONVENTION_ENUM, _

ParamArray FunctionParameters() As Variant) As Variant

‘ Used to call active-x or COM objects, not standard dlls

‘ Return value. Will be a variant containing a value of FunctionReturnType

‘ If this method fails, the return value will always be Empty. This can be verified by checking

‘ the Err.LastDLLError value. It will be non-zero if the function failed else zero.

‘ If the method succeeds, there is no guarantee that the Interface function you called succeeded. The

‘ success/failure of that function would be indicated by this method’s return value.

‘ Typically, success is returned as S_OK (zero) and any other value is an error code.

‘ If calling a sub vs function & this method succeeds, the return value will be zero.

‘ Summarizing: if method fails to execute, Err.LastDLLError value will be non-zero

‘ If method executes ok, if the return value is zero, method succeeded else return is error code

‘ Parameters:

‘ InterfacePointer. A pointer to an object/class, i.e., ObjPtr(IPicture)

‘ Passing invalid pointers likely to result in crashes

‘ VTableOffset. The offset from the passed InterfacePointer where the virtual function exists.

‘ These offsets are generally in multiples of 4. Value cannot be negative.

‘ For the remaining parameters, see the details withn the CallFunction_DLL method.

‘ They are the same with one exception: strings. Pass the string variable name or value

‘// minimal sanity check for these 4 parameters:

If InterfacePointer = 0& Or VTableOffset < 0& Then Exit Function

If Not (FunctionReturnType And &HFFFF0000) = 0& Then Exit Function ‘ can only be 4 bytes

Dim pIndex As Long, pCount As Long

Dim vParamPtr() As Long, vParamType() As Integer

Dim vRtn As Variant, vParams() As Variant

vParams() = FunctionParameters() ‘ copy passed parameters, if any

pCount = Abs(UBound(vParams) – LBound(vParams) + 1&)

If pCount = 0& Then ‘ no return value (sub vs function)

ReDim vParamPtr(0 To 0)

ReDim vParamType(0 To 0)

Else

ReDim vParamPtr(0 To pCount – 1&) ‘ need matching array of parameter types

ReDim vParamType(0 To pCount – 1&) ‘ and pointers to the parameters

For pIndex = 0& To pCount – 1&

vParamPtr(pIndex) = VarPtr(vParams(pIndex))

vParamType(pIndex) = VarType(vParams(pIndex))

Next

End If

‘ call the function now

pIndex = DispCallFunc(InterfacePointer, VTableOffset, CallConvention, FunctionReturnType, _

pCount, vParamType(0), vParamPtr(0), vRtn)

If pIndex = 0& Then ‘ 0 = S_OK

CallFunction_COM = vRtn ‘ return result

Else

SetLastError pIndex ‘ set error & return Empty

End If

End Function

Public Function PointerToStringA(ByVal ANSIpointer As Long) As String

‘ courtesy function provided for your use as needed

‘ ANSIpointer must be a pointer to an ANSI string (1 byte per character)

Dim lSize As Long, sANSI As String

If Not ANSIpointer = 0& Then

lSize = lstrlenA(ANSIpointer)

If lSize > 0& Then

sANSI = String$(lSize \ 2& + 1&, vbNullChar)

CopyMemory ByVal StrPtr(sANSI), ByVal ANSIpointer, lSize

PointerToStringA = Left$(StrConv(sANSI, vbUnicode), lSize)

End If

End If

End Function

Public Function PointerToStringW(ByVal UnicodePointer As Long) As String

‘ courtesy function provided for your use as needed

‘ UnicodePointer must be a pointer to an unicode string (2 bytes per character)

Dim lSize As Long

If Not UnicodePointer = 0& Then

lSize = lstrlenW(UnicodePointer)

If lSize > 0& Then

PointerToStringW = Space$(lSize)

CopyMemory ByVal StrPtr(PointerToStringW), ByVal UnicodePointer, lSize * 2&

End If

End If

End Function

Public Function ThunkFor_CDeclCallbackToVB(ByVal VBcallbackPointer As Long, _

ByVal CallbackParamCount As Long) As Long

‘ this method is a workaround for cases where you are calling a CDECL function that requests

‘ a callback function address in CDECL calling convention.

‘ Ex: qsort in msvcrt20.dll uses such a callback & qsort function description found here:

‘ http://msdn.microsoft.com/en-us/library/zes7xw0h.aspx

‘ Important notes:

‘ 1) DO NOT USE this workaround when any function accepting a callback pointer,

‘ uses stdCall calling convention to that pointer. DO NOT USE this function

‘ for other than CDECL functions calling back to VB

‘ 2) This method’s return value MUST BE RELEASED via a call to ThunkRelease_CDECL method

‘ 3) The VB callback function must be a function vs. sub, even if the the callback

‘ definition describes it as a sub, i.e., returns no value, void

‘ 4) The thunk prevents VB’s stack cleaning by copying first, then replacing it after VB returns

‘ Parameters:

‘ VBcallbackPointer: the VB callback address. If function exists in a bas module, then

‘ this would be the return value of your AddressOf call. If using thunks to get addresses

‘ from class methods, then pass that thunk address as appropriate

‘ CallbackParamCount: Number of parameters your VB method accepts. This cannot be dynamic

‘ sample call: assume that vbCallBackFunction is a Public function within a bas module

‘ ————————————————————————————-

‘ Dim lCallback As Long, lThunkAddress As Long, lResult As Long

‘ lCallback = thisClass.ThunkFor_CDeclCallbackToVB(AddressOf vbCallBackFunction, 2&, lThunkAddress)

‘ ‘ now call your CDECL function, passing lCallback as the required callback address paramter,

‘ ‘ in whatever param position it is required

‘ lResult = thisClass.CallFunction_DLL(“someCDECL.dll”, “functionName”, STR_NONE, CR_LONG, _

‘ CC_CDECL, params, lCallback)

‘ ‘ destroy the thunk when no longer needed

‘ Call thisClass.ThunkRelease_CDECL(lThunkAddress)

‘ sanity checks on passed parameters

If VBcallbackPointer = 0& Or CallbackParamCount < 0& Or CallbackParamCount > 63& Then Exit Function

‘ FYI: Why is 63 the max count? CallbackParamCount stored in the thunk as unsigned byte: 63*4 =252

Dim fPtr As Long, tCode(0 To 2) As Currency

fPtr = VirtualAlloc(0&, 28&, &H1000&, &H40&) ‘ reserve memory for our virtual function

tCode(0) = 465203369712025.6232@ ‘ thunk code is small, 28 bytes

tCode(1) = -140418483381718.8329@

tCode(2) = -4672484613390.9419@

CopyMemory ByVal fPtr, ByVal VarPtr(tCode(0)), 24& ‘ copy to virt memmory

CopyMemory ByVal fPtr + 24&, &HC30672, 4& ‘ copy final 4 bytes also

‘ thunk uses relative address to VB function address, calc relative address & patch the thunk

CopyMemory ByVal fPtr + 10&, VBcallbackPointer – fPtr – 14&, 4&

CopyMemory ByVal fPtr + 16&, CallbackParamCount * 4&, 1& ‘ patch thunk’s param count (stack adjustment)

ThunkFor_CDeclCallbackToVB = fPtr

‘ FYI: Thunk described below. Paul Caton’s work found here:

‘ http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=49776&lngWId=1

‘==============================================================================

‘ ;FASM syntax

‘ use32 ;32bit

‘ call L1 ;Call the next instruction

‘ L1: pop eax ;Pop the return address into eax (eax = L1)

‘ pop dword [eax+(L3-L1)] ;Pop the calling cdecl function’s return address to the save location

‘ db 0E8h ;Op-code for a relative address call

‘ dd 55555555h ;Address of target vb callback function, patched at run-time

‘ sub esp, 55h ;Unfix the stack, our caller expects to do it, patched at runtime

‘ call L2 ;Call the next instruction

‘ L2: pop edx ;Pop the return address into edx (edx = L2)

‘ push dword [edx+(L3-L2)];Push the saved return address, the stack is now as it was on entry to callback_wrapper

‘ ret ;Return to caller

‘ db 0 ;Alignment pad

‘ L3: dd 0 ;Return address of the cdecl caller saved here

‘==============================================================================

End Function

Public Sub ThunkRelease_CDECL(ByVal ThunkCallBackAddress As Long)

‘ Used to release memory created during a call to the ThunkFor_CDeclCallbackToVB method.

‘ The parameter passed here must be the return value of the ThunkFor_CDeclCallbackToVB method

If Not ThunkCallBackAddress = 0& Then VirtualFree ThunkCallBackAddress, 0&, &H8000&

End Sub

Private Sub Class_Terminate()

If Not m_Mod = 0& Then

If m_Release = True Then FreeLibrary m_Mod

End If

End Sub

这个类强大的不行,使用起来也极其简单:

Private Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

Private Sub Command1_Click()

Dim c As cUniversalDLLCalls

Dim sBuffer As String, lLen As Long

Set c = New cUniversalDLLCalls

/// 1st four examples show 2 ways of calling an ANSI function & 2 ways of calling a Unicode function

example of calling ANSI function, passing strings ByRef

Debug.Print "ANSI string parameters, ByRef..."

lLen = c.CallFunction_DLL("user32.dll", "GetWindowTextLengthA", STR_NONE, CR_LONG, CC_STDCALL, Me.hWnd)

sBuffer = String$(lLen, vbNullChar)

STR_ANSI + string variable name = ByRef

lLen = c.CallFunction_DLL("user32.dll", "GetWindowTextA", STR_ANSI, CR_LONG, CC_STDCALL, Me.hWnd, sBuffer, lLen + 1&)

Debug.Print vbTab; "form caption is: "; Left$(StrConv(sBuffer, vbUnicode), lLen); "<<<"

example of calling ANSI function, passing strings ByVal

Debug.Print "ANSI string parameters, ByVal..."

lLen = c.CallFunction_DLL("user32.dll", "GetWindowTextLengthA", STR_NONE, CR_LONG, CC_STDCALL, Me.hWnd)

sBuffer = String$(lLen, vbNullChar)

STR_NONE + string variable name = ByVal. Note: Only use ANSI ByRef if string sole purpose is a buffer

lLen = c.CallFunction_DLL("user32.dll", "GetWindowTextA", STR_NONE, CR_LONG, CC_STDCALL, Me.hWnd, StrPtr(sBuffer), lLen + 1&)

Debug.Print vbTab; "form caption is: "; Left$(StrConv(sBuffer, vbUnicode), lLen); "<<<"

example of calling UNICODE function, passing strings ByRef

Debug.Print "Unicode string parameters, ByRef..."

lLen = c.CallFunction_DLL("user32.dll", "GetWindowTextLengthW", STR_NONE, CR_LONG, CC_STDCALL, Me.hWnd)

sBuffer = String$(lLen, vbNullChar)

STR_UNICODE + string variable name = ByRef

lLen = c.CallFunction_DLL("user32.dll", "GetWindowTextW", STR_UNICODE, CR_LONG, CC_STDCALL, Me.hWnd, sBuffer, lLen + 1&)

Debug.Print vbTab; "form caption is: "; Left$(sBuffer, lLen); "<<<"

example of calling UNICODE function, passing strings ByVal

Debug.Print "Unicode string parameters, ByVal..."

lLen = c.CallFunction_DLL("user32.dll", "GetWindowTextLengthW", STR_NONE, CR_LONG, CC_STDCALL, Me.hWnd)

sBuffer = String$(lLen, vbNullChar)

STR_NONE + StrPtr(variable name) = ByVal

lLen = c.CallFunction_DLL("user32.dll", "GetWindowTextW", STR_NONE, CR_LONG, CC_STDCALL, Me.hWnd, StrPtr(sBuffer), lLen + 1&)

Debug.Print vbTab; "form caption is: "; Left$(sBuffer, lLen); "<<<"

/// UDT/Array examples

example of passing a structure

Dim tRect As RECT

Debug.Print "UDT/structure parameters, ByRef..."

Call c.CallFunction_DLL("user32.dll", "GetWindowRect", STR_NONE, CR_LONG, CC_STDCALL, Me.hWnd, VarPtr(tRect))

Debug.Print vbTab; "window position on screen: L"; CStr(tRect.Left); ".T"; CStr(tRect.Top); " R"; CStr(tRect.Right); ".B"; CStr(tRect.Bottom)

the RECT structure is 16 bytes, we can use an array of Long if we like

Dim aRect(0 To 3) As Long

Debug.Print "Array parameters, ByRef..."

Call c.CallFunction_DLL("user32.dll", "GetWindowRect", STR_NONE, CR_LONG, CC_STDCALL, Me.hWnd, VarPtr(aRect(0)))

Debug.Print vbTab; "window position on screen: L"; CStr(aRect(0)); ".T"; CStr(aRect(1)); " R"; CStr(aRect(2)); ".B"; CStr(aRect(3))

/// CDecl function call

Dim sFmt As String

sBuffer = String$(1024, vbNullChar)

sFmt = "P1=%s, P2=%d, P3=%.4f, P4=%s"

unicode version of the function

Debug.Print "CDecl Unicode parameters, ByRef..."

lLen = c.CallFunction_DLL("msvcrt.dll", "swprintf", STR_UNICODE, CR_LONG, CC_CDECL, sBuffer, sFmt, "ABC", 123456, 1.23456, "xyz")

Debug.Print vbTab; "printf: "; Left$(sBuffer, lLen)

ANSI version of the function, same parameters

Debug.Print "CDecl ANSI parameters, ByRef..."

lLen = c.CallFunction_DLL("msvcrt.dll", "sprintf", STR_ANSI, CR_LONG, CC_CDECL, sBuffer, (sFmt), "ABC", 123456, 1.23456, "xyz")

Debug.Print vbTab; "printf: "; Left$(StrConv(sBuffer, vbUnicode), lLen)

/// COM object call

All VB objects inherit from IUnknown (which has 3 virtual functions)

IPicture inherits from IUnknown and has several virtual functions

This example will call the 1st function which is now the 4th function, preceeded by IUnknowns 3 functions

NOTE: simple example. We can declare a IPicture interface via VB, but many interfaces are not exposed,

and this example indicates how to get a pointer to the interface & call functions from that pointer.

But just like any function, you must research to determine the VTable order & function parameter

requirements. Do not assume that some page describing the interface functions lists the functions

in VTable order. That assumption will lead to crashes.

Dim IID_IPicture As Long, aGUID(0 To 3) As Long, lPicHandle As Long

Const IUnknownQueryInterface As Long = 0& IUnknown vTable offset to Query implemented interfaces

Const IUnknownRelease As Long = 8& IUnkownn vTable offset to decrement reference count

Const IPictureGetHandle As Long = 12& 4th VTable offset from IUnknown

GUID for IPicture {7BF80980-BF32-101A-8BBB-00AA00300CAB}

c.CallFunction_DLL "ole32.dll", "CLSIDFromString", STR_UNICODE, CR_LONG, CC_STDCALL, "{7BF80980-BF32-101A-8BBB-00AA00300CAB}", VarPtr(aGUID(0))

c.CallFunction_COM ObjPtr(Me.Icon), IUnknownQueryInterface, CR_LONG, CC_STDCALL, VarPtr(aGUID(0)), VarPtr(IID_IPicture)

If IID_IPicture <> 0& Then

get the icon handle & then Release the IPicture interface. QueryInterface calls AddRef internally

c.CallFunction_COM IID_IPicture, 12&, CR_LONG, CC_STDCALL, VarPtr(lPicHandle)

c.CallFunction_COM IID_IPicture, IUnknownRelease, CR_LONG, CC_STDCALL

End If

Debug.Print "COM interface call example..."

Debug.Print vbTab; "Me.Icon.Handle = "; Me.Icon.Handle; " IPicture.GetHandle = "; lPicHandle

The PointerToString methods are a courtesy

/// simple example to return a string from a pointer

sFmt = "LaVolpe"

Debug.Print "PointerToStringA & PointerToStringW examples..."

sBuffer = c.PointerToStringW(StrPtr(sFmt)) unicode example

Debug.Print vbTab; sBuffer; "<<<"

sFmt = StrConv(sFmt, vbFromUnicode)

sBuffer = c.PointerToStringA(StrPtr(sFmt)) ANSI example

Debug.Print vbTab; sBuffer; "<<<"

End Sub

stdcall和cdecl的支持已经做进来了,其他的没有给应用案例,不知道能不能用

第2个,Paul Caton的cCallFunc2.cls,支持的调用约定stdcall、cdecl、fastcall

**********************************************************************************

** cCallFunc2.cls - cCallFunc with added fastcall support, call by address and

** additional return types

**

** Universal dll function/sub calling class

** cdecl/stdcall/fastcall calling convention

** Call by ordinal, name or address

** Module (.bas) callbacks for cdecl.

** Object (.cls/.frm/.ctl) callbacks for cdecl/stdcall

** Support for multiple callbacks.

** Support for multiple cCallFunc2 instances

** Support unicode path\module names

**

** If you wish to do crazy stuff like CallFunc with callbacks inside a callback

** then the best solution is to make a copy of the class, eg cCallFunc1.cls, and

** use an instance of that where needed.

**

** Calling conventions:

** stdcall: parameters right to left, called routine adjusts the stack

** cdecl: parameters right to left, caller adjusts the stack

** fastcall: first parameter, if present, in the ecx register

** second parameter, if present, in the edx register

** any other parameters are pushed to the stack

** called routine adjusts the stack

** N.B. fastcall isnt standardised, differing conventions exist.

** This class supports the Microsoft/GCC implementation.

**

** paul_caton@hotmail.com

**

** 20031029 First cut....................................................... v1.00

** 20071129 Now using virtual memory to fix a DEP issue..................... v1.01

** 20071130 Hacked from cCDECL, now supports stdcall and ordinals........... v1.02

** 20071201 Added support for callback objects.............................. v1.03

** 20071202 Unicode support for paths\modules where available............... v1.04

** 20071213 Forked from cCallFunc.cls

** Added support for fastcall calling convention

** Added CallPointer

** Changed the interface to be more property like.................. v1.05

** 20080212 Support Byte, Integer, Long, Single and Double return types..... v1.06

** 20080311 Added IsValidDll and IsValidMethod

** Parameter block made global

** Eliminated MAX_ARG, VB has a limit of 60 parameters

** Various optimizations........................................... v1.07

**********************************************************************************

Option Explicit

API declarations

Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long

Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function GetLastError Lib "kernel32" () As Long

Private Declare Function GetProcByName Lib "kernel32" Alias "GetProcAddress" (ByVal hModule As Long, ByVal lpProcName As String) As Long

Private Declare Function GetProcByOrdinal Lib "kernel32" Alias "GetProcAddress" (ByVal hModule As Long, ByVal nOrdinal As Long) As Long

Private Declare Function IsBadCodePtr Lib "kernel32" (ByVal lpfn As Long) As Long

Private Declare Function IsWindowUnicode Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long

Private Declare Function LoadLibraryW Lib "kernel32" (ByVal lpLibFileName As Long) As Long

Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long

Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long

Private Declare Sub GetMem1 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Byte)

Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Long)

Private Declare Sub PutMem1 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Byte)

Private Declare Sub PutMem2 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Integer)

Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Long)

Private Declare Sub PutMem8 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Currency)

Private Declare Sub SetLastError Lib "kernel32" (ByVal dwErrCode As Long)

Public Enum eObjType Object type for CallbackObj... also incorporates vTable offsets

objCls = &H1C Class object callback

objFrm = &H6F8 Form object callback

objCtl = &H7A4 UserControl object callback

End Enum

Public Enum eReturnType CallFunc/CallPointer return types... also incorporates return type jump values

retByte = &H0 Return Byte

retInteger = &H4 Return Integer

retLong = &H9 Return Long

retInt64 = &HD Return 64 bit value eg. Currency

retSingle = &H14 Return Single

retDouble = &H18 Return Double

retSub = &H1A No return value

End Enum

Private Const SRC As String = "cCallFunc2." Error source

Private Type tParamBlock Parameter block type

ParamCount As Long Number of parameters

Params(0 To 59) As Long Array of parameters

End Type

Private m_FastCall As Boolean FastCall private property value

Private m_LastError As Long LastError private property value

Private bUnicode As Boolean Unicode flag

Private vCode As Long Pointer to the machine-code thunks

Private vTable As Long Class vTable address

Private nAddrPb As Long Address of the parameter block

Private hModule As Long Current/last-used dll handle

Private strLastDLL As String Current/last-used dll name

Private strLastFunc As String Current/last-used function/sub name

Private pb As tParamBlock Parameter block

CallFunc:

strDLL - Name of the DLL

RetType - Function return type

strFunc - Name of the function or its ordinal value preceded by a # eg. "#2"

ParamLongs - Any number [or none] of parameters As Long.

To pass the address (ByRef) of a string use StrPtr, eg. StrPtr(strPath)

To pass the address (ByRef) of a variable or UDT use VarPtr, eg. VarPtr(i)

Public Function CallFunc(ByRef strDll As String, _

ByVal RetType As eReturnType, _

ByRef strFunc As String, _

ParamArray ParamLongs() As Variant) As Variant

Dim bNewDll As Boolean New dll flag

If StrComp(strDll, strLastDLL, vbTextCompare) <> 0 Then If the module is new

Dim hMod As Long

If bUnicode Then If unicode

hMod = LoadLibraryW(StrPtr(strDll & vbNullChar)) Load the module with the unicode version of LoadLibrary

Else

hMod = LoadLibraryA(strDll) Load the module with the ascii version of LoadLibrary

End If

If hMod = 0 Then If the load failed

Debug.Assert False Halt if running under the VB IDE

Err.Raise vbObjectError + 0, SRC & "CallFunc", "DLL failed load" Raise an error if running compiled

End If

If hModule <> 0 Then If a module is already loaded

FreeLibrary hModule Free the last module

End If

hModule = hMod Save the module handle

strLastDLL = strDll Save the new module name

bNewDll = True Indicate that its a new module

End If

If bNewDll Or StrComp(strFunc, strLastFunc, vbBinaryCompare) <> 0 Then If the function or module is new

Dim fnAddress As Long Function address

If Asc(strFunc) = 35 Then If "#..." eg "#2", ordinal 2

fnAddress = GetProcByOrdinal(hModule, CLng(Mid$(strFunc, 2))) Get the address of the function by ordinal

Else

fnAddress = GetProcByName(hModule, strFunc) Get the address of the function by name

End If

If fnAddress = 0 Then If the function wasnt found in the module

Debug.Assert False Halt if running under the VB IDE

Err.Raise vbObjectError + 1, SRC & "CallFunc", "Function not found" Raise an error if running compiled

End If

strLastFunc = strFunc Save the function name

PutMem4 vCode + &H19, fnAddress - vCode - (&H19 + 4) Patch the code with the relative address to the target function

End If

With pb

Dim i As Long Parameter loop vars

Dim j As Long Parameter loop vars

j = UBound(ParamLongs) Get the upper parameter array bound

For i = 0 To j For each parameter

.Params(i) = ParamLongs(i) Store the parameter in the parameter block

Next i

.ParamCount = i Store the parameter count (j + 1)

End With

CallFunc = CallCommon(RetType) Call common code

End Function

CallPointer: call a function by address

RetType - Function return type

fnAddress - Address of the target function

ParamLongs - Any number of parameters As Long, or none.

To pass the address (ByRef) of a string use StrPtr, eg. StrPtr(strPath)

To pass the address (ByRef) of a variable or UDT use VarPtr, eg. VarPtr(i)

Public Function CallPointer(ByVal RetType As eReturnType, _

ByVal fnAddress As Long, _

ParamArray ParamLongs() As Variant) As Variant

Dim i As Long Parameter loop vars

Dim j As Long Parameter loop vars

With pb

j = UBound(ParamLongs) Get the upper parameter array bound

For i = 0 To j For each parameter

.Params(i) = ParamLongs(i) Store the parameter in the parameter block

Next i

.ParamCount = i Store the parameter count (j + 1)

End With

strLastFunc = vbNullString Ensure we dont clash with CallFunc caching

PutMem4 vCode + &H19, fnAddress - vCode - (&H19 + 4) Patch the code with the relative address to the target function

CallPointer = CallCommon(RetType) Call common code

End Function

CallbackCdecl: return a wrapper address for a bas module routine to be used as a callback for a cdecl function.

Note: stdcall functions dont need a thunk to use a bas module function as a callback, use direct.

nModFuncAddr - The address of the bas module callback function, use AddressOf to get this value

nParms - The number of parameters that will be passed to the bas module callback function

nIndex - Allow for multiple simultaneous callbacks

Public Function CallbackCdecl(ByVal nModFuncAddr As Long, _

ByVal nParams As Long, _

Optional ByVal nIndex As Long = 1) As Long

If nIndex < 1 Or nIndex > 60 Or nParams > 60 Then Parameter sanity checks

Debug.Assert False Halt if running under the VB IDE

Err.Raise vbObjectError + 2, SRC & "CallbackCdecl", "Invalid parameter" Raise error if running compiled

End If

CallbackCdecl = vCode + 128 + ((nIndex - 1) * 64) Address of the callback wrapper. Pass this return value as the callback address parameter of the cdecl function

PutMem8 CallbackCdecl + 0, 465203369712025.6232@ Callback wrapper machine code

PutMem8 CallbackCdecl + 8, -140418483381718.8339@

PutMem8 CallbackCdecl + 16, -801546908679710.9163@

PutMem4 CallbackCdecl + 10, nModFuncAddr - CallbackCdecl - (10 + 4) Patch the code to call the vb bas module callback function

PutMem1 CallbackCdecl + 16, nParams * 4 Patch the code to apply the necessary stack adjustment

End Function

CallbackObj: return a wrapper address for an object callback from a cdecl or stdcall function

objType - Callback object type

objCallback - The callback object

nParams - The number of parameters that will be passed to the object callback function

nOrdinal - Callback ordinal. 1 = last private function in the callback object, 2 = second last private function in the callback object, etc

bCDECL - Specifes whether the callback calling function is cdecl or stdcall

nIndex - Allow for multiple simultaneous callbacks

Public Function CallbackObj(ByVal objType As eObjType, _

ByRef objCallback As Object, _

ByVal nParams As Long, _

Optional ByVal nOrdinal As Long = 1, _

Optional ByVal bCDECL As Boolean = False, _

Optional ByVal nIndex As Long = 1) As Long

Dim o As Long Object pointer

Dim i As Long vTable entry counter

Dim j As Long vTable address

Dim n As Long Method pointer

Dim b As Byte First method byte

Dim m As Byte Known good first method byte

If nIndex < 1 Or nIndex > 60 Or nParams > 60 Then Parameter sanity checks

Debug.Assert False Halt if running under the VB IDE

Err.Raise vbObjectError + 3, SRC & "CallbackObj", "Invalid parameter" Raise error if running compiled

End If

o = ObjPtr(objCallback) Get the callback objects address

GetMem4 o, j Get the address of the callback objects vTable

j = j + objType Increment to the the first user entry for this callback object type

GetMem4 j, n Get the method pointer

GetMem1 n, m Get the first method byte... &H33 if pseudo-code, &HE9 if native

j = j + 4 Bump to the next vtable entry

For i = 1 To 511 Loop through a sane number of vtable entries

GetMem4 j, n Get the method pointer

If IsBadCodePtr(n) Then If the method pointer is an invalid code address

GoTo vTableEnd Weve reached the end of the vTable, exit the for loop

End If

GetMem1 n, b Get the first method byte

If b <> m Then If the method byte doesnt matche the known good value

GoTo vTableEnd Weve reached the end of the vTable, exit the for loop

End If

j = j + 4 Bump to the next vTable entry

Next i Bump counter

Debug.Assert False Halt if running under the VB IDE

Err.Raise vbObjectError + 4, SRC & "CallbackObj", "Ordinal not found" Raise error if running compiled

vTableEnd: Weve hit the end of the vTable

GetMem4 j - (nOrdinal * 4), n Get the method pointer for the specified ordinal

CallbackObj = vCode + 128 + ((nIndex - 1) * 64) Address of the callback wrapper. Pass this return value as the callback address parameter

PutMem8 CallbackObj + 0, 648518346342877.6073@ Callback wrapper machine code

PutMem8 CallbackObj + 8, 9425443492.7235@

PutMem8 CallbackObj + 16, -29652486425477.8624@

PutMem8 CallbackObj + 24, 614907631944580.0296@

PutMem8 CallbackObj + 32, -444355163233240.1323@

PutMem4 CallbackObj + 40, &H90900055

PutMem1 CallbackObj + &HD, nParams Patch the number of params

PutMem4 CallbackObj + &H19, o Patch the callback object

PutMem4 CallbackObj + &H1E, n - CallbackObj - (&H1E + 4) Patch the callback call address

PutMem1 CallbackObj + &H28, IIf(bCDECL, 0, nParams * 4) Patch the stack correction

End Function

Public Property Get FastCall() As Boolean Get FastCall flag

FastCall = m_FastCall

End Property

Public Property Let FastCall(ByVal bValue As Boolean) Let Fastcall flag

m_FastCall = bValue

PutMem2 vCode + &H11, IIf(m_FastCall, &H34EB, &H9090) Patch the code as per FastCall status

End Property

IsValidDll - return whether the passed dll [path\]name is valid

strDLL - [path\]name of the DLL

Public Function IsValidDll(ByRef strDll As String)

Dim hMod As Long

If bUnicode Then If unicode

hMod = LoadLibraryW(StrPtr(strDll & vbNullChar)) Load the module with the unicode version of LoadLibrary

Else

hMod = LoadLibraryA(strDll) Load the module with the ascii version of LoadLibrary

End If

If hMod Then If the library loaded okay

FreeLibrary hMod Free the library

IsValidDll = True Indicate success

End If

End Function

IsValidMethod - return whether the passed dll [path\]name / method name is valid

strDLL - [path\]name of the DLL

strFunc - Name of the function or its ordinal value preceded by a # eg. "#2"

Public Function IsValidMethod(ByRef strDll As String, _

ByRef strFunc As String)

Dim hMod As Long

If bUnicode Then If unicode

hMod = LoadLibraryW(StrPtr(strDll & vbNullChar)) Load the module with the unicode version of LoadLibrary

Else

hMod = LoadLibraryA(strDll) Load the module with the ascii version of LoadLibrary

End If

If hMod Then If the library loaded okay

Dim nFuncAddr As Long Function address

If Asc(strFunc) = 35 Then If "#..." eg "#2", ordinal 2

nFuncAddr = GetProcByOrdinal(hModule, CLng(Mid$(strFunc, 2))) Get the address of the function by ordinal

Else

nFuncAddr = GetProcByName(hModule, strFunc) Get the address of the function by name

End If

If nFuncAddr Then If the function was found in the module

IsValidMethod = True Indicate success

End If

FreeLibrary hMod Free the library

End If

End Function

Public Property Get LastError() As Long Get last error

LastError = m_LastError

End Property

CallCommon: common CallFunc/CallPointer code

RetType - Function return type

Private Function CallCommon(ByVal RetType As eReturnType) As Variant

PutMem1 vCode + &H27, RetType Patch the return type jump

SetLastError 0 Clear the error code

N.B. we patch the vTable on each call because there could be multiple

instances of this class. Multiple instances share the same code...

and would otherwise share the vCode of the last created instance.

So we re-patch the vTable on each call to ensure the entry is hooked

to the instances vCode

Select Case RetType Select on return type

Case eReturnType.retByte Return a Byte

PutMem4 vTable + (19 * 4), vCode Patch the z_CallFunc_i08 entry to point to vCode

CallCommon = z_CallFunc_i08(nAddrPb) Call

Case eReturnType.retInteger Return an Integer

PutMem4 vTable + (20 * 4), vCode Patch the z_CallFunc_i16 entry to point to vCode

CallCommon = z_CallFunc_i16(nAddrPb) Call

Case eReturnType.retLong Return a Long

PutMem4 vTable + (21 * 4), vCode Patch the z_CallFunc_i32 entry to point to vCode

CallCommon = z_CallFunc_i32(nAddrPb) Long

Case eReturnType.retInt64 Return 64bits (e.g. Currency)

PutMem4 vTable + (22 * 4), vCode Patch the z_CallFunc_i64 entry to point to vCode

CallCommon = z_CallFunc_i64(nAddrPb) Call

Case eReturnType.retSingle Return a Single

PutMem4 vTable + (23 * 4), vCode Patch the z_CallFunc_Sng entry to point to vCode

CallCommon = z_CallFunc_Sng(nAddrPb) Call

Case eReturnType.retDouble Return a Double

PutMem4 vTable + (24 * 4), vCode Patch the z_CallFunc_Dbl entry to point to vCode

CallCommon = z_CallFunc_Dbl(nAddrPb) Call

Case eReturnType.retSub Subroutine, no return value

PutMem4 vTable + (25 * 4), vCode Patch the z_CallFunc_Sub entry to point to vCode

Call z_CallFunc_Sub(nAddrPb) Call

Case Else Undefined return type

Debug.Assert False Halt if running under the VB IDE

Err.Raise vbObjectError + 5, SRC & "CallCommon", "Unknown return type" Raise error if running compiled

End Select

m_LastError = GetLastError() Get the error code

End Function

Class_Initialize: initialize the cCallFunc2 instance

Private Sub Class_Initialize()

vCode = VirtualAlloc(0, &H1000&, &H1000&, &H40&) Allocate 4k of read/write/executable memory

PutMem8 vCode + 0, 695618785647368.6248@ Universal function caller machine code

PutMem8 vCode + 8, -208726556020175.3831@

PutMem8 vCode + 16, -29652486425143.4233@

PutMem8 vCode + 24, 614902794093417.828@

PutMem8 vCode + 32, 193965741455568.6229@

PutMem8 vCode + 40, -151277692825560.6392@

PutMem8 vCode + 48, -857442152266638.7183@

PutMem8 vCode + 56, 21029022751752.3025@

PutMem8 vCode + 64, -7203916540378.4739@

PutMem8 vCode + 72, -61276775362635.1564@

PutMem8 vCode + 80, -454553025687766.4117@

GetMem4 ObjPtr(Me), vTable Get the address of the class vTable

If GetProcByName(LoadLibraryA("user32"), "IsWindowUnicode") Then Is IsWindowUnicode present

bUnicode = IsWindowUnicode(GetDesktopWindow()) Determine whether well use the unicode version of LoadLibrary

End If

FastCall = False Default to non-Fastcall

nAddrPb = VarPtr(pb) Address of the parameter block

End Sub

Class_Terminate: cleanup the cCallFunc2 instance

Private Sub Class_Terminate()

If hModule <> 0 Then If a module is loaded

FreeLibrary hModule Free the loaded module

End If

VirtualFree vCode, 0, &H8000& Free the allocated memory

End Sub

**********************************************************************************************************

These following functions vTable method pointers are patched to point to vCode in CallFunc & CallPointer

Note: these functions must be private and cannot be moved within this source file.

**********************************************************************************************************

z_CallFunc_i08: return Byte

Private Function z_CallFunc_i08(ByVal nParmAddr As Long) As Byte

Debug.Assert False Halt if running under the VB IDE

End Function

z_CallFunc_i16: return Integer

nParmAddr - address of the parameter block

Private Function z_CallFunc_i16(ByVal nParmAddr As Long) As Integer

Debug.Assert False Halt if running under the VB IDE

End Function

z_CallFunc_i32: return Long

nParmAddr - address of the parameter block

Private Function z_CallFunc_i32(ByVal nParmAddr As Long) As Long

Debug.Assert False Halt if running under the VB IDE

End Function

z_CallFunc_i64: return int64

nParmAddr - address of the parameter block

Private Function z_CallFunc_i64(ByVal nParmAddr As Long) As Currency

Debug.Assert False Halt if running under the VB IDE

End Function

z_CallFunc_Sng: return Single

nParmAddr - address of the parameter block

Private Function z_CallFunc_Sng(ByVal nParmAddr As Long) As Single

Debug.Assert False Halt if running under the VB IDE

End Function

z_CallFunc_Dbl: return Double

nParmAddr - address of the parameter block

Private Function z_CallFunc_Dbl(ByVal nParmAddr As Long) As Double

Debug.Assert False Halt if running under the VB IDE

End Function

z_CallFunc_Sub: no return value

nParmAddr - address of the parameter block

Private Sub z_CallFunc_Sub(ByVal nParmAddr As Long)

Debug.Assert False Halt if running under the VB IDE

End Sub

其他的应用也有很多,但是这两个类最强大,最稳健。

相关推荐

我们经常会遇到这样的问题,从网页或文档中复制文字时,背景色也一并被复制了下来,使得粘贴后的文字难以阅读。那么,如何去掉复制粘贴文字的背景色,让文字更清晰、更易读呢?本文将为你详细解答。 复制粘贴文字的…

当年玩《暗黑破坏神2》最绝望的事是什么呢? 和BOSS拼命之前忘记放回城卷,结果被打死之后还要跑步去捡尸体,一个运气不好被路边一个杂兵又给干死了; 多死了几次之后脑袋一热退出游戏,这下好了,剩下一个没…

我的双胞胎宝宝去年3月出生,妹妹出生后第四天护理阿姨发现妹妹的尿不湿上面有些许血丝,告知护士医生后,妹妹就住进了新生儿科,直到第六天我和哥哥出院,妹妹都还不能出院。 出院后几天,医院打电话来让送母乳,…

爱他美奇迹系列在2020年面世,分别有澳洲版绿罐,以及香港版蓝罐、白罐,奇迹系列走的是高端路线,不少人来后台留言问:爱他美奇迹系列怎么样?有什么区别?哪个更值得买?下面,各位看完我的解读分析就会有答案…

点击右上角“关注”,每天获取职场经验、企业管理知识!轻课CEO,坚持无干货,不分享! 以前中国人称呼生意人的称呼很简单,就是老板。改革开放后,外国公司进入中国后,不但带来了新的经营理念,还带来了全新的…

俗话说“数量重于质量”。但 Dieline 奖 2023 年度最佳工作室得主每年都证明,事实上,您可以同时拥有精心设计的包装和众多奖项。年度最佳工作室颁发给在竞赛中所有类别中获得最多总体胜利的工作室、…

《指鹿为洋》番茄小说甜宠结局he,暗恋 mx 总裁在左手无名指上纹了字母sz 时常盯着发呆,他的朋友调侃着询问道“是女朋友吗?” 语气生成的回答道“不是女朋友,我还没有把她追到手。” 得知女孩要来自己…

【 爱情麻辣烫 】 导演: 张扬 编剧: 刘奋斗 / 刁亦男 / 蔡尚君 / 张扬 / 皮特·洛尔 主演: 高圆圆 / 徐静蕾 / 邵兵 / 濮存昕 / 吕丽萍 / 更多... 类型: 剧情 / 爱情…

马上4月份了,给大家推荐6个值得去的地方,希望你们能喜欢 一、云南.西双版-浪漫的边陲小城 这座边陲小城特别适合情侣闺蜜旅行,穿傣服,做傣妹,万人齐聚泼水狂欢 西双版纳旅游推荐景点 般若寺 很漂亮,最…

自用的TP-Link路由器好几年了,最近三天二头重启才能正常连接。正好手头上有台Buffalo WZR-HP-G450H无线路由器,正好可以替换掉老的TP-Link。 我的教程适合电脑小白和11、12…

《英雄联盟》S5赛季的季前赛如期来临,不少撸友闷头扎进了这场声势浩大的季前赛大军中。每年的LOL季前赛总会有很多的朋友疑惑季前赛的相关问题,比如为什么会有季前赛?我在季前赛中所打的所有比赛对我之后的正…

自从有了内置GPS(全球定位系统)的智能手机,普通人在城市,荒野穿行时不再迷路,如果您认为GPS的功能仅限于此,那就大错特错了。 GPS工作原理图 GPS系统由一组卫星组成,这些卫星将信号发送到地球表…

丹麦王国(丹麦语:Kongeriget Danmark;英语:The Kingdom of Denmark),简称丹麦(Denmark),北欧五国之一,是一个君主立宪国,拥有两个自治领地,法罗群岛和格…

在夸张版的 SmackDown 中,凯文欧文斯被揭露为 Team Brawling Brutes 的第五名成员,这让 The Bloodline 非常懊恼。 此外,Ricochet 和 Butch 获…

一旦宝宝发烧,很多父母都会担心宝宝“烧坏脑子”、“烧出肺炎”,但其实只要宝宝精神状态良好,温度在38.5℃以下,父母可不用过于担心,也不必急于吃药。 一般情况下,如果宝宝发烧不超过38.5℃,父母可以…

阳光,海岸,香车,美人…… 与敞篷跑车联系在一起的词汇总让人浮想联翩。 在普通人的印象里,敞篷跑车总是给人一种昂贵,且遥不可及的感觉。但事实真的如此吗? 根据权威媒体的测评,我们为你介绍四个类别的最佳…

最近,《权力的游戏》中“龙妈”的扮演者在社交平台发布自拍,竟然被一些网友骂又老又丑,年纪大了,全然没了年轻时的美貌。 互联网上因此展开了一场激烈的骂战,有人恶毒评价她的外貌,也有人维护她,双方你来我往…

"啊,我的电脑系统怎么又出故障了!!!"一听到这些长叹,韩博士就知道肯定是这位小伙伴的电脑出现故障问题了。对于这种经常性出现故障问题的小伙伴来说,重装系统应该已经算得上是家常便饭了。不过如果是第一次碰…

在日常生活中,我们经常需要将一些文件在不同设备上进行互传。今天我们主要来讲述两台电脑之间怎么互传文件,小编总结了3点,一起来看看吧! 第一、U盘/硬盘 U盘和硬盘是我们日常使用最多的外接储存设备,也是…

最新一期由佰草集冠名的《出发吧爱情》一向以高战斗值而突出的吴京谢楠夫妇,居然在花前月下上演了一场星月般的浪漫约会。身为武术冠军的吴京不如别的丈夫那般会弹着吉他唱歌送玫瑰,紧张得不能自已。遵循着做自己就…