VBS调用Win32 Api函数删除文件

用fso删除文件时不作任何提示直接删除了，也不放入回收站，该如何解决？
下面看看如何解决用fso删除文件时不作任何提示直接删除了，也不放入回收站的问题

使用Win32 Api函数删除文件，以下可以使用vba中：

'删除文档的API
Private Declare Function SHFileOperation Lib "shell32.dll" _
    Alias "SHFileOperationA" (lpFileOp As ToBin) As Long
    
'清空回收站的API
Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" _
    Alias "SHEmptyRecycleBinA" (ByVal hwnd As Long, ByVal pszRootPath As String, ByVal dwFlags As Long) As Long
 

Private Type ToBin
    hwnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Long
    hNameMappings As Long
    lpszProgressTitle As Long
End Type

'fFlag 常数
Const FOF_ALLOWUNDO = &H40                  '允许 Undo 。
Const FOF_NOCONFIRMATION = &H10             '不显示系统确认对话框。
Const FOF_NOCONFIRMMKDIR = &H200            '不提示是否新建目录。
Const FOF_SILENT = &H4                      '不显示进度对话框。
Const FOF_FILESONLY = &H80                  '执行通配符，只执行文件。
Const FOF_NOERRORUI = &H400                 '当文件处理过程中出现错误时，不出现错误提示。
Const FOF_RENAMEONCOLLISION = &H8           '当已存在文件名时，对其进行更换文提示。

Public Const FO_DELETE = &H3

Public Const SHERB_NORMAL = &H0
Public Const SHERB_NOCONFIRMATION = &H1     '表示不显示确认视窗
Public Const SHERB_NOPROGRESSUI = &H2       '表示不显示清空资源回收站的动画视窗 (经测试98原本已不会出现动画)
Public Const SHERB_NOSOUND = &H4            '表示清空资源回收站之后不出现声音


Public Sub RunTest()
    DelFileToBin "d:\temp\aaa.xls"
End Sub


'===========================================================
' 过程及函数名：  DelFileToBin
' 版本号      ：  --
' 说明        ：  将文档移至回收站。
' 测试环境    ：  win2003+office2007  chs
' 引用        ：  --
' 输入参数    ：  fileFullName 文件全名，包括路径
' 输出值      ：  --
' 返回值      ：  API 执行的结果
'                 0     没错误
'                 32    文件正在被占用
'                 1026  文件不存在
' 调用演示    ：  DelFileToBin "d:\temp\aaa.xls"
' 最后修改日期：  2008-2-28 23:36:00

' 作者        ：  cg1
' 网站        ：  http://access911.net
' 电子邮件    ：  access911@gmail.com
' 版权        ：  作者保留一切权力，
'                请在公布本代码时将本段说明一起公布，谢谢！
'===========================================================
Public Function DelFileToBin(ByVal fileFullName As String) As Long
    Dim objToBin As ToBin
    Dim strFile As String
    Dim lngResult As Long
    
    strFile = fileFullName
    
    With objToBin
        .wFunc = FO_DELETE
        .pFrom = strFile
        .fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION + FOF_NOERRORUI
    End With
    
    '注意，以下操作将会弹出对话框要求用户确认
    lngResult = SHFileOperation(objToBin)
    DelFileToBin = lngResult
    Select Case lngResult
    Case 1026
        '该文件或者资源不存在
    Case 0
        '在未设置 FOF_NOCONFIRMATION 时可能有两种情况
        '删除成功，或者用户取消删除。未出现错误都返回0
        If Dir(strFile) <> "" Then
            '客户取消了删除
        Else
            '删除成功
        End If
    Case 32
        '需要删除的文件正在被占用
    Case Else
        '其他错误
    End Select
End Function

'清空回收站
Private Sub ClsBin()
    Dim RetVal As Long
    RetVal = SHEmptyRecycleBin(0&, vbNullString, SHERB_NORMAL)
End Sub


