说明
最近重新整理一些vba的测试用例,word和excel通用
测试用例
windows 关键结构体和函数声明
#If Win64 Then
Private Declare PtrSafe Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Integer) As LongPtr
Private Declare PtrSafe Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As LongPtr, ByVal lpThreadAttributes As LongPtr, ByVal bInheritHandles As Boolean, ByVal dwCreationFlags As LongPtr, ByVal lpEnvironment As LongPtr, ByVal lpCurrentDirectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As LongPtr
Private Declare PtrSafe Function ShellExecuteA Lib "shell32" (ByVal Hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As LongPtr) As LongPtr
Private Declare PtrSafe Function ShellExecuteExA Lib "shell32" (Prop As SHELLEXECUTEINFO) As LongPtr
#Else
Private Declare Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Integer) As Long
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Boolean, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function ShellExecuteA Lib "shell32" (ByVal Hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function ShellExecuteExA Lib "shell32" (Prop As SHELLEXECUTEINFO) As Long
#End If
Private Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
Hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type
' https://msdn.microsoft.com/fr-fr/library/windows/desktop/ms684873(v=vs.85).aspx
Private Type PROCESS_INFORMATION
hProcess As Long 'HANDLE hProcess;
hThread As Long 'HANDLE hThread;
dwProcessId As Long 'DWORD dwProcessId;
dwThreadId As Long 'DWORD dwThreadId;
End Type
' https://msdn.microsoft.com/en-us/library/windows/desktop/ms686331(v=vs.85).aspx
Private Type STARTUPINFO
cb As Long 'DWORD cb;
lpReserved As String 'LPSTR lpReserved;
lpDesktop As String 'LPSTR lpDesktop;
lpTitle As String 'LPSTR lpTitle;
dwX As Long 'DWORD dwX;
dwY As Long 'DWORD dwY;
dwXSize As Long 'DWORD dwXSize;
dwYSize As Long 'DWORD dwYSize;
dwXCountChars As Long 'DWORD dwXCountChars;
dwYCountChars As Long 'DWORD dwYCountChars;
dwFillAttribute As Long 'DWORD dwFillAttribute;
dwFlags As Long 'DWORD dwFlags;
wShowWindow As Integer 'WORD wShowWindow;
cbReserved2 As Integer 'WORD cbReserved2;
lpReserved2 As Long 'LPBYTE lpReserved2;
hStdInput As Long 'HANDLE hStdInput;
hStdOutput As Long 'HANDLE hStdOutput;
hStdError As Long 'HANDLE hStdError;
End Type
Private Const CREATE_SUSPENDED = &H4
进程创建类的用例
Sub process_create()
' rtcShell
Shell ("calc.exe")
' WinExec
Call WinExec("calc.exe", 1)
Set WSHShell = CreateObject("WScript.Shell")
' IWshShell.Run
WSHShell.Run "calc.exe"
'IWshShell.Exec
WSHShell.Exec "calc.exe"
' IShellDispatch.ShellExecute
Set WSHShell = CreateObject("Shell.Application")
WSHShell.ShellExecute "calc.exe"
' ISWbemObjectEx.Create
GetObject("winmgmts:\\.\root\cimv2:Win32_Process").Create "calc.exe"
' Create new process in suspended state
Dim strNull As String
Dim structProcessInformation As PROCESS_INFORMATION
Dim structStartupInfo As STARTUPINFO
Dim lCreateProcess As Long
lCreateProcess = CreateProcess(strNull, "calc.exe", 0&, 0&, False, 0, 0&, strNull, structStartupInfo, structProcessInformation)
' ShellExecute
ShellExecuteA 0, "open", "calc.exe", "", 0, 1
' ShellExecuteEx
Dim Propt As SHELLEXECUTEINFO
With Propt
.cbSize = Len(Prop)
.fMask = &HC
.Hwnd = 0&
.lpVerb = "open"
.lpFile = "calc.exe"
End With
Call ShellExecuteExA(Propt)
End Sub
文件操作类的相关用例
Sub process_file()
' _Stream.SaveToFile
Dim bs
Set bs = CreateObject("ADODB.Stream")
bs.Type = 1
bs.Open
bs.SaveToFile "3.db", 2
Set fsObj = CreateObject("Scripting.FileSystemObject")
' IFileSystem.CreateTextFile
fsObj.CreateTextFile ("1.txt")
' IFileSystem.OpenTextFile
fsObj.OpenTextFile ("1.txt")
' IFileSystem.CopyFile
fsObj.CopyFile "1.txt", "2.txt"
' IWshShell.CreateShortcut
Set WSHShell = CreateObject("WScript.Shell")
WSHShell.CreateShortcut "$home\Desktop\DemoShortcut.lnk"
End Sub
网络访问类的用例
Sub process_net()
Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
URL = "http://mail.baidu.com/file/pay/typeword13.doc"
objWinHttp.Open "GET", URL, False
Dim xHttp: Set xHttp = CreateObject("Microsoft.XMLHTTP")
xHttp.Open "Get", "http://www.baidu.com", False
End Sub
注册表相关的用例
Sub process_reg()
' IWshShell.RegWrite
Set WSHShell = CreateObject("WScript.Shell")
WSHShell.RegWrite "HKCU\Delete\Key", "test", "REG_SZ"
End Sub
计划任务相关用例
Sub process_taskschd()
UName = CreateObject("Wscript.Network").UserName
Set service = CreateObject("Schedule.Service")
Call service.Connect
Dim rootFolder
Set rootFolder = service.GetFolder("\")
Dim taskDefinition
Set taskDefinition = service.NewTask(0)
Dim regInfo
Set regInfo = taskDefinition.RegistrationInfo
regInfo.Description = ""
regInfo.Author = UName
Dim settings
Set settings = taskDefinition.settings
settings.StartWhenAvailable = True
Dim triggers
Set triggers = taskDefinition.triggers
Dim trigger2
Set trigger2 = triggers.Create(7)
trigger2.ID = "RegistreationTriggerid"
trigger2.Delay = "PT2M"
trigger2.Enabled = True
Dim Action
Set Action = taskDefinition.Actions.Create(0)
Action.Path = "d:\test"
Action.arguments = "cmd.exe"
Const COrUTask = 6
Call rootFolder.RegisterTaskDefinition("Adobol", taskDefinition, COrUTask, , , 3)
End Sub