实用代码（兼散分）：VBAnyCall类(第2版)——任意调用函数代码（包括__cdecl调用约定的函数及汇编代码）

[supergreenbean]

1.VBAnyCall.cls 第1部分

'------------------------------ 类模块 VBAnyCall.cls ------------------------------
Option Explicit
'本模块名称
Private Const THIS_MODULE_NAME As String = "CVBAnyCall"

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 mlParameters() As Long '参数列表
Private mlCallAddress As Long '调用的函数地址
Private mbCodeBuffer() As Byte '汇编代码字节
Private mlLastCodePosition As Long '用以跟踪最后添加的字节
Private mbCodeBytes() As Byte '用于存储代码字节
Private mfStdCall As Boolean '是否为__stdcall调用约定 True=__stdcall False=__cdecl
Private mfThroughVTable As Boolean '是否使用VTable进行跳转

'******************************* 暴露的接口 *******************************
'哑方法，在使用VTABLE方法进行调用时使用
'注意:这个方法一定要放在最前面的位置，也就是所有其他方法属性的前面!
Public Function Invoke() As Long

End Function
'调用汇编字节字符串方法
'sCodeStr :汇编字节字符串
'FuncParams():参数数组
Public Function CallCodeBytes(ByVal sCodeStr As String, ParamArray FuncParams()) As Long
On Error Resume Next
Dim i As Long
ReDim mlParameters(0)
ReDim mbCodeBuffer(0)
mlCallAddress = 0

mbCodeBytes = ByteCodeStrToBin(sCodeStr)

i = UBound(mbCodeBytes)

If Err.Number <> 0 Then
Call RaiseErr("代码字节字符串转换错误")
Exit Function
End If

mlCallAddress = VarPtr(mbCodeBytes(0))

If mlCallAddress = 0 Then
Call RaiseErr("代码入口点地址错误")
Exit Function
End If
ReDim mlParameters(UBound(FuncParams) + 1)
For i = 1 To UBound(mlParameters)
mlParameters(i) = CLng(FuncParams(i - 1))
Next i

CallCodeBytes = ExecuteCode()
End Function


'按地址调用代码
'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
Call RaiseErr("代码入口点地址错误")
Exit Function
End If
ReDim mlParameters(UBound(FuncParams) + 1)
For i = 1 To UBound(mlParameters)
mlParameters(i) = CLng(FuncParams(i - 1))
Next i
CallByAddress = ExecuteCode()
End Function

'调用DLL函数
'sDllName:Dll名称
'sFuncName:函数的名称
'FuncParams():参数数组
Public Function CallApiByName(ByVal sDllName As String, ByVal sFuncName As String, ParamArray FuncParams()) As Long
Dim hLib As Long, i As Long
ReDim mlParameters(0)
ReDim mbCodeBuffer(0)
mlCallAddress = 0
hLib = LoadLibrary(ByVal sDllName)
If hLib = 0 Then
Call RaiseErr("Dll文件未找到")
Exit Function
End If
mlCallAddress = GetProcAddress(hLib, ByVal sFuncName)
If mlCallAddress = 0 Then
Call RaiseErr("代码入口点地址错误")
FreeLibrary hLib
Exit Function
End If
ReDim mlParameters(UBound(FuncParams) + 1)
For i = 1 To UBound(mlParameters)
mlParameters(i) = CLng(FuncParams(i - 1))
Next i
CallApiByName = ExecuteCode()
FreeLibrary hLib
End Function

'汇编字节字符串转换为代码字节数组
'sByteCode:汇编字节字符串
Public Function ByteCodeStrToBin(ByVal sByteCode As String) As Byte()
Dim s() As String
Dim b() As Byte
Dim i As Long

s = Split(Trim(sByteCode), " ")

If UBound(s) >= 0 Then
ReDim b(UBound(s))
End If

For i = 0 To UBound(s)
b(i) = CByte("&h" & s(i))
Next
ByteCodeStrToBin = b
End Function