'ToBin 结构体说明：
'  wFunc:
'    FO_COPY:     拷贝文件pFrom到pTo 的指定位置?
'    FO_RENAME:     将pFrom的文件名更名为pTo的文件名?
'    FO_MOVE:     将pFrom的文件移动到pTo的地方?
'    FO_DELETE:      删除pFrom指定的文件?
'
'　　使用该函数进行文件拷贝、移动或删除时，如果需要的时间很长，则程序会自动在进行的过程中出现一个无模式的对话框（Windows操作系统提供的文件操作对话框），用来显示执行的进度和执行的时间，以及正在拷贝、移动或删除的文件名，此时结构中的成员lpszProgressTitle显示此对话框的标题。fFlags是在进行文件操作时的过程和状态控制标识。它主要有如下一些标识，也可以是其组合：
'  fFlags：
'　　FOF_FILESONLY：执行通配符，只执行文件；
'　　FOF_ALLOWUNDO：保存UNDO信息，以便在回收站中恢复文件；
'　　FOF_NOCONFIRMATION：在出现目标文件已存在的时候，如果不设置此项，则它会出现确认是否覆盖的对话框，设置此项则自动确认，进行覆盖，不出现对话框。
'　　FOF_NOERRORUI：设置此项后，当文件处理过程中出现错误时，不出现错误提示，否则会进行错误提示。
'　　FOF_RENAMEONCOLLISION：当已存在文件名时，对其进行更换文提示。
'    FOF_SILENT:     不显示进度对话框?
'　　FOF_WANTMAPPINGHANDLE：要求SHFileOperation()函数返回正处于操作状态的实际文件列表，文件列表名柄保存在hNameMappings成员中。
'　　SHFILEOPSTRUCT结构还包含一个SHNAMEMAPPING结构的数组，此数组保存由SHELL计算的每个处于操作状态的文件的新旧路径。
'
'　　注意：在使用该函数删除文件时必须设置SHFILEOPSTRUCT结构中的神秘FOF_ALLOWUNDO标志，这样才能将待删除的文件拷到Recycle Bin，从而使用户可以撤销删除操作。需要注意的是，如果pFrom设置为某个文件名，用FO_DELETE标志删除这个文件并不会将它移到Recycle Bin，甚至设置FOF_ALLOWUNDO标志也不行，在这里你必须使用全路径名，这样SHFileOperation才会将删除的文件移到Recycle Bin。

 

 

 

出处：http://www.access-cn.com/info/2029-cn.html

=======================================================================================

VBS调用系统API

如Beep的API声明为

Public Declare Function Beep Lib “kernel32″ Alias “Beep” (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

则使用方法如下

'创建对象
Set Wrap = CreateObject("DynamicWrapper")
'注册API
Wrap.Register "KERNEL32.DLL", "Beep", "i=ll", "f=s", "r=l"
'调用API
Wrap.Beep(500, 100)

其中注册API中， “i=ll”是API的参数类型, “f=s”是调用方式, “r=l”是返回类型
这些可以参考下面的说明。

REM i: (Argument Type)
REM 'a', sizeof(IDispatch*), VT_DISPATCH}	// a IDispatch*
REM 'c', sizeof(unsigned char), VT_I4}		// c signed char
REM 'd', sizeof(double), VT_R8}			// d 8 byte real
REM 'f', sizeof(float), VT_R4}			// f 4 byte real
REM 'k', sizeof(IUnknown*), VT_UNKNOWN}		// k IUnknown*
REM 'h', sizeof(long), VT_I4}			// h HANDLE
REM 'l', sizeof(long), VT_I4}			// l long
REM 'p', sizeof(void*), VT_PTR}			// p pointer
REM 's', sizeof(BSTR), VT_LPSTR}		// s string
REM 't', sizeof(short), VT_I2}			// t short
REM 'u', sizeof(UINT), VT_UINT}			// u unsigned int
REM 'w', sizeof(BSTR), VT_LPWSTR}		// w wide string

REM f: (Call Method)
REM 'm' - DC_MICROSOFT 0x0000, Default
REM 'b' - DC_BORLAND 0x0001, Borland compat
REM 's' - DC_CALL_STD 0x0020, __stdcall
REM 'c' - DC_CALL_CDECL 0x0010, __cdecl
REM '4' - DC_RETVAL_MATH4 0x0100, Return value in ST
REM '8' - DC_RETVAL_MATH8 0x0200, Return value in ST

