動態呼叫dll的無引數函式，為什么會不成功呢？
’類模塊：APIClass,
Option Explicit
'==============================================================================
'資料型別定義
'==============================================================================
Private Type VariableBuffer
VariableParameter() As Byte
End Type
'==============================================================================
'API 函式宣告
'==============================================================================
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 m_opIndex As Long
Private m_OpCode() As Byte
'********************************************************************************
Public Function ExecuteAPI(LibPath As String, APIScript As String) As Long
Dim hProcAddress As Long, hModule As Long, X As Long, Y As Long
Dim RetLong As Long, FunctionName As String, FunctionParameter As String
Dim LongCount As Long, StringInfo As String, StrByteArray() As VariableBuffer
Dim StringSize As Long, ByteArray() As Byte, IsHaveParameter As Boolean
Dim ParameterArray() As String, OutputArray() As Long
StringSize = 0
ReDim StrByteArray(StringSize)
'識別函式名稱
RetLong = InStr(1, APIScript, " ", vbTextCompare)
If RetLong = 0 Then
'沒有引數的函式
FunctionName = APIScript
IsHaveParameter = False
Else
'帶引數的函式
FunctionName = Left(APIScript, RetLong - 1)
IsHaveParameter = True
'識別函式引數
FunctionParameter = Right(APIScript, Len(APIScript) - RetLong)
'分析函式引數
ParameterArray = Split(FunctionParameter, ",")
'初始化函式記憶體大小
ReDim OutputArray(UBound(ParameterArray))
'格式化函式引數
For X = 0 To UBound(ParameterArray)
If IsNumeric(Trim(ParameterArray(X))) = True Then
LongCount = CLng(Trim(ParameterArray(X)))
OutputArray(X) = LongCount
Else
StringInfo = Mid(Trim(ParameterArray(X)), 2, Len(ParameterArray(X)) - 3)
If Len(StringInfo) = 0 Then
OutputArray(X) = CLng(VarPtr(Null))
Else
ReDim Preserve StrByteArray(StringSize)
ByteArray = StrConv(StringInfo, vbFromUnicode)
ReDim Preserve StrByteArray(StringSize)
ByteArray = StrConv(StringInfo, vbFromUnicode)
ReDim Preserve StrByteArray(StringSize).VariableParameter(UBound(ByteArray) + 1)
CopyMemory StrByteArray(StringSize).VariableParameter(0), ByteArray(0), UBound(ByteArray) + 1
OutputArray(X) = CLng(VarPtr(StrByteArray(StringSize).VariableParameter(0)))
StringSize = StringSize + 1
StringSize = StringSize + 1
End If
End If
Next X
ReDim m_OpCode(400 + 6 * UBound(OutputArray)) '保留用來寫m_OpCode
End If
'讀取API庫
hModule = LoadLibrary(ByVal LibPath)
If hModule = 0 Then
ExecuteAPI = 0 'Library 讀取失敗
Exit Function
End If
'取得函式地址
hProcAddress = GetProcAddress(hModule, ByVal FunctionName)
If hProcAddress = 0 Then
ExecuteAPI = 0 '函式讀取失敗
FreeLibrary hModule
Exit Function
End If
If IsHaveParameter = True Then
'帶引數的情況在此執行
ExecuteAPI = CallWindowProc(GetCodeStart(hProcAddress, OutputArray), 0, 1, 2, 3)
Else
'不帶引數的情況在此執行
ExecuteAPI = CallWindowProc(hProcAddress, 0, 1, 2, 3)
End If
'釋放庫空間
FreeLibrary hModule
End Function
Private Function GetCodeStart(ByVal lngProc As Long, arrParams() As Long) As Long
Dim lngIndex As Long, lngCodeStart As Long
lngCodeStart = (VarPtr(m_OpCode(0)) Or &HF) + 1
m_opIndex = lngCodeStart - VarPtr(m_OpCode(0))
For lngIndex = 0 To m_opIndex - 1
m_OpCode(lngIndex) = &HCC
Next lngIndex
For lngIndex = UBound(arrParams) To 0 Step -1
AddByteToCode &H68
AddLongToCode arrParams(lngIndex)
Next lngIndex
AddByteToCode &HE8
AddLongToCode lngProc - VarPtr(m_OpCode(m_opIndex)) - 4
AddByteToCode &HC2
AddByteToCode &H10
AddByteToCode &H0
GetCodeStart = lngCodeStart
End Function
Private Sub AddLongToCode(lData As Long)
CopyMemory m_OpCode(m_opIndex), lData, 4
m_opIndex = m_opIndex + 4
End Sub
Private Sub AddIntToCode(iData As Integer)
CopyMemory m_OpCode(m_opIndex), iData, 2
m_opIndex = m_opIndex + 2
End Sub
Private Sub AddByteToCode(bData As Byte)
m_OpCode(m_opIndex) = bData
m_opIndex = m_opIndex + 1
End Sub
‘表單部分
Private Sub Command1_Click()
Dim API As New APIClass, i As Long
i = API.ExecuteAPI("C:/Windows/SysWOW64/SkinH.dll", "SkinH_Attach")
MsgBox i
End Sub
SkinH_Attach為SkinH.dll中的一個沒有引數的函式，為什么會呼叫不成功呢？？很費解，求高手幫助！！
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/15157.html
標籤：API
上一篇：前兩天發現的