'是否为__stdcall调用约定 True=__stdcall False=__cdecl
Public Property Let IsStandardCall(fVal As Boolean)
mfStdCall = fVal
End Property

Public Property Get IsStandardCall() As Boolean
IsStandardCall = mfStdCall
End Property

'是否使用VTable进行跳转
Public Property Let ThroughVTable(fVal As Boolean)
mfThroughVTable = fVal
End Property

Public Property Get ThroughVTable() As Boolean
ThroughVTable = mfThroughVTable
End Property

'返回函数指针值
Public Function FuncPtr(ByVal lAddr) As Long
FuncPtr = lAddr
End Function

'复制lAddress开始ubound(b)个字节的内容到字节数组b(),并返回字符串表示
Public Function ShowMemory(ByVal lAddress As Long, b() As Byte, Optional ByVal fPrint As Boolean = True) As String
On Error Resume Next
Dim lLen As Long
lLen = UBound(b) - LBound(b) + 1
If lLen <= 0 Or Err.Number <> 0 Then
Exit Function
End If

CopyMemory b(0), ByVal lAddress, lLen

Dim i As Long
For i = 0 To lLen - 1
If b(i) < 16 Then
ShowMemory = ShowMemory & "0" & Hex(b(i))
Else
ShowMemory = ShowMemory & Hex(b(i))
End If
ShowMemory = ShowMemory & " "
Next

If fPrint Then
Debug.Print ShowMemory
End If
End Function

'获得内存lAddress处的Long值
Public Function GetLngValue(ByVal lAddress As Long) As Long
CopyMemory GetLngValue, ByVal lAddress, 4
End Function
'******************************* 暴露的接口 *******************************

[online]

结贴后
回复 | 推荐 | 收藏 | 专题 | 公告 | 管理 | 保存 | 关闭窗口
变成了
回复 | 推荐 | 收藏 | 专题 | 公告 | 加入faq | 保存 | 关闭窗口

[online]

to hisofty(瘦马)
http://www.dearbook.com.cn/book/viewbook.aspx?pno=TS0013167

是这本吗??

[supergreenbean]

呵呵，要钱的说~~

[hisofty]

呵呵，是那本书
内容极深，而且很多都是一般认为vb无法办到的知识
不了解com的话，理解起来很困难，我就只知起然，而不管其所以然了，也没法管

[online]

to hisofty(瘦马)
http://www.dearbook.com.cn/book/viewbook.aspx?pno=TS002673
是这本吗??

[online]

呵呵
功夫不负有心人
http://www.dearbook.com.cn/book/viewbook.aspx?pno=TS004463
找到了

书 名： 高级Visual Basic 编程 特价书
原 书 名： Advanced Visual Basic
原 作 者： Matthew Curland /著
作 者： 涂翔云 刘玉印 刘岩 /译
出 版 社： 中国电力出版社
图书分类： 程序设计 > VB
版别版次： 2001年7月第一版第一次印刷
ISBN ： 7-5083-0662-7

开 本： 787*1092 1/16
出版日期： 2001年7月 字数： 612千字
页数： 409
备注： 1CD
市场价： ￥ 55.0元 dearbook会员价：￥ 11.0元

[supergreenbean]

我K到那本书了，正在享受中……哈哈哈哈哈~~

[cso]

太强了,学习ing

[dgwangfang]

有没有下载的？可给高分!!!

[高高兴兴的晶晶]

使力的 UP

[zidane10]

up 接分

[boyzhang]

好!

Support!

[daisy8675]

蹭蹭再講

[daisy8675]

我K到那本书了，正在享受中……哈哈哈哈哈~~
///
同學，請做成影印版，提供下載地址....

[broown]

好东西，收藏

[daisy8675]

你给我N块大洋我就考虑考虑……
///
我給你啪啦啪啦幣怎麼樣？可以考慮一下噢。我可以給你一儀塊噢^^

[supergreenbean]

//同學，請做成影印版，提供下載地址....

-_-#

你给我N块大洋我就考虑考虑……

[Ranma_True]

mark

[limitworld]

好,谢谢

[wingchi]

谢谢楼主 收藏