高手进来帮忙!即时调用API函数的问题!

不是啊我不先声明SENDMESSAGE在过程中声明/调用原来看过一段程序,好象就行,找不到了

那段程序开头是这样的:
不过不知道后面该怎么调用,太大的一个工程
(是一个脚本解释器)Option Explicit
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) 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 Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
Private mlngParameters() As Long 'list of parameters
Private mlngAddress As Long 'address of function to call
Private mbytCode() As Byte 'buffer for assembly code
Private mlngCP As Long 'used to keep track of latest byte added to codePublic Function CallApiByName(libName As String, funcName As String, ParamArray FuncParams()) As Long
   Dim lb As Long, i As Integer
   ReDim mlngParameters(0)
   ReDim mbytCode(0)
   mlngAddress = 0
   lb = LoadLibrary(ByVal libName)
   If lb = 0 Then
      MsgBox "DLL not found", vbCritical
      Exit Function
   End If
   mlngAddress = GetProcAddress(lb, ByVal funcName)
   If mlngAddress = 0 Then
      MsgBox "Function entry not found", vbCritical
      FreeLibrary lb
      Exit Function
   End If
   ReDim mlngParameters(UBound(FuncParams) + 1)
   For i = 1 To UBound(mlngParameters)
      mlngParameters(i) = CLng(FuncParams(i - 1))
   Next i
   CallApiByName = CallWindowProc(PrepareCode, 0, 0, 0, 0)
   FreeLibrary lb
End Function................

http://expert.csdn.net/Expert/topic/793/793043.xml?temp=.5732538http://email.hosp.ncku.edu.tw/~cww/html/q00528.html

类模块：
cAPIByName.cls
__________________________________________________________
Option ExplicitPrivate Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) 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 Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
Private m_lngParameters() As Long
Private m_lngAddress As Long
Private m_bytCode() As Byte
Private m_lngCP As LongPublic Function CallApiByName(ByVal strLibName As String, _
                              ByVal strFuncName As String, _
                              ParamArray FuncParams()) As Long   Dim o_lngLb As Long, o_intItems As Integer

   ReDim m_lngParameters(0)

   ReDim m_bytCode(0)

   m_lngAddress = 0

   o_lngLb = LoadLibrary(ByVal strLibName)

   If o_lngLb Then
    m_lngAddress = GetProcAddress(o_lngLb, ByVal strFuncName)

    If m_lngAddress Then

        ReDim m_lngParameters(UBound(FuncParams) + 1)

        For o_intItems = 1 To UBound(m_lngParameters)
           m_lngParameters(o_intItems) = CLng(FuncParams(o_intItems - 1))
        Next o_intItems

        CallApiByName = CallWindowProc(PrepareCode, 0, 0, 0, 0)

    End If

    FreeLibrary o_lngLb

   End IfEnd Function
Private Function PrepareCode() As Long

    Dim o_lngItems As Long, o_lngCodeStart As Long

    ReDim m_bytCode(18 + 32 + 6 * UBound(m_lngParameters))

    o_lngCodeStart = GetAlignedCodeStart(VarPtr(m_bytCode(0)))

    m_lngCP = o_lngCodeStart - VarPtr(m_bytCode(0))

    For o_lngItems = 0 To m_lngCP - 1
        m_bytCode(o_lngItems) = &HCC
    Next

    AddByteToCode &H58 'pop eax
    AddByteToCode &H59 'pop ecx
    AddByteToCode &H59 'pop ecx
    AddByteToCode &H59 'pop ecx
    AddByteToCode &H59 'pop ecx
    AddByteToCode &H50 'push eax

    For o_lngItems = UBound(m_lngParameters) To 1 Step -1
        AddByteToCode &H68 'push wwxxyyzz
        AddLongToCode m_lngParameters(o_lngItems)
    Next

    AddCallToCode m_lngAddress

    AddByteToCode &HC3

    AddByteToCode &HCC

    PrepareCode = o_lngCodeStart

End Function
Private Sub AddCallToCode(lngAddress As Long)
    AddByteToCode &HE8
    AddLongToCode lngAddress - VarPtr(m_bytCode(m_lngCP)) - 4
End Sub
Private Sub AddLongToCode(lng As Long)

    Dim o_intItems As Integer
    Dim o_bytArray(3) As Byte

    CopyMemory o_bytArray(0), lng, 4

    For o_intItems = 0 To 3
        AddByteToCode o_bytArray(o_intItems)
    NextEnd Sub
Private Sub AddByteToCode(byt As Byte)
    m_bytCode(m_lngCP) = byt
    m_lngCP = m_lngCP + 1
End Sub
Private Function GetAlignedCodeStart(lngAddress As Long) As Long
    GetAlignedCodeStart = lngAddress + (15 - (lngAddress - 1) Mod 16)
    If (15 - (lngAddress - 1) Mod 16) = 0 Then GetAlignedCodeStart = GetAlignedCodeStart + 16
End Function
__________________________________________________________
例子：
private m_ucmAPIByName as new cAPIByNamemsgbox CBool(m_ucmAPIByName.CallApiByName("comctl32.dll", "GetDllVersion") '后面还可以加任意参数，不过，要注意的是，参数是倒叙的，也就是说，para3,para2,para1，如此类推

调试易

高手进来帮忙!即时调用API函数的问题!

解决方案 »