VB动态调用外部API函数的方法

原创 2008年09月28日 14:35:00

这么久了都没放出过什么比较好的程序出来,让大家失望了。前段时间无聊搞了个类,今天拿出来和大家分享一下。
主要是实现在VB中动态调用API函数的类,才疏学浅,见笑了。

Visual Basic Code
'******************************************************************************** 

'Name.......... APIClass 
'File.......... APIClass.cls 
'Version....... 1.0.0 
'Dependencies.. kernel32.DLL 
'Author........ Supermanking   
'Date.......... Apr, 17nd 2008 
'UpdateURL..... http://bbs.rljy.com/?m=vbAPIClass 

'Copyright (c) 2008 by www.rljy.com 
'Liuzhou city, China 

'******************************************************************************** 
Option Explicit  
'============================================================================== 
'数据类型定义 
'============================================================================== 
Private Type VariableBuffer  
    VariableParameter (   )   As Byte  
End Type  
'============================================================================== 
'API 函数声明 
'============================================================================== 
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  
'******************************************************************************** 
'**  作    者 :    人类(Supermanking) 
'**  函 数 名 :    ExecuteAPI 
'**  输    入 :    LIBPath(String)        -  刷新的目标窗口句柄,可为0 
'**            :    APIScript(String)      -  场景图像的宽度 
'**  返    回 :    (Long)                  -  返回零表示失败,非零表示成功 
'**  功能描述 :    动态执行类库里的API函数 
'**  创建日期 :    2008-04-17 
'**  修 改 人 : 
'**  修改日期 : 
'**  版    本 :    Version 1.0.0 
'******************************************************************************** 
Public Function ExecuteAPI ( LibPath As String, APIScript As String )   As Long  
    Dim hProcAddress As Long, hModule As Long, X As Long, Y As Long  
    Dim RetLong As Long, FunctionName As String, FunctionParameter As String  
    Dim LongCount As Long, StringInfo As String, StrByteArray (   )   As VariableBuffer  
    Dim StringSize As Long, ByteArray (   )   As Byte, IsHaveParameter As Boolean  
    Dim ParameterArray (   )   As String, OutputArray (   )   As Long  
    StringSize   =   0  
    ReDim StrByteArray ( StringSize )    
  '识别函数名称 
    RetLong   =   InStr ( 1, APIScript, " ", vbTextCompare )    
    If RetLong   =   0 Then  
      '没有参数的函数 
            FunctionName   =   APIScript  
            IsHaveParameter   =   False  
    Else  
      '带参数的函数 
            FunctionName   =   Left ( APIScript, RetLong - 1 )    
            IsHaveParameter   =   True  
             
      '识别函数参数 
            FunctionParameter   =   Right ( APIScript, Len ( APIScript )   - RetLong )    
     
      '分析函数参数 
            ParameterArray   =   Split ( FunctionParameter, "," )    
     
      '初始化函数内存大小 
            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  
     
  '读取API库 
    hModule   =   LoadLibrary ( ByVal LibPath )    
    If hModule   =   0 Then  
            ExecuteAPI   =   0   'Library 读取失败  
            Exit Function  
    End If  

  '取得函数地址 
    hProcAddress   =   GetProcAddress ( hModule, ByVal FunctionName )    
    If hProcAddress   =   0 Then  
            ExecuteAPI   =   0   '函数读取失败  
            FreeLibrary hModule  
            Exit Function  
    End If  
     
    If IsHaveParameter   =   True Then  
      '带参数的情况在此执行 
            ExecuteAPI   =   CallWindowProc ( GetCodeStart ( hProcAddress, OutputArray ) , 0, 1, 2, 3 )    
    Else  
      '不带参数的情况在此执行 
            ExecuteAPI   =   CallWindowProc ( hProcAddress, 0, 1, 2, 3 )    
    End If  
     
  '释放库空间 
    FreeLibrary hModule  
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  
        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  
        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

