DynamicWrapper.dll、dynwrapx.dll测试（WinXP、Win7下均可跑）（2013-08-07 13:21:55）



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