' ====================================================================================================
' RunApp 执行程序
Sub Run( strCmd )
CreateObject("WScript.Shell").Run strCmd, 1, True ' 正常运行 + 等待程序运行完成
End Sub
Sub RunNotWait( strCmd )
CreateObject("WScript.Shell").Run strCmd, 1, False ' 正常运行 + 不等待程序运行完成
End Sub
Sub RunHide( strCmd )
CreateObject("WScript.Shell").Run strCmd, 0, True ' 隐藏后台运行 + 等待程序运行完成
End Sub
Sub RunHideNotWait( strCmd )
CreateObject("WScript.Shell").Run strCmd, 0, False ' 隐藏后台运行 + 不等待程序运行完成
End Sub
' ====================================================================================================
' CMD 命令集
' ----------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------
' 获取CMD输出
Function CmdOut(str)
Set ws = CreateObject("WScript.Shell")
host = WScript.FullName
'Demon注：这里不用这么复杂吧，LCase(Right(host, 11))不就行了
If LCase( right(host, len(host)-InStrRev(host,"")) ) = "wscript.exe" Then
ws.run "cscript """ & WScript.ScriptFullName & chr(34), 0
WScript.Quit
End If
Set oexec = ws.Exec(str)
CmdOut = oExec.StdOut.ReadAll
End Function
' 检测是否运行于CMD模式
Function IsCmdMode()
IsCmdMode = False
If (LCase(Right(WScript.FullName,11)) = LCase("CScript.exe")) Then IsCmdMode = True
End Function
' Exist 检测文件或文件夹是否存在
Function Exist( strPath )
Exist = False
Set fso = CreateObject("Scripting.FileSystemObject")
If ((fso.FolderExists(strPath)) Or (fso.FileExists(strPath))) Then Exist = True
Set fso = Nothing
End Function
' ----------------------------------------------------------------------------------------------------
' MD 创建文件夹路径
Sub MD( ByVal strPath )
Dim arrPath, strTemp, valStart
arrPath = Split(strPath, "")
If Left(strPath, 2) = "" Then ' UNC Path
valStart = 3
strTemp = arrPath(0) & "" & arrPath(1) & "" & arrPath(2)
Else ' Local Path
valStart = 1
strTemp = arrPath(0)
End If
Set fso = CreateObject("Scripting.FileSystemObject")
For i = valStart To UBound(arrPath)
strTemp = strTemp & "" & arrPath(i)
If Not fso.FolderExists( strTemp ) Then fso.CreateFolder( strTemp )
Next
Set fso = Nothing
End Sub
' ----------------------------------------------------------------------------------------------------
' copy 复制文件或文件夹
Sub Copy( ByVal strSource, ByVal strDestination )
On Error Resume Next ' Required 必选
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(strSource)) Then ' 如果来源是一个文件
If (fso.FolderExists(strDestination)) Then ' 如果目的地是一个文件夹，加上路径后缀反斜线“”
fso.CopyFile fso.GetFile(strSource).Path, fso.GetFolder(strDestination).Path & "", True
Else ' 如果目的地是一个文件，直接复制
fso.CopyFile fso.GetFile(strSource).Path, strDestination, True
End If
End If ' 如果来源是一个文件夹，复制文件夹
If (fso.FolderExists(strSource)) Then fso.CopyFolder fso.GetFolder(strSource).Path, fso.GetFolder(strDestination).Path, True
Set fso = Nothing
End Sub
' ----------------------------------------------------------------------------------------------------
' del 删除文件或文件夹
Sub Del( strPath )
On Error Resume Next ' Required 必选
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(strPath)) Then
fso.GetFile( strPath ).attributes = 0
fso.GetFile( strPath ).delete
End If
If (fso.FolderExists(strPath)) Then
fso.GetFolder( strPath ).attributes = 0
fso.GetFolder( strPath ).delete
End If
Set fso = Nothing
End Sub
' ----------------------------------------------------------------------------------------------------
' attrib 改变文件属性
Sub Attrib( strPath, strArgs ) 'strArgs = [+R | -R] [+A | -A ] [+S | -S] [+H | -H]
Dim fso, valAttrib, arrAttrib()
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(strPath)) Then valAttrib = fso.getFile( strPath ).attributes
If (fso.FolderExists(strPath)) Then valAttrib = fso.getFolder( strPath ).attributes
If valAttrib = "" Or strArgs = "" Then Exit Sub
binAttrib = DecToBin(valAttrib) ' 十进制转二进制
For i = 0 To 16 ' 二进制转16位二进制
ReDim Preserve arrAttrib(i) : arrAttrib(i) = 0
If i > 16-Len(binAttrib) Then arrAttrib(i) = Mid(binAttrib, i-(16-Len(binAttrib)), 1)
Next
If Instr(1, LCase(strArgs), "+r", 1) Then arrAttrib(16-0) = 1 'ReadOnly 1 只读文件。
If Instr(1, LCase(strArgs), "-r", 1) Then arrAttrib(16-0) = 0
If Instr(1, LCase(strArgs), "+h", 1) Then arrAttrib(16-1) = 1 'Hidden 2 隐藏文件。
If Instr(1, LCase(strArgs), "-h", 1) Then arrAttrib(16-1) = 0
If Instr(1, LCase(strArgs), "+s", 1) Then arrAttrib(16-2) = 1 'System 4 系统文件。
If Instr(1, LCase(strArgs), "-s", 1) Then arrAttrib(16-2) = 0
If Instr(1, LCase(strArgs), "+a", 1) Then arrAttrib(16-5) = 1 'Archive 32 上次备份后已更改的文件。
If Instr(1, LCase(strArgs), "-a", 1) Then arrAttrib(16-5) = 0
valAttrib = BinToDec(Join(arrAttrib,"")) ' 二进制转十进制
If (fso.FileExists(strPath)) Then fso.getFile( strPath ).attributes = valAttrib
If (fso.FolderExists(strPath)) Then fso.getFolder( strPath ).attributes = valAttrib
Set fso = Nothing
End Sub
Function DecToBin(ByVal number) ' 十进制转二进制
Dim remainder
remainder = number
Do While remainder > 0
DecToBin = CStr(remainder Mod 2) & DecToBin
remainder = remainder 2
Loop
End Function
Function BinToDec(ByVal binStr) ' 二进制转十进制
Dim i
For i = 1 To Len(binStr)
BinToDec = BinToDec + (CInt(Mid(binStr, i, 1)) * (2 ^ (Len(binStr) - i)))
Next
End Function
' ----------------------------------------------------------------------------------------------------
' Ping 判断网络是否联通
Function Ping(host)
On Error Resume Next
Ping = False : If host = "" Then Exit Function
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & host & "'")
For Each objStatus in objPing
If objStatus.ResponseTime >= 0 Then Ping = True : Exit For
Next
Set objPing = nothing
End Function
