VB動態呼叫外部函式的方法 (轉)

VB動態呼叫外部函式的方法 (轉)[@more@]

VB可以用Declare宣告來標準DLL的外部，但是其侷限性也很明顯：利用Declare我們只能載入在設計時透過Lib和Alias字句指定的函式指標！而不能在執行時指定由我們自己動態載入的函式指標），不能用Declare語句來呼叫任意的函式指標。當我們想動態呼叫外部函式的時候，就必須考慮採用其他的輔助方法，來完成這個任務了。

在文章《/develop/read_article.?id=12882">VB真是想不到系列之三：VB指標葵花寶典之函式指標 》、《Matthew Curland的VB函式指標呼叫》、《》等文獻中對此問題都進行了一定程度上的討論，但是頭緒都很繁瑣，對我這樣的菜鳥還有點深奧，在資料搜尋過程中，找到透過在VB中調入匯序，比較簡便的實現了這個功能，下面就是實現原理：

1）使用LoadLibrary載入DLL；
2）GetProcAddress獲得函式指標；

以上兩步得到了預載入函式的指標，但是VB中沒有提供使用這個指標的方法。我們可以透過一段語言，來完成函式指標的呼叫！

3）透過組合語言，把函式的所有引數壓入堆疊，然後用Call待用函式指標就可以了。

實現以上功能的主要：
'載入Dll
LibAddr = LoadLibrary(ByVal "user32")
'獲得函式指標
ProcAddr = GetProcAddress(LibAddr, ByVal "MessageBoxA")
'原型為MessageBox(hWnd, lpText, lpCaption, uType)

'---以下為Assembly部分---
push uType
push lpCaption
push lpText
push hWnd
call ProcAddr
'--------------------

FreeLibrary LibAddr'釋放空間

嘿，夠簡單吧！下面是動態呼叫MessageBoxA的，上面的步驟被封裝到RunDll32函式中，可放到模組（CallbyName.bas）中：
  Dim s1() As Byte, s2() As Byte
  Dim ret As Long
  s1 = StrConv("Hello~World", vbFromUnicode)
  s2 = StrConv("VBNote", vbFromUnicode)
  ret = RunDll32("user32", "MessageBoxA", hwnd, Vtr(s1(0)), VarPtr(s2(0)), 0&)

CallAPIbyName.bas中的原始碼：

Option Explicit

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, lp As Any, ByVal cBytes As Long)

Public m_opIndex As Long '寫入位置
Private m_OpCode() As Byte  'Assembly 的OPCODE

Public Function RunDll32(LibFileName As String, ProcName As String, ParamArray Params()) As Long
  Dim hProc As Long
  Dim hModule As Long
 
  ReDim m_OpCode(400 + 6 * UBound(Params)) '保留用來寫m_OpCode
  '讀取API庫
  hModule = LoadLibrary(ByVal LibFileName)
  If hModule = 0 Then
  MsgBox "Library讀取失敗！"
  Exit Function
  End If
 
  '取得函式地址
  hProc = GetProcAddress(hModule, ByVal ProcName)
  If hProc = 0 Then
  MsgBox "函式讀取失敗！", vbCritical
  FreeLibrary hModule
  Exit Function
  End If
 
 
  'Assembly Code部分
  RunDll32 = CallWindowProc(GetCodeStart(hProc, Params), 0, 1, 2, 3)
 
  FreeLibrary hModule '釋放空間
End Function

Private Function GetCodeStart(ByVal lngProc As Long, ByVal arrParams As Variant) As Long
'---以下為Assembly部分--
'作用：將函式的引數壓入堆疊
 
  Dim lngIndex As Long, lngCodeStart As Long
 
  '程式起始位址必須是16的倍數
  'VarPtr函式是用來取得變數的地址
  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 'int 3
  Next lngIndex
 
  '--------以下開始放入所需的程式----------
 
  '將引數push到堆疊
  '由於是STDCall CALL 引數由最後一個開始放到堆疊
  For lngIndex = UBound(arrParams) To 0 Step -1
  AdyteToCode &H68 'push的機器碼為H68
  AddLongToCode CLng(arrParams(lngIndex))  '引數地址
  Next lngIndex
 
  'call hProc
  AddByteToCode &HE8 'call的機器碼為HE8
  AddLongToCode lngProc - VarPtr(m_OpCode(m_opIndex)) - 4 '函式地址 用call的定址
 
  '-----------結束所需的程式--------------
 
  '返回呼叫函式
  AddByteToCode &HC2 'ret 10h
  AddByteToCode &H10
  AddByteToCode &H0
 
  GetCodeStart = lngCodeStart
End Function

Private Sub AddLongToCode(lData As Long)
'將Long型別的引數寫到m_OpCode中
  CopyMemory m_OpCode(m_opIndex), lData, 4
  m_opIndex = m_opIndex + 4
End Sub

Private Sub AddIntToCode(iData As Byte)
'將Integer型別的引數寫道m_OpCode中
  CopyMemory m_OpCode(m_opIndex), iData, 2
  m_opIndex = m_opIndex + 2
End Sub

Private Sub AddByteToCode(bData As Byte)
  '將Byte型別的引數寫道m_OpCode中
  m_OpCode(m_opIndex) = bData
  m_opIndex = m_opIndex + 1
End Sub