如何调用带参数的函数指针

wtogether 2009-02-02 08:28:08
在Supermanking的blog找到了他发的一个用调用外部函数的类,而我现在的应用中不是调用外部函数,而是直接调用模块中的函数,我把他的类稍微改了下,去掉对dll和函数指针的获取那段,如果不带参数,那么可以执行的过,带参数过去的话程序就崩溃了,估计是压栈那段代码,原作者的注释和代码太多,就不贴完了,贴我改过的APIClass代码


Option Explicit

Private Type VariableBuffer
VariableParameter() As Byte
End Type

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, FunctionName As String, ParamArray ParameterArray() As Variant) As Long
'这里是调用外部函数的,太长了,略过
End Function

'下面这是调用模块中的函数的
Public Function ExecuteFunc(hProcAddress As Long, ParamArray ParameterArray()) As Long
Dim X As Long, Y As Long
Dim LongCount As Long, StringInfo As String, StrByteArray() As VariableBuffer
Dim StringSize As Long, ByteArray() As Byte, IsHaveParameter As Boolean
Dim OutputArray() As Long
StringSize = 0
ReDim StrByteArray(StringSize)
'识别函数名称
IsHaveParameter = CBool(UBound(ParameterArray) <> -1)
If IsHaveParameter Then
'初始化函数内存大小
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).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
End If
End If
Next X
ReDim m_OpCode(400 + 6 * UBound(OutputArray)) '保留用来写m_OpCode
End If

If IsHaveParameter = True Then
'带参数的情况在此执行
'崩溃在这段代码,估计是GetCodeStart的压栈问题,VB的内部函数接口和DLL的函数接口不知道是不是都是__stdcall的
ExecuteFunc = CallWindowProc(GetCodeStart(hProcAddress, OutputArray), 0, 1, 2, 3)
Else
'不带参数的情况在此执行,这里可以执行成功
ExecuteFunc = CallWindowProc(hProcAddress, 0, 1, 2, 3)
End If
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 'GetCodeStart的函数返回值只在这里赋值,m_OpCode是个空的数组,估计这里是函数与参数的内存地址
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'估计函数和参数的内存地址在这里压栈,对DLL的函数和参数是这样压栈的,但是对内部函数和参数如何压栈?
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
...全文
588 5 打赏 收藏 转发到动态 举报
AI 作业
写回复
用AI写文章
5 条回复
切换为时间正序
请发表友善的回复…
发表回复
wtogether 2009-02-03
  • 打赏
  • 举报
回复
原来这样,那么最多只能带四个参数,非常感谢
Tiger_Zhao 2009-02-03
  • 打赏
  • 举报
回复
内部函数指针调用很简单,只要保证函数和 WindowProc 一致就可以了。
原理可 Google: Visual Basic变态用法之函数指针
Option Explicit

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

Sub Main()
Dim fp As Long
fp = FARPROC(AddressOf Max)
Debug.Print CallWindowProc(fp, 3, 2, 0, 0)
End Sub

Function Max(ByVal v1 As Long, ByVal v2 As Long, ByVal Dummy3 As Long, ByVal Dummy4 As Long) As Long
Max = IIf(v1 > v2, v1, v2)
End Function

Function FARPROC(ByVal fp As Long) As Long
FARPROC = fp
End Function
Tiger_Zhao 2009-02-03
  • 打赏
  • 举报
回复
用 Any 类型的参数传递 UDT,可以包含任意信息
Option Explicit

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, _
ByRef lParam As Any) As Long '<-注意 lParam 的类型

Type LongArray
'这里可以定义任意多的成员
Items() As Long
End Type

Sub Main()
Dim a As LongArray
Dim fp As Long

ReDim a.Items(4)
a.Items(0) = 20
a.Items(1) = 8
a.Items(2) = 7
a.Items(3) = 9
a.Items(4) = 11
fp = FARPROC(AddressOf Sum)
Debug.Print CallWindowProc(fp, 0, 0, 0, a)
End Sub

Function Sum(ByVal Dummy1 As Long, ByVal Dummy2 As Long, ByVal Dummy3 As Long, Data As LongArray) As Long
Dim lSum As Long
Dim i As Long
For i = LBound(Data.Items) To UBound(Data.Items)
lSum = lSum + Data.Items(i)
Next
Sum = lSum
End Function

Function FARPROC(ByVal fp As Long) As Long
FARPROC = fp
End Function
fjwyshan 2009-02-02
  • 打赏
  • 举报
回复
不懂,up
noenoughmemory 2009-02-02
  • 打赏
  • 举报
回复
不懂,up

1,488

社区成员

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

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