实用代码:VBAnyCall类——任意调用函数代码(包括__cdecl调用约定的函数及汇编代码)

supergreenbean 2004-04-12 12:14:17
'------------------------------ 类模块 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

'**************************************************************************
'* 暴露的接口 *
'**************************************************************************

'调用汇编字节字符串方法
'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 = CallWindowProc(PrepareCode, 0, 0, 0, 0)
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 = CallWindowProc(PrepareCode, 0, 0, 0, 0)
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 = CallWindowProc(PrepareCode, 0, 0, 0, 0)
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
'**************************************************************************
'* 暴露的接口 *
'**************************************************************************


'**************************************************************************
'******************************** 私有函数 ********************************
'**************************************************************************
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 Not mfStdCall Then '如果调用约定不是__stdcall,那就自己恢复堆栈
For i = 1 To UBound(mlParameters)
AddByteToCode &H59 'pop ecx'恢复堆栈
Next
End If
AddByteToCode &HC3
AddByteToCode &HCC
PrepareCode = lCodeStartPosition
End Function

Private Sub AddCallToCode(lAddr As Long)
AddByteToCode &HE8
AddLongToCode lAddr - VarPtr(mbCodeBuffer(mlLastCodePosition)) - 4
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 AddByteToCode(bCode As Byte)
mbCodeBuffer(mlLastCodePosition) = bCode
mlLastCodePosition = mlLastCodePosition + 1
End Sub

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 RaiseErr(ByVal sErrMsg As String)
Err.Raise vbObjectError + &H1321, "VBAnyCall", sErrMsg
End Sub
Private Sub Class_Initialize()
mfStdCall = True
End Sub
'**************************************************************************
'******************************** 私有函数 ********************************
'**************************************************************************

...全文
348 59 打赏 收藏 转发到动态 举报
写回复
用AI写文章
59 条回复
切换为时间正序
请发表友善的回复…
发表回复
LittlePig 2010-06-13
  • 打赏
  • 举报
回复
http://expert.csdn.net/Expert/TopicView1.asp?id=2859424 进不去呀?
LittlePig 2010-06-03
  • 打赏
  • 举报
回复
先顶再看~
谢谢lz
boyzhang 2004-04-27
  • 打赏
  • 举报
回复
:)

不好意思! 吓到你了!

应该是

<<Advanced Visual Basic6>>
supergreenbean 2004-04-26
  • 打赏
  • 举报
回复
偶什么都没有听过诶,真是孤陋寡闻啊,唉`~~~
daisy8675 2004-04-26
  • 打赏
  • 举报
回复
我翻...什麼叫運氣好 .....

偶偶偶....翻, 你還是幫偶看看sstab吧。也不知道sp6能解決...偶沒有sp6
铁拳 2004-04-26
  • 打赏
  • 举报
回复
你运气好,可以用这个地址再现 vbsmart 风采,http://www.hidotnet.com/download/tekken/kki
daisy8675 2004-04-26
  • 打赏
  • 举报
回复
smart!smart!我很久沒有辦法進去了呀

站長是強人的說,而且網葉做的特漂亮.....

smart呀...............
铁拳 2004-04-25
  • 打赏
  • 举报
回复
www.vbsmart.com 里面有一个 subclass 的源代码,这段代码很有收藏价值。我把它贴出来吧。
boyzhang 2004-04-25
  • 打赏
  • 举报
回复
AD什么什么的Visual Basic(老外著)算不算?

呵呵,很NB哟!只可惜我们这里买不到!
cso 2004-04-22
  • 打赏
  • 举报
回复
太强了,学习ing
qyii 2004-04-21
  • 打赏
  • 举报
回复
go go go!!!不要"叹",国内没人写就自己去写...
supergreenbean 2004-04-21
  • 打赏
  • 举报
回复
我看过的书不是很多,基本都是网上或MSDN上散乱的文档和例子……似乎国内还没有什么人写过非常详细的关于子类处理的东西吧,会提到子类处理的基本上都是老外写的……唉,叹息啊
道素 2004-04-21
  • 打赏
  • 举报
回复
非常棒!
代码里汇编语言部分比较陌生!学习...
daisy8675 2004-04-19
  • 打赏
  • 举报
回复
豆豆:
給我介紹本關於subclass好一點的書。我昨天逛圖書城,走暈我了,都沒有看見一本合心意的。
中文英文的不限,隻要目前國內能買到就可以啦 ^^
hongsongboy 2004-04-18
  • 打赏
  • 举报
回复
打印预览控件(免费)
===============================
http://sky300.com:88/hongsong/
===============================
支持MSHFLEX,MSFLEX控件打印,自定义标题、表头、页头、表尾、输出图像(.BMP .JPG),打印缩放功能,等还有很多功能等待你去开发。
43720938 2004-04-18
  • 打赏
  • 举报
回复
恭喜升星
programfish 2004-04-18
  • 打赏
  • 举报
回复
关注
supergreenbean 2004-04-18
  • 打赏
  • 举报
回复
//逗逗去做個操作系統出來好不好

-_-!

......我还是看看书写写字比较好
daisy8675 2004-04-16
  • 打赏
  • 举报
回复
嘿嘿,偶發現偶真的是到什麼地方叫別人什麼,別人都有的應呀。

逗逗去做個操作系統出來好不好
supergreenbean 2004-04-16
  • 打赏
  • 举报
回复
呵呵,行了就好,否则偶就白叫子类狂了
加载更多回复(38)

1,487

社区成员

发帖
与我相关
我的任务
社区描述
VB API
社区管理员
  • API
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