Paul Caton的cCallFunc2.cls 的源代码

以下是cCallFunc2.cls的源代码：

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cCallFunc2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const CC_FASTCALL As Long = 0
Private Const CC_CDECL As Long = 1
Private Const CC_STDCALL As Long = 2

Private hLib As Long
Private m_pFunc As Long
Private m_nCallConv As Long

Public Property Get CallConv() As Long
    CallConv = m_nCallConv
End Property

Public Property Let CallConv(ByVal nCallConv As Long)
    m_nCallConv = nCallConv
End Property

Public Sub LoadLibrary(ByVal sLibName As String)
    hLib = LoadLibrary(sLibName)
End Sub

Public Sub FreeLibrary()
    FreeLibrary hLib
End Sub

Public Function GetFuncAddr(ByVal sFuncName As String) As Long
    Dim s As String * 256
    s = sFuncName
    GetFuncAddr = GetProcAddress(hLib, s)
    m_pFunc = GetFuncAddr
End Function

Public Function CallFunc(ParamArray Params()) As Long
    Dim nParamCount As Long
    nParamCount = UBound(Params) + 1
    Select Case m_nCallConv
        Case CC_FASTCALL
            Call CallFuncFast(m_pFunc, nParamCount, Params(0), Params(1), Params(2), Params(3))
        Case CC_CDECL
            Call CallFuncCDecl(m_pFunc, nParamCount, Params(0), Params(1), Params(2), Params(3), Params(4), Params(5), Params(6), Params(7))
        Case CC_STDCALL
            Call CallFuncStdCall(m_pFunc, nParamCount, Params(0), Params(1), Params(2), Params(3), Params(4), Params(5), Params(6), Params(7))
    End Select
    CallFunc = Params(0)
End Function

Private Sub CallFuncFast(ByVal pFunc As Long, ByVal nParamCount As Long, ParamArray Params())
    Dim nRegCount As Long
    Dim nStackCount As Long
    Dim nParamIndex As Long
    Dim nArgIndex As Long

    ' Determine number of arguments that can be passed in registers
    nRegCount = IIf(nParamCount > 0, 1, 0) + IIf(nParamCount > 1, 1, 0) + IIf(nParamCount > 2, 1, 0) + IIf(nParamCount > 3, 1, 0)

    ' Push arguments onto stack
    nStackCount = nParamCount - nRegCount
    For nParamIndex = nRegCount To nParamCount - 1
        CopyMemory ByVal VarPtr(Params(nParamIndex)), ByVal VarPtr(nArgIndex), 4
        nArgIndex = nArgIndex + 4
    Next nParamIndex

    ' Call function
    Select Case nRegCount
        Case 0
            CallWindowProc pFunc, 0, 0, 0, 0
        Case 1
            CallWindowProc pFunc, 0, Params(0), 0, 0
        Case 2
            CallWindowProc pFunc, 0, Params(0), Params(1), 0
        Case 3
            CallWindowProc pFunc, 0, Params(0), Params(1), Params(2)
        Case 4
            CopyMemory ByVal VarPtr(Params(0)), ByVal VarPtr(0), 4
            CopyMemory ByVal VarPtr(Params(1)), ByVal VarPtr(4), 4
            CopyMemory ByVal VarPtr(Params(2)), ByVal VarPtr(8), 4
            CopyMemory ByVal VarPtr(Params(3)), ByVal VarPtr(12), 4
            CallWindowProc pFunc, 0, Params(0), Params(1), Params(2)
    End Select
End Sub

Private Sub CallFuncCDecl(ByVal pFunc As Long, ByVal nParamCount As Long, ParamArray Params())
    Dim nParamIndex As Long
    Dim nArgIndex As Long

    ' Push arguments onto stack
    For nParamIndex = 0 To nParamCount - 1
        CopyMemory ByVal VarPtr(Params(nParamIndex)), ByVal VarPtr(nArgIndex), 4
        nArgIndex = nArgIndex + 4
    Next nParamIndex

    ' Call function
    CallWindowProc pFunc, 0, Params(0), Params(1), Params(2), Params(3), Params(4), Params(5), Params(6), Params(7)
End Sub

Private Sub CallFuncStdCall(ByVal pFunc As Long, ByVal nParamCount As Long, ParamArray Params())
    Dim nParamIndex As Long
    Dim nArgIndex As Long

    ' Push arguments onto stack
    For nParamIndex = nParamCount - 1 To 0 Step -1
        CopyMemory ByVal VarPtr(Params(nParamIndex)), ByVal VarPtr(nArgIndex), 4
        nArgIndex = nArgIndex + 4
    Next nParamIndex

    ' Call function
    CallWindowProc pFunc, 0, Params(0), Params(1), Params(2), Params(3), Params(4), Params(5), Params(6), Params(7)
End Sub

请注意，这只是一个简单的示例，cCallFunc2.cls的实现方式可能会因DLL函数调用约定的不同而有所不同。建议您查阅更多的资料来了解如何使用这个类来动态调用DLL函数。