總共就兩個(gè)部分，第一部分說幾個(gè)聲明API并使用的技巧，第二部分簡(jiǎn)單講一下怎么動(dòng)態(tài)調(diào)用DLL

一、動(dòng)態(tài)聲明

玩API的人看到前面的描述肯定會(huì)心里MMP，廢話少說，看內(nèi)容。

1、相對(duì)路徑聲明

這個(gè)最好理解

普通的API聲明長(zhǎng)這樣：

下面是其FullPath版本的聲明：

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

下面是其相對(duì)路徑版本的聲明：

這特么怎么這么復(fù)雜呢，這三種都可以？下面也就簡(jiǎn)單一解釋，不做深入研究，各位看官也就看看就好，能記住就記住。

先說FullPath版本，這是最低級(jí)的使用方法，一般人不會(huì)這么用；還有一種方法也可以指定FullPath，那就是使用manifest，manifest是個(gè)好東西，這個(gè)以后再扒。

然后是普通的API和相對(duì)路徑的API，這倆其實(shí)是一個(gè)原理：

對(duì)于VB6，怎么檢索DLL呢，當(dāng)然是先檢索App.Path（1、不檢索子目錄；2、VBA里對(duì)應(yīng)Application.Path）

然后再檢索環(huán)境變量目錄

很多人不知道怎么看環(huán)境變量，Win R，cmd，輸入set，enter，就看到了所有環(huán)境變量

上述DLL靜態(tài)聲明，會(huì)在當(dāng)前目錄和所有環(huán)境變量目錄，以相對(duì)路徑檢索DLL（如果多個(gè)路徑都檢索到，這個(gè)要應(yīng)用檢索規(guī)則，這里也不扒了）

假設(shè)環(huán)境變量中有一個(gè)路徑：c:\xxx

那么API中的'..\Plugins\liblz4'和'liblz4'，就分別對(duì)應(yīng)了路徑：

'c:\xxx\..\Plugins\liblz4.dll'和'c:\xxx\liblz4.dll'

上面'..'的意思是指上一級(jí)目錄，也即

'c:\xxx\..\Plugins\liblz4.dll' = 'c:\Plugins\liblz4.dll'

2、動(dòng)態(tài)路徑

先說怎么用，聲明就跟普通聲明方式一樣：

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

但是，如果這時(shí)候在環(huán)境變量目錄下都沒有這個(gè)dll的話

在使用這個(gè)dll之前，我們可以用LoadLibrary這個(gè)API來加載一下dll，就可以調(diào)用'LZ4_versionNumber'了

Declare聲明函數(shù)時(shí)，是聲明函數(shù)指針，并指明入口點(diǎn)，VB6會(huì)通過內(nèi)部函數(shù)DllFunctionCall（該函數(shù)會(huì)調(diào)用LoadLibraryA）來調(diào)用外部API

如果Declare時(shí)，在所有路徑都找不到DLL，而這時(shí)候，你主動(dòng)使用LoadLibrary加載了該DLL

這時(shí)候，就解決了加載DLL的問題，相當(dāng)于運(yùn)行時(shí)重定向DLL

3、修改環(huán)境變量

VB6程序在加載時(shí)，會(huì)優(yōu)先加載App.Path

然后會(huì)加載進(jìn)程環(huán)境變量，進(jìn)程環(huán)境變量

這里相關(guān)的API有5個(gè)，這里用到的就前2個(gè)：

然后加環(huán)境變量就是這樣操作：

 Dim lngRet As Long
 Dim strDest As String
 Dim arr() As String, i As Long
 Dim boolIn As Boolean '路徑是否在環(huán)境變量中
 
 Const MAX_BUFFER = 9000&
 strDest = String$(MAX_BUFFER, Chr(0))
 GetEnvironmentVariableA 'Path', strDest, MAX_BUFFER   1 '獲取當(dāng)前進(jìn)程的Path環(huán)境變量
 lngRet = InStr(strDest, Chr(0))
 strDest = Left(strDest, lngRet - 1) '清掉緩存字符
 
 arr = Split(strDest, ';') '判斷路徑是否已經(jīng)在環(huán)境變量中
 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 '設(shè)置當(dāng)前進(jìn)程的Path環(huán)境變量，加在最前面
 End If

這樣設(shè)置之后，檢測(cè)DLL的時(shí)候，就多了一個(gè)自定義設(shè)置的strDllPath路徑了

二、動(dòng)態(tài)調(diào)用

以下內(nèi)容多且復(fù)雜，初學(xué)者直接跳過，由于這里對(duì)外鏈卡得比較嚴(yán)，我就只敢貼代碼。

所以，需要探討的，在評(píng)論里交流

很多時(shí)候，開發(fā)者不想寫那么多Declare，就論這個(gè)問題，其實(shí)有兩個(gè)解決方案。

一個(gè)是使用tlb，現(xiàn)在有很多包含win32api的tlb文件，tlb文件制作簡(jiǎn)單，在編寫代碼時(shí)引用到工程里，發(fā)布程序時(shí)不需要附帶tlb文件

還有一種方案就是動(dòng)態(tài)調(diào)用：

說起來方法其實(shí)很簡(jiǎn)單

第1步：LoadLibrary，加載DLL模塊到內(nèi)存

第2步：GetProcAddress，獲取DLL里的API函數(shù)指針

第3步：CallWindowProc或者DispCallFunc，調(diào)用函數(shù)

第4步：FreeLibrary，用完了釋放函數(shù)

但是如果真的要自己去研究，而且要支持多種調(diào)用約定的話，就比較麻煩了。

像CallWindowProc，在不寫匯編代碼的情況下，只能支撐有4個(gè)參數(shù)的API

這里當(dāng)然不會(huì)講怎么寫匯編代碼，所以這里推薦幾個(gè)已有的輪子：

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

第1個(gè)：DispCallFunc方案

vbforums論壇高人Lavolpe寫的類cUniversalDLLCalls.cls，理論上支持9種調(diào)用約定

' 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./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

這個(gè)類強(qiáng)大的不行，使用起來也極其簡(jiǎn)單：

stdcall和cdecl的支持已經(jīng)做進(jìn)來了，其他的沒有給應(yīng)用案例，不知道能不能用

第2個(gè)，Paul Caton的cCallFunc2.cls，支持的調(diào)用約定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 isn't 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 it's 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 it's 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 wasn't 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 don't 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 don't 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 object's address
 GetMem4 o, j 'Get the address of the callback object's 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 'We've 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 doesn't matche the known good value
 GoTo vTableEnd 'We've 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: 'We've 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 it's 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 instance's 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 we'll 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 function's 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

其他的應(yīng)用也有很多，但是這兩個(gè)類最強(qiáng)大，最穩(wěn)健。