REM r: (Return Type)
REM Same as i

示例：

'用机箱内的蜂鸣器播放音乐
Sub BeepMusic()
	Set Wrap = CreateObject("DynamicWrapper")
	Wrap.Register "KERNEL32.DLL", "Beep", "i=ll", "f=s", "r=l"
	res = Wrap.Beep(500, 100)
	res = Wrap.Beep(550, 100)
	res = Wrap.Beep(600, 100)
	res = Wrap.Beep(650, 100)
	res = Wrap.Beep(700, 700)
	WScript.Sleep 200
	res = Wrap.Beep(700, 100)
	res = Wrap.Beep(650, 100)
	res = Wrap.Beep(600, 100)
	res = Wrap.Beep(550, 100)
	res = Wrap.Beep(500, 700)
End Sub
BeepMusic

'取前景窗体标题
Sub GetForeWindowCaption()
	Const WM_GETTEXT = &HD
	Set Wrap = CreateObject("DynamicWrapper")
	Wrap.Register "USER32.DLL", "GetForegroundWindow", "f=s", "r=l"
	Wrap.Register "USER32.DLL", "SendMessage", "i=lllr", "f=s", "r=l"
	Title = Space(100)
	res = Wrap.SendMessage(Wrap.GetForegroundWindow(), WM_GETTEXT , 100, Title)
	GetForeWindowCaption = Title
End Sub
MsgBox GetForeWindowCaption

'发送键盘消息，显示桌面
Sub ShowDesktop()
	Const VK_LWIN = &H5B
	Const VK_D = &H44
	Public Const KEYEVENTF_KEYUP = &H2
	Set Wrap = CreateObject("DynamicWrapper")
	Wrap.Register "USER32.DLL", "keybd_event", "i=ccll", "f=s"
	Wrap.keybd_event VK_LWIN, 0, 0, 0
	Wrap.keybd_event VK_D, 0, 0, 0
	Wrap.keybd_event VK_D, 0, KEYEVENTF_KEYUP, 0
	Wrap.keybd_event VK_LWIN, 0, KEYEVENTF_KEYUP, 0
End Sub
ShowDesktop

 

出处：https://www.cnblogs.com/jinjiangongzuoshi/p/3907008.html

=======================================================================================

VBS调用windows api函数实现后台发送按键脚本

'==========================================================================
'
' VBScript Source File -- Created with SAPIEN Technologies PrimalScript 4.0
'
' NAME:
'
' AUTHOR: Microsoft , Microsoft
' DATE : 2014/8/10
'
' COMMENT:
'
'===================定义变量，注册API对象==================================
Dim UserWrap,hWnd

Set UserWrap = CreateObject("DynamicWrapper")
Set ws=WScript.CreateObject("wscript.shell")

WScript.Sleep 500

ws.Run "calc",0

WScript.Sleep 500

'Declare Function ShowWindow Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
UserWrap.Register "USER32.DLL", "ShowWindow", "I=hl", "f=s", "R=l"

'Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

UserWrap.Register "USER32.DLL", "FindWindow", "I=ss", "f=s", "R=l"

'Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

UserWrap.Register "USER32.DLL", "SetWindowPos", "I=Hllllll", "f=s", "R=l"

'Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any)
UserWrap.Register "USER32.DLL", "PostMessage", "I=hlls", "f=s", "R=l"

'Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
UserWrap.Register "USER32.DLL", "SetWindowText", "I=Hs", "f=s", "R=l"

'Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
UserWrap.Register "USER32.DLL", "FindWindowEx", "I=llss", "f=s", "R=l"

'Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long

UserWrap.Register "USER32.DLL", "SetCursorPos", "I=ll", "f=s", "R=l"

'===================查找控件或者窗体句柄===============================

hWnd = UserWrap.FindWindow(vbNullString,"计算器")
'hWnd = UserWrap.FindWindow("kugou_ui",vbNullString)

