vb6 CallByAddress,call fun by address,api call,dll call by address
form1 code
form1 code
Code:
Private Sub Command1_Click()
Dim a As Long, b As Long, C As Long
a = 11
b = 22
MsgBox "Result value 2:" & CallByAddress(AddressOf add, VarPtr(a), VarPtr(b))
MsgBox "A=" & a
a = 11
b = 22
MsgBox "Result value 3:" & CallByAddress(AddressOf Add2, VarPtr(a), b)
MsgBox "A2=" & a
Dim s1 As String, s2 As String, s3 As String, Result As Long
s1 = "abc"
s2 = "kkk"
Result = CallByAddress(AddressOf AddStr, VarPtr(s1), StrPtr(s2))
s3 = GetBSTRFromPtr(Result)
MsgBox "s3=" & s3
MsgBox "s1=" & s1
End SubCode:
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes 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 mlParameters() As Long '参数列表
Private mlCallAddress As Long '调用的函数地址
Private mbCodeBuffer() As Byte '汇编代码字节
Private mlLastCodePosition As Long '用以跟踪最后添加的字节
Public isCdecl As Boolean
'按地址调用代码
'lFuncAddress:函数地址
'FuncParams():参数数组
Public Function CallByAddress(ByVal lFuncAddress As Long, ParamArray FuncParams()) As Long
Dim i As Long
ReDim mlParameters(0)
ReDim mbCodeBuffer(0)
mlCallAddress = 0
mlCallAddress = lFuncAddress
If mlCallAddress = 0 Then
MsgBox "代码入口点地址错误"
Exit Function
End If
ReDim mlParameters(UBound(FuncParams) + 1)
For i = 1 To UBound(mlParameters)
mlParameters(i) = CLng(FuncParams(i - 1))
Next i
CallByAddress = CallWindowProc(PrepareCode, 0, 0, 0, 0)
End Function
'******************************** 私有函数 ********************************
'**************************************************************************
Private Function PrepareCode() As Long
Dim i As Long, lCodeStartPosition As Long
ReDim mbCodeBuffer(18 + 32 + 6 * UBound(mlParameters))
lCodeStartPosition = GetAlignedlCodeStartPosition(VarPtr(mbCodeBuffer(0)))
mlLastCodePosition = lCodeStartPosition - VarPtr(mbCodeBuffer(0))
For i = 0 To mlLastCodePosition - 1
mbCodeBuffer(i) = &HCC
Next
AddByteToCode &H58 'pop eax'将返回地址存入eax
AddByteToCode &H59 'pop ecx' / 去掉
AddByteToCode &H59 'pop ecx'| 事先
AddByteToCode &H59 'pop ecx'| 被压入
AddByteToCode &H59 'pop ecx' \ 的参数
AddByteToCode &H50 'push eax'重新压入返回地址
For i = UBound(mlParameters) To 1 Step -1
AddByteToCode &H68 'push parameter(i)'压入我们的参数
AddLongToCode mlParameters(i)
Next
AddCallToCode mlCallAddress
'VB之所以不能用__cdecl调用约定的函数就是因为VB不会自己恢复堆栈。
If isCdecl Then '如果调用约定不是__stdcall，那就自己恢复堆栈
For i = 1 To UBound(mlParameters)
AddByteToCode &H59 'pop ecx'恢复堆栈
Next
End If
AddByteToCode &HC3
AddByteToCode &HCC
PrepareCode = lCodeStartPosition
End Function
Private Function GetAlignedlCodeStartPosition(lAddr As Long) As Long
GetAlignedlCodeStartPosition = lAddr + (15 - (lAddr - 1) Mod 16)
If (15 - (lAddr - 1) Mod 16) = 0 Then GetAlignedlCodeStartPosition = GetAlignedlCodeStartPosition + 16
End Function
Private Sub AddByteToCode(bCode As Byte)
mbCodeBuffer(mlLastCodePosition) = bCode
mlLastCodePosition = mlLastCodePosition + 1
End Sub
Private Sub AddLongToCode(lCode As Long)
Dim i As Integer
Dim b(3) As Byte
CopyMemory b(0), lCode, 4
For i = 0 To 3
AddByteToCode b(i)
Next
End Sub
Private Sub AddCallToCode(lAddr As Long)
AddByteToCode &HE8
AddLongToCode lAddr - VarPtr(mbCodeBuffer(mlLastCodePosition)) - 4
End SubCode:
Private Declare Sub CopyMemoryLong Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
ByVal Destination As Long, _
ByVal Source As Long, _
ByVal Length As Long)
Function GetBSTRFromPtr(ByVal lpStr As Long) As String
'从指针得到BSTR字符串
Dim InStrLen As Long, OutStrArr() As Byte
If lpStr = 0 Then Exit Function
CopyMemoryLong VarPtr(InStrLen), lpStr - 4, 4 '得到输入字符串的长度
ReDim OutStrArr(InStrLen - 1)
Call CopyMemoryLong(VarPtr(OutStrArr(0)), lpStr, InStrLen)
GetBSTRFromPtr = OutStrArr
End Function
Function LenPtr(ByVal lpStr As Long) As Long
'根据指针取BSTR长度
Dim InStrLen As Long
If lpStr = 0 Then Exit Function
CopyMemoryLong VarPtr(InStrLen), lpStr - 4, 4 '得到输入字符串的长度
LenPtr = InStrLen
End Function
Public Function add(a As Long, b As Long) As Long
add = a + b
a = a + 100
End Function
Public Function Add2(a As Long, ByVal b As Long) As Long
Add2 = a + b
a = a + 200
End Function
Function AddStr(str1 As String, ByVal str2 As String) As String
MsgBox "str1=" & str1
MsgBox "str2=" & str2
AddStr = str1 & str2
str1 = str1 & Now
End Function