vb动态加载dll的一个类,实现vb动态加载dll并动态调用dll导出的函数的一个方便办法

自从会vb用调用动态库函数以来,我一直在想:如何动态的调用dll里的函数?网上有一个用CallWindowProc函数的方法,不过我还是喜欢自己有个

办法.今天工夫不负有心人,我终于把我心中一直想的办法给实现了,干脆就往自己的空间上贴吧.错误的地方,希望可以得到有这方面的师傅给以

指正,以求进步!对于系统api我没有尝试,如果调用约定相符,应该适用于对系统api的调用.
我自己用c写个dll,然后在vb里写了这个类.
以下代码只是我简单的实现,主要的是看实现的道理.
vc代码:
///
'我把dll文件名命名为:dll
#include <Windows.h>
#include <stdlib.h>
#include <string.h>
#include 'stdafx.h'

BOOL APIENTRY DllMain( HANDLE hModule,
                       DWORD  ul_reason_for_call,
                       LPVOID lpReserved
                     )
{
      return TRUE;
}

extern 'C' BOOL _declspec(dllexport) add(int a)
{
        MessageBoxA(NULL,'运行在dll里!','成功',MB_OK);
        a=999;
        return 1;
}
///
vb代码:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'类代码:
Private 状态标志 As Boolean
Private 模块句柄 As Long
Private 本地函数地址备份(0 To 4) As Byte
Private 被替换函数的地址 As Long

Public Function 替换函数地址(模块名 As String, 函数名 As String, 本地函数地址 As Long) As Boolean       
       
        If 0 = 本地函数地址 Then
               替换函数地址 = 0
               Exit Function
        End If       
        被替换函数的地址 = 替换函数地址
       
        Dim 函数地址 As Long
        Dim a As Long
        Dim 跳转指令(0 To 4) As Byte      
        '加载模块
        模块句柄 = LoadLibrary(模块名)
        If 0 <> 模块句柄 Then
                '状态标志 = 1
        Else:
                替换函数地址 = 0
                Exit Function
        End If
       
        '检索函数地址
        函数地址 = GetProcAddress(ByVal 模块句柄, ByVal 函数名)
        If 0 <> 函数地址 Then
                '状态标志 = 1
        Else
                替换函数地址 = 0
                Exit Function
        End If
       
        '计算跳转地址
        a = 函数地址 - (本地函数地址 + 5)
       
        '构造跳转地址
        跳转指令(0) = 233
        a = WriteProcessMemory(-1, ByVal VarPtr(跳转指令(1)), ByVal VarPtr(a), 4, 0)
        If 0 = a Then
              替换函数地址 = 0
              Exit Function
        End If
       
        '先备份本地函数入口指令
        a = WriteProcessMemory(-1, ByVal VarPtr(本地函数地址备份(0)), ByVal 本地函数地址, 5, 0)
        If 0 = a Then
              替换函数地址 = 0
              Exit Function
        End If
       
        '写入跳转指令
        a = WriteProcessMemory(-1, ByVal 本地函数地址, ByVal VarPtr(跳转指令(0)), 5, 0)
        If 0 = a Then
              替换函数地址 = 0
              Exit Function
        Else:
              状态标志 = 1
              替换函数地址 = 1
        End If
       
End Function

Public Function 还原函数地址() As Boolean

If 0 = 状态标志 Then
               还原函数地址 = 0
               Exit Function
        End If
       
        Dim a As Long
        a = WriteProcessMemory(-1, ByVal 被替换函数的地址, ByVal VarPtr(本地函数地址备份(0)), 5, 0)
        If 0 = a Then
              还原函数地址 = 0
              Exit Function
        Else:
              状态标志 = 0
              还原函数地址 = 1
        End If
        FreeLibrary 模块句柄
       
End Function

Public Function 当前状态() As Boolean
        当前状态 = 状态标志
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'vb普通模块代码:
'读写内存的api函数
Public Declare Function WriteProcessMemory Lib 'kernel32' (ByVal hProcess As Long, ByVal _
       lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long

'加载模块的api函数
Public Declare Function LoadLibrary Lib 'kernel32' Alias 'LoadLibraryA' (ByVal lpLibFileName As String) As Long

'检索模块里函数地址的api函数
Public Declare Function GetProcAddress Lib 'kernel32' (ByVal hModule As Long, ByVal lpProcName As String) As Long

'
Public Declare Function FreeLibrary Lib 'kernel32' (ByVal hLibModule As Long) As Long

'模拟一个函数与dll里,我们想调用函数类型和参数一致, 用类将函数的地址替换
Public Function 测试函数(参数 As Long) As Boolean
       '我们随便给返回0,因为这个指令将不会被程序执行到
       测试函数 = 0
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'vb窗口模块代码:
Private Sub Form_Load()
        Dim 模块名 As String, 函数名 As String
        模块名 = App.Path + '/dll.dll'
        '模块名现在可以自己定了,自由了!
        函数名 = 'add'
        Dim p As Boolean
        Dim aa As New Class1
        p = aa.替换函数地址(模块名, 函数名, AddressOf 测试函数)
        If p Then
             测试函数 0
             '将会弹出对话筐:运行在dll里!
             aa.还原函数地址
        End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

(0)

相关推荐