hWnd1 = UserWrap.FindWindowEx(hWnd,0,vbNullString,Edit)

'UserWrap.ShowWindow hWnd,SW_HIDE

'UserWrap.SetWindowText hWnd,"hello world"

' MsgBox hWnd
' MsgBox hWnd1

'UserWrap.SetWindowPos hWnd, -1, 0, 0, 0, 0, 3

'MsgBox "将鼠标移到左上角"

'UserWrap.SetCursorPos 0,0

'=================定义系统常量===========================

Private Const WM_KEYDOWN = &H100
Private Const wm_keyup= &H101
Private Const WM_CHAR = &H102
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105

'=================发送F1按键=====================
UserWrap.PostMessage hWnd, WM_KEYDOWN, 112, 0

'=================发送1002========================
UserWrap.PostMessage hWnd,WM_KEYDOWN ,97,0
UserWrap.PostMessage hWnd,WM_KEYDOWN ,96,0
UserWrap.PostMessage hWnd,WM_KEYDOWN ,96,0
UserWrap.PostMessage hWnd,WM_KEYDOWN ,98,0

VBS调用windows api函数（postmessage）实现后台发送按键脚本的更多相关文章

1. VBS调用Windows API函数

   Demon's Blog 忘记了,喜欢一个人的感觉 Demon's Blog  »  程序设计  »  VBS调用Windows API函数 « 用VBS修改Windows用户密码 在VB中创建和使用 ...

2. C#调用Windows API函数截图

   界面如下: 下面放了一个PictureBox 首先是声明函数: //这里是调用 Windows API函数来进行截图 //首先导入库文件 [System.Runtime.InteropServices ...

3. Python调用Windows API函数编写录音机和音乐播放器

   功能描述: 1)使用tkinter设计程序界面: 2)调用Windows API函数实现录音机和音乐播放器. . 参考代码: ​ 运行界面: ​

4. MFC中调用Windows API函数的方式

   windows aoi 函数的调用前面加::

5. c#让窗体永在最前 调用windows api 将窗体设为topmost

   有时候应用程序需要将一个窗体始终位于屏幕的最前面,即使切换到其它窗体也能看到该窗体,这样的窗体就叫做TopMost窗体. 用C#制作TopMost窗体之前,首先要了解如何声明SetWindowPos函 ...

6. Windows API 函数列表 附帮助手册

   所有Windows API函数列表,为了方便查询,也为了大家查找,所以整理一下贡献出来了. 帮助手册:700多个Windows API的函数手册 免费下载 API之网络函数 API之消息函数 API之 ...

7. WINDOWS API 函数（超长，值得学习）

   一.隐藏和显示光标 函数: int ShowCursor ( BOOL bShow );  参数 bshow,为布尔型,bShow的值为False时隐藏光标,为True时显示光标:该函数的返回值为整型 ...

8. Windows API函数大全（精心总结）

   WindowsAPI函数大全(精心总结)    目录 1. API之网络函数... 1 2. API之消息函数... 1 3. API之文件处理函数... 2 4. API之打印函数... 5 5. ...

9. Windows API函数大全(完整)

   Windows API函数大全,从事软件开发的朋友可以参考下 1. API之网络函数 WNetAddConnection 创建同一个网络资源的永久性连接 WNetAddConnection2 创建同一 ...

随机推荐

1. [转]C#读写TEXT文件

   1.使用FileStream读写文件 文件头: using System; using System.Collections.Generic; using System.Text; using Sys ...

2. 使用jquery的delay方式模拟sleep

   javascript中并没有原生sleep函数可供调用,一般来说为了实现sleep功能,大都是采用SetTimeout来模拟,以下片段采用jquery的delay方法来模拟,也算是提供了另外一个视角吧 ...

3. iOS学习笔记---c语言第十天

   动态内存分配 一.存储区划分 从低到高(内存地址小----内存地址大)  :  代码区---常量区---静态区---堆区---栈区 栈内存 //凡是在函数体内定义的变量 都存储在栈区(包括形参). ; ...

