' 例程代码如下
' By: PY-DNG
' Time Written: 2019-09-29 17:51
Set FSO = createobject("scripting.filesystemobject")
Set ws = Createobject("wscript.shell")
If wscript.Arguments.Count = 0 Then
Set objshell = CreateObject("Shell.Application")
objshell.ShellExecute "wscript.exe",Chr(34) & wscript.ScriptFullName & chr(34) & " uac","","runas",1
wscript.quit
End If
On Error Resume Next
SelfFolderPath = FSO.GetFile(WScript.ScriptFullName).ParentFolder.Path
If Right(SelfFolderPath,1) <> "\" Then
SelfFolderPath = SelfFolderPath & "\"
End If
Function CreateTempPath(IsFolder)
Dim TempPath
TempPath = FSO.GetSpecialFolder(2) & "\" & FSO.GetTempName()
If IsFolder Then TempPath = FormatPath(TempPath)
CreateTempPath = TempPath
End Function
Function FormatPath(Path)
If Not Right(Path,1) = "\" Then
Path = Path & "\"
End If
FormatPath = Path
End Function
Function MessageBox(Content,Icon,Title,DisplayTime)
On Error Resume Next
Content = Replace(Content,Chr(13),""" & Chr(13) & """)
Content = Replace(Content,Chr(10),""" & Chr(10) & """)
MsgFilePath = CreateTempPath(False)
ExecFilePath = CreateTempPath(False)
MSGFileContent = "CreateObject(""Scripting.FileSystemObject"").DeleteFile Wscript.ScriptFullName" & Chr(13) & Chr(10) & "Msgbox """ & Content & """," & CStr(Icon) & ",""" & Title & """"
If DisplayTime < 0 Then
ExecFileContent = "CreateObject(""Scripting.FileSystemObject"").DeleteFile Wscript.ScriptFullName" & Chr(13) & Chr(10) & "CreateObject(""Wscript.Shell"").Run ""wscript.exe //e:VBScript "" & Chr(34) & """ & MsgFilePath & """ & Chr(34)"
Else
ExecFileContent = "CreateObject(""Scripting.FileSystemObject"").DeleteFile Wscript.ScriptFullName" & Chr(13) & Chr(10) & "Set MsgProcess = CreateObject(""Wscript.Shell"").Exec(""wscript.exe //e:VBScript "" & Chr(34) & """ & MsgFilePath & """ & Chr(34))" & Chr(13) & Chr(10) & "Wscript.Sleep " & Cstr(DisplayTime) & Chr(13) & Chr(10) & "MsgProcess.Terminate"
End If
FSO.CreateTextFile(MsgFilePath,True).Write MSGFileContent
FSO.CreateTextFile(ExecFilePath,True).Write ExecFileContent
ws.Run "wscript.exe //e:VBScript """ & ExecFilePath & """"
End Function
Call MessageBox("第一行:本信息框应该在2秒后自动关闭" & Chr(13) & Chr(10) & "第二行:本信息框应该在2秒后自动关闭" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "第三行:本信息框应该在2秒后自动关闭" & Chr(13) & Chr(10),64,"标题",2000)
Call MessageBox("第一行:本信息框不会关闭" & Chr(13) & Chr(10) & "第二行:本信息框不会关闭" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "第三行:本信息框不会关闭" & Chr(13) & Chr(10),64,"标题",-1)
Call MessageBox("第一行:本信息框一闪而过" & Chr(13) & Chr(10) & "第二行:本信息框一闪而过" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "第三行:本信息框一闪而过" & Chr(13) & Chr(10),64,"标题",20)