使用方法也很简单,我举个例子:
Visual Basic Code
Private Sub Command1_Click (   )    
      Dim API As New APIClass  
      Dim APIScript As String  
   '最简单的调用API函数 
      APIScript   =   "MessageBoxA 0, ""这是动态调用API函数显示的MSGBOX内容,下面将要在作面画一笔。"", ""API信息提示"", 0"  
      API.ExecuteAPI "C:/WINDOWS/system32/user32.dll", APIScript  
         
   '=============在作面画画============ 
      Dim DesktophWnd As Long, DesktophDC As Long  
   '取得桌面窗口句柄 
      DesktophWnd   =   API.ExecuteAPI ( "C:/WINDOWS/system32/user32.dll", "GetDesktopWindow" )    
   '取得桌面窗口设备句柄 
      DesktophDC   =   API.ExecuteAPI ( "C:/WINDOWS/system32/user32.dll", "GetWindowDC " & DesktophWnd )    
   '在作面设备上画一条线 
      API.ExecuteAPI "C:/WINDOWS/system32/gdi32.dll", "LineTo " & DesktophDC & "," & Screen.Width / 15 & "," & Screen.Height / 15  
End Sub  

VB调用API函数

API函数快速入门--怎样在VB中声明和使用API函数--       一、在VB中声明API函数有两种方法:如果我们只在某个窗体中使用API函数,我们可以在窗体代码的 General部分声明它: ...
  • lunkay
  • lunkay
  • 2016年01月13日 20:17
  • 4813

VB6.0 Windows API

VB6.0 Windows API1.控件与消息函数AdjustWindowRect 给定一种窗口样式,计算获得目标客户区矩形所需的窗口大小AnyPopup 判断屏幕上是否存在任何弹出式窗口Arran...
  • asftrhgjhkjlkttttttt
  • asftrhgjhkjlkttttttt
  • 2011年06月21日 10:54
  • 3525

VB外接API函数

VB外接API函数            API,即应用程序编程接口,是一些预定义的函数,API函数包括在windows系统目录下的动态链接库中,凡是在Windows工作环境底下执行的应用程序,都可以...
  • nangeali
  • nangeali
  • 2015年06月14日 20:47
  • 812

VB动态调用外部API函数的方法

这么久了都没放出过什么比较好的程序出来,让大家失望了。前段时间无聊搞了个类,今天拿出来和大家分享一下。主要是实现在VB中动态调用API函数的类,才疏学浅,见笑了。Visual Basic Code**...
  • SupermanKing
  • SupermanKing
  • 2008年09月28日 14:35
  • 5371

VB外部调用AutoCAD

VB外部操作AutoCAD的方法及步骤 1、IDE以vs2010为例。打开vs2010,新建项目     2、选择左侧Visual Basic模板,选择Windows窗体应用程序,输入应用程序...
  • wangluozhangleilei
  • wangluozhangleilei
  • 2014年08月13日 12:18
  • 1590

VB动态调用外部API函数的方法

这么久了都没放出过什么比较好的程序出来,让大家失望了。前段时间无聊搞了个类,今天拿出来和大家分享一下 主要是实现在VB中动态调用API函数的类,才疏学浅,见笑了。 Visual Bas...
  • sdgaojian
  • sdgaojian
  • 2013年12月29日 16:38
  • 445

vb怎么声明api函数:VB中声明和使用API函数

一、在VB中声明API函数有两种方法:如果我们只在某个窗体中使用API函数,我们可以在窗体代码的General部分声明它:    声明的语法是:    Private Declare Function...
  • nfenghklibra
  • nfenghklibra
  • 2008年10月18日 20:59
  • 1811

VB动态调用外部API函数的方法

VB code ***************************************************************************
  • ssihc0
  • ssihc0
  • 2008年10月10日 23:57
  • 850

API入门教程

什么是API 首先,有必要向大家讲一讲,什么是API。所谓API本来是为C和C++程序员写的。API说来说去,就是一种函数,他们包含在一个附加名为DLL的动态连接库文件中。用标准的定义来讲,API就是...
  • microt
  • microt
  • 2008年03月27日 14:42
  • 402

VB动态调用外部函数的方法

VB可以用Declare声明来调用标准DLL的外部函数,但是其局限性也很明显:利用Declare我们只能载入在设计时通过Lib和Alias字句指定的函数指针!而不能在运行时指定由我们自己动态载入的函数...
  • treewith
  • treewith
  • 2003年04月18日 08:50
  • 1016
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:VB动态调用外部API函数的方法
举报原因:
原因补充:

(最多只允许输入30个字)