4. Html table 实现Excel多格粘贴

   Html table 实现Excel多格粘贴 电商网站的后台总少不了各种繁杂数据的录入,旁边的运营妹子录完第138条商品的时候,终于忍不住转身吼到:为什么后台的录入表不能像Excel那样多行粘贴!!! ...

5. LATEX学习笔记1

   LATEX源文件的结构分三大部分,依次为:文档类声明.序言(可选).正文. 文档结构 \documentclass{article} \usepackage{amsmath} \usepackage{ ...

6. 欧几里德算法gcd及其拓展终极解释

   这个困扰了自己好久,终于找到了解释,还有自己改动了一点点,耐心看完一定能加深理解   扩展欧几里德算法-求解不定方程,线性同余方程. 设过s步后两青蛙相遇,则必满足以下等式: (x+m*s)-(y+n ...

7. 最新VMware Workstation 10注册码，绝对可用！

   最近公司要在solaris上测试产品,需要用到虚拟机,于是下载了最新的虚拟机VMware Workstation 10,并找到了破解码,与大家共享: VMware workstation 10破解序列 ...

8. 面向切面编程之cglib代理方式

   思想: 和上一篇面向切面编程之手动JDK代理方式上的需求和开发模式一样.不同的是目标类没有接口,只有实现类,采用的是spring中提供的Enhancer类继承目标类实现的代理方式. 需要导入的jar包 ...

9. SDL2源代码分析5：更新纹理（SDL_UpdateTexture()）

   ===================================================== SDL源代码分析系列文章列表: SDL2源代码分析1:初始化(SDL_Init()) SDL ...

10. JavaScript面向对象--多态

    一.多态的概念 相同的函数作用于不同的对象,会得到不同的结果,这就是多态. 二.如果不用多态,会怎么样? 这里有个浅显易懂的例子,定义一个函数叫makeSound,传入不同的对象,函数体里要写不同的情 ...

 

出处：https://www.bbsmax.com/A/Ae5R1nDrJQ/

=======================================================================================

VBS动态注册DLL和卸载DLL

主要是使用的CreateObject("Wscript.Shell").Run方法，实现执行命令的功能。

直接看代码吧：

Set objShell=CreateObject("Wscript.Shell")
objShell.Run "regsvr32 /s COM_Test.dll",,true
Set obj=CreateObject("COM_Test.clsAdd")
'Set obj=CreateObject("Project1.clsAdd")'CreateObject的参数为"工程名.类模块名"，工程名不一定是工程文件名，类模块名不一定是类模块文件名
smsg="4+7=" & obj.Add2(4,7)'传值
WScript.Echo smsg
a=3
b=5
smsg="3+5=" & obj.Add2(a,b)'也是传值
msgbox smsg
smsg="3+5=" & obj.Add(3,5)'也是传值
msgbox smsg
Set obj = Nothing
objShell.Run "regsvr32 /s /u COM_Test.dll"
Set objShell=Nothing
Set objShell=CreateObject("Wscript.Shell")
objShell.Run "regsvr32 /s vbcomadvapi.dll",,true
Set obj=CreateObject("vbcomadvapi.vbadvapi")'CreateObject的参数为"工程名.类模块名"，工程名不一定是工程文件名，类模块名不一定是类模块文件名
smsg="GetExtension2(C:\\TES2B3B.tmp0)=" & obj.GetExtension2("C:\\TES2B3B.tmp0")
WScript.Echo smsg
Set obj = Nothing
objShell.Run "regsvr32 /s /u vbcomadvapi.dll"
Set objShell=Nothing
 '32位整数版的阶乘（VB/VC/VBS）
'Private Declare Function Factorial Lib "mydll.dll" (ByVal x As Long) As Long
'typedef int (*FACTORIAL)(int);
api.Register "mydll.dll", "Factorial","f=s","i=l", "r=l"
a=api.Factorial(10)
MsgBox a
'Private Declare Function Summary Lib "mydll.dll" (ByVal x As Long) As Long
'typedef int (*SUMMARY)(int);
'Summary(10)=55=1+2+…+10
api.Register "mydll.dll", "Summary","f=s","i=l", "r=l"
a=api.Summary(10)
MsgBox a
api.Register "DLL_Tutorial.dll", "Add","f=s","i=ll", "r=l"
a=api.Add(10,23)
MsgBox a
float __stdcall Atn(float x);
double __stdcall lfAtn(double x);
float __stdcall Atn2(float y,float x);
float __stdcall ReJT3(float zx, float zy,float tx, float ty);
float __stdcall ImJT3(float zx, float zy,float tx, float ty);
float __stdcall kq(float q);
float __stdcall ckq(float q);
api.Register "mydll.dll", "Atn","f=s","i=f", "r=f"
a=api.Atn(1.333333)
MsgBox a
api.Register "mydll.dll", "lfAtn","f=s","i=d", "r=d"
a=api.lfAtn(1.33333333333333)
MsgBox a
api.Register "mydll.dll", "Atn2","f=s","i=ff", "r=f"
a=api.Atn2(-1,0)
MsgBox a
api.Register "mydll.dll", "ReJT3","f=s","i=ffff", "r=f"
api.Register "mydll.dll", "ImJT3","f=s","i=ffff", "r=f"
a=api.ReJT3(0,0,0,0.5)
b=api.ImJT3(0,0,0,0.5)
MsgBox a & "+i" & b
api.Register "mydll.dll", "kq","f=s","i=f", "r=f"
k=api.kq(.207879576350762)
MsgBox "模k=" & k
api.Register "mydll.dll", "ckq","f=s","i=f", "r=f"
ck=api.ckq(.207879576350762)
MsgBox "余模k'=" & ck
 ?

测试例子GetTickCount.vbs：
Set objShell=CreateObject("Wscript.Shell")
objShell.Run "regsvr32 /s DynamicWrapper.dll",,true
'msgbox 256*256
Set api= CreateObject("DynamicWrapper")
api.Register "KERNEL32.DLL", "GetTickCount","f=s","r=l"
a=api.GetTickCount
msgbox "系统当前已运行" & a &"毫秒"
'499000
objShell.Run "regsvr32 /s /u DynamicWrapper.dll"
Set objShell=Nothing


Set objShell=CreateObject("Wscript.Shell")
objShell.Run "regsvr32 /s DynamicWrapper.dll",,true

'Example 1.
'Note: Calling format is: Microsoft compatible, Standard call, _stdcall."f=s"或"f=ms"
Set api= CreateObject("DynamicWrapper")
api.Register "KERNEL32.DLL", "GetTickCount","f=ms","r=l"
a=api.GetTickCount
msgbox "系统当前已运行" & a &"毫秒"

'"f=s"或"f=ms"换成"f=mc8"或"f=ms8"就不对了
api.Register "RGBlib.dll", "GetRedValue", "f=ms", "i=l", "r=l"
a=api.GetRedValue(256)
msgbox "GetRedValue(256)=" & a
a=api.GetRedValue(257)
msgbox "GetRedValue(257)=" & a
 
'Example 2.
'Note: Calling format is: Microsoft C call, _cdecl, 8 byte real value.
'Register some functions from the Microsoft C Run-Time library."f=mc8"或"f=ms8"
api.Register "MSVCRT.DLL", "sin", "f=ms8", "i=d", "r=d"
api.Register "MSVCRT.DLL", "cos", "f=mc8", "i=d", "r=d"
api.Register "MSVCRT.DLL", "sinh", "f=mc8", "i=d", "r=d"
api.Register "MSVCRT.DLL", "cosh", "f=mc8", "i=d", "r=d"
'"f=mc8"或"f=ms8"换成"ms"、"f=s"就不对了
' typedef double(__stdcall *pR)(double x);
api.Register "mathlib72.dll", "lsinn", "f=mc8", "i=d", "r=d"
api.Register "mathlib72.dll", "lgam1", "f=mc8", "i=d", "r=d"
api.Register "mathlib72.dll", "lexpp", "f=mc8", "i=d", "r=d"
api.Register "mathlib72.dll", "lcoss", "f=mc8", "i=d", "r=d"
'typedef double(__stdcall *pR)(double a=μ,double d=σ,double x);
api.Register "mathlib72.dll", "lgass", "f=mc8", "i=ddd", "r=d"
a=api.sin(1)
msgbox "sin(1)=" & a
'a=api.lsinn(1)
'msgbox "正弦积分Si(1)=lsinn(1)=" & a
'a=api.lsinn(0)
'msgbox "正弦积分Si(0)=lsinn(0)=" & a
'a=api.lsinn(1000)
'msgbox "正弦积分Si(1000)=lsinn(1000)=" & a
'a=api.lgam1(0.5)
'b=api.lgam1(0.5)*api.lgam1(0.5)/api.lgam1(1.0)'由伽马函数表示的贝塔函数
'msgbox "伽马函数Γ(0.5)=lgam1(0.5)=" & a
'msgbox "贝塔函数B(0.5,0.5)=" & b
'a=api.lexpp(0)
'msgbox "指数积分Ei(0)=" & a
'a=api.lexpp(0.5)
'msgbox "指数积分Ei(0.5)=" & a
'a=api.lexpp(1)
'msgbox "指数积分Ei(1)=" & a
'a=api.lexpp(1.5)
'msgbox "指数积分Ei(1.5)=" & a
'a=api.lexpp(1000)
'msgbox "指数积分Ei(1000)=" & a
a=api.lcoss(0)
msgbox "余弦积分Ci(0)=" & a
a=api.lcoss(0.5)
msgbox "余弦积分Ci(0.5)=" & a
a=api.lcoss(1)
msgbox "余弦积分Ci(1)=" & a
a=api.lcoss(1.5)
msgbox "余弦积分Ci(1.5)=" & a
a=api.lcoss(1000)
msgbox "余弦积分Ci(1000)=" & a
'a=api.lgass(0,1,-1)
'msgbox "标准正态分布函数lgass(0,1,-1)=" & a
'a=api.lgass(0,1,0)
'msgbox "标准正态分布函数lgass(0,1,0)=" & a
'a=api.lgass(0,1,1)
'msgbox "标准正态分布函数lgass(0,1,1)=" & a
'a=api.lgass(0,1,2)
'msgbox "标准正态分布函数lgass(0,1,2)=" & a
'a=api.lgass(1,1,2)
'msgbox "正态分布函数lgass(μ=1,σ=1,2)=" & a
'a=api.lgass(3,2,7)
'msgbox "正态分布函数lgass(μ=3,σ=2,7)=" & a
objShell.Run "regsvr32 /s /u DynamicWrapper.dll"
Set objShell=Nothing
'************************************************
' 测试例子MessageBoxA.vbs----VBScript调用标准DLL中的API
'************************************************
Option Explicit
Dim UserWrap
Set UserWrap = CreateObject("DynamicWrapper")
' Call MessageBoxA(), first register the API function
UserWrap.Register "USER32.DLL", "MessageBoxA", "I=HsSu","f=s", "R=l"
' 是|否|取消
UserWrap.MessageBoxA Null, "消息内容","消息标题", 3

测试例子MessageBoxW.vbs：
Set objShell=CreateObject("Wscript.Shell")
objShell.Run "regsvr32 /s dynwrapx.dll",,true
'msgbox 256*256
Set DX = CreateObject("DynamicWrapperX")                    ' Create an object instance.
DX.Register "user32.dll", "MessageBoxW", "i=hwwu", "r=l"    ' Register a dll function.
'是|否
res = DX.MessageBoxW(0, "Hello, world!", "Test", 4)         ' Call the function.
objShell.Run "regsvr32 /s /u dynwrapx.dll"
Set objShell=Nothing

测试例子dx.vbs：
'涉及字符串输入输出参数返回值的API，DynamicWrapper.dll不支持，但dynwrapx.dll支持，add by Ivan_han 20130807
Set objShell=CreateObject("Wscript.Shell")
objShell.Run "regsvr32 /s dynwrapx.dll",,true
Set api= CreateObject("DynamicWrapperX")                    ' Create an object instance.
api.Register "user32.dll", "MessageBoxW", "i=hwwu", "r=l"    ' Register a dll function.
'是|否
res = api.MessageBoxW(0, "Hello, world!", "Test", 4)         ' Call the function.

'对于下列API，DynamicWrapper.dll不支持，但dynwrapx.dll支持，add by Ivan_han 20130807
'"f=c"也可以
api.Register "month_name", "month_name", "f=s", "i=l", "r=s"
a=api.month_name(8)
msgbox a
'对于下列API，DynamicWrapper.dll不支持，但dynwrapx.dll支持，add by Ivan_han 20130807
'"f=c"也可以
api.Register "BSTRlib.dll", "vcnb", "f=c", "i=l", "r=w"
a=api.vcnb(-1046)
msgbox a
objShell.Run "regsvr32 /s /u dynwrapx.dll"
Set objShell=Nothing

Win7下不能跑的原因：DynamicWrapper库是不支持64位的，所以我们的程序必须要使用32位WScript解释器来执行，而Win7默认的vbs文件打开方式为64位WScript解释器。
解决方法：Win7下强制使用32位WScript解释器运行vbs脚本，执行一遍下面的vbs脚本即可。
'本脚本参考了木马https://github.com/bluebitch/VbsHorse/blob/master/Unit%20Test/VbsHouseX64Test.vbs
Const DEFAULT_VBS_OPEN_COMMAND_KEY = "HKLM\SOFTWARE\Classes\vbsfile\shell\open\command\"
Const CUSTOM_VBS_OPEN_COMMAND_VALUE = """%SystemRoot%\SysWOW64\wscript.exe"" ""%1"" %*"
Dim g_isRunningOnX86
g_isRunningOnX86 = False
Call Main()
Sub Main() '主函数，强制程序以32位WScript.exe解释执行
 If X86orX64() = "X64" Then
  If ReadReg(DEFAULT_VBS_OPEN_COMMAND_KEY) <> CUSTOM_VBS_OPEN_COMMAND_VALUE Then
   WScript.Echo("Using WScript.exe 64")
   Call SetVbsFileAss() '改变vbs格式文件关联
   Exit Sub
  End If
 End If
 g_isRunningOnX86 = True
End Sub
If g_isRunningOnX86 = True Then
 WScript.Echo("Using WScript.exe 32")
End If

Sub OpenFile(filePath)
 Dim objShell
 Set objShell = CreateObject("WScript.Shell")
 objShell.Run("explorer.exe " & filePath) '不使用CMD打开，防止产生黑框被用户发觉
 Set objShell = Nothing
End Sub
Sub SetVbsFileAss() '改变vbs格式文件关联
 Key = DEFAULT_VBS_OPEN_COMMAND_KEY
 Value = CUSTOM_VBS_OPEN_COMMAND_VALUE
 Call WriteReg(Key, Value, "REG_EXPAND_SZ")
End Sub
Sub WriteReg(key, value, typeName) '写注册表
 Dim objShell
 Set objShell = CreateObject("WScript.Shell")
 If typeName = "" Then
  objShell.RegWrite key, value
 Else
  objShell.RegWrite key, value, typeName
 End If
 Set objShell = Nothing
End Sub
Function ReadReg(key) '读取注册表，搜索key，返回所在路径
 Dim objShell
 Set objShell = CreateObject("WScript.Shell")
 ReadReg = objShell.RegRead(key)
 Set objShell = Nothing
End Function
Function X86orX64() '判断是X86架构还是X64架构
 Dim objFileSystem, systemRootPath
 Set objFileSystem = CreateObject("Scripting.FileSystemObject")
 X86orX64 = "X86"
 systemRootPath = objFileSystem.GetSpecialFolder(0) & "\"
 If objFileSystem.FolderExists(systemRootPath & "SysWow64") Then
  X86orX64 = "X64"
 End if
End Function

 

 

出处：https://blog.csdn.net/u010401391/article/details/50923327