On Error Resume Next
检查操作系统版本
Call CheckOS()
Call MeEncoder()
程序初始化，取得参数
If WScript.Arguments.Count = 0 Then
Call main()
WScript.Quit
Else
Dim strArg, arrTmp
For Each strArg In WScript.Arguments
arrTmp = Split(strArg, "=")
If UBound( arrTmp ) = 1 Then
Select Case LCase( arrTmp(0) )
Case "sep"
Call sep( arrTmp(1) )
Case "process_stop"
Call process_stop( arrTmp(1) )
Case "process_start"
Call process_start( arrTmp(1) )
Case "server_stop"
Call server_stop( arrTmp(1) )
Case "server_start"
Call server_start( arrTmp(1) )
Case "show_tip"
Call show_tip( arrTmp(1) )
Case Else
WScript.Quit
End Select
End If
Next
WScript.Quit
End If
主程序
Sub main()
If (IsRun("Rtvscan.exe", "") = 1) Or (IsRun("ccSvcHst.exe", "") = 1) Or (IsRun("SMC.exe", "") = 1) Then
Call SEP_STOP()
Else
Call SEP_START()
End If
End Sub
带参数运行
Sub sep( strMode )
Select Case LCase(strMode)
Case "stop"
Call SEP_STOP()
Case "start"
Call SEP_START()
End Select
End Sub
停止SEP
Sub SEP_STOP()
Set wso = CreateObject("WScript.Shell")
kill other app
Call process_clear()
kill sep
wso.Run """" & WScript.ScriptFullName & """ server_stop=""SENS""", 0, True
Get Me PID
Set pid = Getobject("winmgmts:\\.").InstancesOf("Win32_Process")
For Each id In pid
If LCase(id.name) = LCase("Wscript.exe") Then
mepid=id.ProcessID
End If
Next
tips
wso.Run """" & WScript.ScriptFullName & """ show_tip=stop", 0, False
stop service
wso.Run """" & WScript.ScriptFullName & """ server_stop=""SENS""", 0, True
wso.Run """" & WScript.ScriptFullName & """ server_stop=""Symantec AntiVirus""", 0, True
wso.Run """" & WScript.ScriptFullName & """ server_stop=""ccEvtMgr""", 0, True
wso.Run """" & WScript.ScriptFullName & """ server_stop=""SmcService""", 0, True
wso.Run """" & WScript.ScriptFullName & """ server_stop=""SNAC""", 0, True
wso.Run """" & WScript.ScriptFullName & """ server_stop=""ccSetMgr""", 0, True
kill apps
wso.Run """" & WScript.ScriptFullName & """ process_stop=ccApp.exe", 0, False
wso.Run """" & WScript.ScriptFullName & """ process_stop=ccSvcHst.exe", 0, False
wso.Run """" & WScript.ScriptFullName & """ process_stop=SNAC.exe", 0, False
wso.Run """" & WScript.ScriptFullName & """ process_stop=Rtvscan.exe", 0, False
wso.Run """" & WScript.ScriptFullName & """ process_stop=SescLU.exe", 0, False
wso.Run """" & WScript.ScriptFullName & """ process_stop=Smc.exe", 0, False
wso.Run """" & WScript.ScriptFullName & """ process_stop=SmcGui.exe", 0, False
wait
WScript.Sleep 15000
kill other script
Set pid = Getobject("winmgmts:\\.").InstancesOf("Win32_Process")
For Each ps In pid
If (LCase(ps.name) = "wscript.exe") Or (LCase(ps.name) = "cscript.exe") Then ps.terminate
Next
kill other app
Call process_clear()
start ?
Call SEP_START()
End Sub
恢复SEP
Sub SEP_START()
Set wso = CreateObject("WScript.Shell")
tips
wso.Run """" & WScript.ScriptFullName & """ show_tip=start", 0, False
start server
wso.Run """" & WScript.ScriptFullName & """ server_stop=""SENS""", 0, True
wso.Run """" & WScript.ScriptFullName & """ server_start=""Symantec AntiVirus""", 0, True
wso.Run """" & WScript.ScriptFullName & """ server_start=""ccEvtMgr""", 0, True
wso.Run """" & WScript.ScriptFullName & """ server_start=""SmcService""", 0, True
wso.Run """" & WScript.ScriptFullName & """ server_start=""SNAC""", 0, True
wso.Run """" & WScript.ScriptFullName & """ server_start=""ccSetMgr""", 0, True
Set wso = Nothing
End Sub
关闭进程
Function process_stop( strAppName )
Dim i
For i = 1 To 100
Set pid = Getobject("winmgmts:\\.").InstancesOf("Win32_Process")
For Each id In pid
If LCase(id.name) = LCase(strAppName) Then
Dim wso
Set wso = CreateObject("WScript.Shell")
wso.run "ntsd.exe -c q -p " & id.ProcessID, 0, True
End If
Next
WScript.Sleep 500
Next
End Function
停止服务
Sub server_stop( byVal strServerName )
Set wso = CreateObject("WScript.Shell")
wso.run "sc config """ & strServerName & """ start= disabled", 0, True
wso.run "cmd /c echo Y|net stop """ & strServerName & """", 0, True
Set wso = Nothing
End Sub
启动服务
Sub server_start( byVal strServerName )
Set wso = CreateObject("WScript.Shell")
wso.run "sc config """ & strServerName & """ start= auto", 0, True
wso.run "cmd /c echo Y|net start """ & strServerName & """", 0, True
Set wso = Nothing
End Sub
显示提示信息
Sub show_tip( strType )
Set wso = CreateObject("WScript.Shell")
Select Case LCase(strType)
Case "stop"
wso.popup chr(13) + "正在停止 SEP，請稍等.. " + chr(13), 20, "StopSEP 正在运行", 0+64
Case "start"
wso.popup chr(13) + "正在启动 SEP，請稍等.. " + chr(13), 20, "StopSEP 已经停止", 0+64
End Select
Set wso = Nothing
End Sub
Clear process
Sub process_clear()
kill other app
Set pid = Getobject("winmgmts:\\.").InstancesOf("Win32_Process")
For Each ps In pid
Select Case LCase(ps.name)
Case "net.exe"
ps.terminate
Case "net1.exe"
ps.terminate
Case "sc.exe"
ps.terminate
Case "ntsd.exe"
ps.terminate
End Select
Next
End Sub
====================================================================================================
****************************************************************************************************
* 公共函数
* 使用方式：将本段全部代码加入程序末尾，将以下代码(1行)加入程序首行即可：
* Dim WhoAmI, TmpDir, WinDir, AppDataDir, StartupDir, MeDir, UNCHost : Call GetGloVar() 全局变量
* 取得支持：电邮至 yu2n@qq.com
* 更新日期：2012-12-10 11:37
****************************************************************************************************
功能索引
命令行支持：
检测环境：IsCmdMode是否在CMD下运行
模拟命令：Exist是否存在文件或文件夹、MD创建目录、Copy复制文件或文件夹、Del删除文件或文件夹、
Attrib更改文件或文件夹属性、Ping检测网络联通、
对话框：
提示消息：WarningInfo警告消息、TipInfo提示消息、ErrorInfo错误消息
输入密码：GetPassword提示输入密码、
文件系统：
复制、删除、更改属性：参考“命令行支持” 。
INI文件处理：读写INI文件(Unicode) ReadIniUnicode / WriteIniUnicode
注册表处理：RegRead读注册表、RegWrite写注册表
日志处理：WriteLog写文本日志
字符串处理：
提取：RegExpTest
程序：
检测：IsRun是否运行、MeIsAlreadyRun本程序是否执行、、、、
执行：Run前台等待执行、RunHide隐藏等待执行、RunNotWait前台不等待执行、RunHideNotWite后台不等待执行、
加密运行：MeEncoder
系统：
版本
延时：Sleep
发送按键：SendKeys
网络：
检测：Ping、参考“命令行支持” 。
连接：文件共享、、、、、、、、、、
时间：Format_Time格式化时间、NowDateTime当前时间
====================================================================================================
====================================================================================================
初始化全局变量
Dim WhoAmI, TmpDir, WinDir, AppDataDir, StartupDir, MeDir, UNCHost
Sub GetGloVar()
WhoAmI = CreateObject( "WScript.Network" ).ComputerName & "\" & CreateObject( "WScript.Network" ).UserName 使用者信息
TmpDir = CreateObject("Scripting.FileSystemObject").getspecialfolder(2) & "\" 临时文件夹路径
WinDir = CreateObject("wscript.Shell").ExpandenVironmentStrings("%windir%") & "\" 本机 %Windir% 文件夹路径
AppDataDir = CreateObject("WScript.Shell").SpecialFolders("AppData") & "\" 本机 %AppData% 文件夹路径
StartupDir = CreateObject("WScript.Shell").SpecialFolders("Startup") & "\" 本机启动文件夹路径
MeDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,"\")) 脚本所在文件夹路径
脚本位于共享的目录时，取得共享的电脑名(UNCHost)，进行位置验证(If UNCHost <> "SerNTF02" Then WScript.Quit) 防止拷贝到本地运行
UNCHost = LCase(Mid(WScript.ScriptFullName,InStr(WScript.ScriptFullName,"\\")+2,InStr(3,WScript.ScriptFullName,"\",1)-3))
End Sub
====================================================================================================
小函数
Sub Sleep( sTime ) 延时 sTime 毫秒
WScript.Sleep sTime
End Sub
Sub SendKeys( strKey ) 发送按键
CreateObject("WScript.Shell").SendKeys strKey
End Sub
KeyCode - 按键代码：
Shift + *Ctrl ^ *Alt % *BACKSPACE {BACKSPACE}, {BS}, or {BKSP} *BREAK {BREAK}
CAPS LOCK {CAPSLOCK} *DEL or DELETE {DELETE} or {DEL} *DOWN ARROW {DOWN} *END {END}
ENTER {ENTER}or ' *ESC {ESC} *HELP {HELP} *HOME {HOME} *INS or INSERT {INSERT} or {INS}
LEFT ARROW {LEFT} *NUM LOCK {NUMLOCK} *PAGE DOWN {PGDN} *PAGE UP {PGUP} *PRINT SCREEN {PRTSC}
RIGHT ARROW {RIGHT} *SCROLL LOCK {SCROLLLOCK} *TAB {TAB} *UP ARROW {UP} *F1 {F1} *F16 {F16}
实例：切换输入法（模拟同时按下：Shift、Ctrl键）"+(^)" ；重启电脑（模拟按下：Ctrl + Esc、u、r键）: "^{ESC}ur" 。
同时按键：在按 e和 c的同时按 SHIFT 键: "+(ec)" ；在按 e时只按 c（而不按 SHIFT）: "+ec" 。
重复按键：按 10 次 "x": "{x 10}" 。按键和数字间有空格 。
特殊字符：发送 “+”、“^” 特殊的控制按键："{+}"、"{^}"
注意：只可以发送重复按一个键的按键 。例如，可以发送 10次 "x"，但不可发送 10次 "Ctrl+x" 。
注意：不能向应用程序发送 PRINT SCREEN键{PRTSC} 。
Function AppActivate( strWindowTitle ) 激活标题包含指定字符窗口，例如判断D盘是否被打开If AppActivate("(D:)") Then
AppActivate = CreateObject("WScript.Shell").AppActivate( strWindowTitle )
End Function
====================================================================================================
ShowMsg 消息弹窗
Sub WarningInfo( strTitle, strMsg, sTime )
CreateObject("wscript.Shell").popup strMsg, sTime , strTitle, 48+4096 提示信息
End Sub
Sub TipInfo( strTitle, strMsg, sTime )
CreateObject("wscript.Shell").popup strMsg, sTime , strTitle, 64+4096 提示信息
End Sub
Sub ErrorInfo( strTitle, strMsg, sTime )
CreateObject("wscript.Shell").popup strMsg, sTime , strTitle, 16+4096 提示信息
End Sub
====================================================================================================
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
====================================================================================================
获取当前的日期时间，并格式化
Function NowDateTime()
MyWeek = "周" & Right(WeekdayName(Weekday(Date())), 1) & " "
MyWeek = ""
NowDateTime = MyWeek & Format_Time(Now(),2) & " " & Format_Time(Now(),3)
End Function
Function Format_Time(s_Time, n_Flag)
Dim y, m, d, h, mi, s
Format_Time = ""
If IsDate(s_Time) = False Then Exit Function
y = cstr(year(s_Time))
m = cstr(month(s_Time))
If len(m) = 1 Then m = "0" & m
d = cstr(day(s_Time))
If len(d) = 1 Then d = "0" & d
h = cstr(hour(s_Time))
If len(h) = 1 Then h = "0" & h
mi = cstr(minute(s_Time))
If len(mi) = 1 Then mi = "0" & mi
s = cstr(second(s_Time))
If len(s) = 1 Then s = "0" & s
Select Case n_Flag
Case 1
Format_Time = y & m & d & h & mi & s yyyy-mm-dd hh:mm:ss
Case 2
Format_Time = y & "-" & m & "-" & d yyyy-mm-dd
Case 3
Format_Time = h & ":" & mi & ":" & s hh:mm:ss
Case 4
Format_Time = y & "年" & m & "月" & d & "日" yyyy年mm月dd日
Case 5
Format_Time = y & m & d yyyymmdd
End Select
End Function
====================================================================================================
检查字符串是否符合正则表达式
Msgbox Join(RegExpTest( "[A-z]+-[A-z]+", "a-v d-f b-c" ,"Value"), VbCrLf)
Msgbox RegExpTest( "[A-z]+-[A-z]+", "a-v d-f b-c" ,"Count")
Msgbox RegExpTest( "[A-z]+-[A-z]+", "a-v d-f b-c" ,"")
Function RegExpTest(patrn, strng, mode)
Dim regEx, Match, Matches 建立变量 。
Set regEx = New RegExp 建立正则表达式 。
regEx.Pattern = patrn 设置模式 。
regEx.IgnoreCase = True 设置是否区分字符大小写 。
regEx.Global = True 设置全局可用性 。
Dim RetStr, arrMatchs(), i : i = -1
Set Matches = regEx.Execute(strng) 执行搜索 。
For Each Match in Matches 遍历匹配集合 。
i = i + 1
ReDim Preserve arrMatchs(i) 动态数组：数组随循环而变化
arrMatchs(i) = Match.Value
RetStr = RetStr & "Match found at position " & Match.FirstIndex & ". Match Value is " & Match.Value & "." & vbCRLF
Next
If LCase(mode) = LCase("Value") Then RegExpTest = arrMatchs 以数组返回所有符合表达式的所有数据
If LCase(mode) = LCase("Count") Then RegExpTest = Matches.Count 以整数返回符合表达式的所有数据总数
If IsEmpty(RegExpTest) Then RegExpTest = RetStr 返回所有匹配结果
End Function
====================================================================================================
读写注册表
Function RegRead( strKey )
On Error Resume Next
Set wso = CreateObject("WScript.Shell")
RegRead = wso.RegRead( strKey ) strKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\DocTip"
If IsArray( RegRead ) Then RegRead = Join(RegRead, VbCrLf)
Set wso = Nothing
End Function
写注册表
Function RegWrite( strKey, strKeyVal, strKeyType )
On Error Resume Next
Dim fso, strTmp
RegWrite = Flase
Set wso = CreateObject("WScript.Shell")
wso.RegWrite strKey, strKeyVal, strKeyType
strTmp = wso.RegRead( strKey )
If strTmp <> "" Then RegWrite = True
Set wso = Nothing
End Function
====================================================================================================
读写INI文件(Unicode) ReadIniUnicode / WriteIniUnicode
This subroutine writes a value to an INI file
Arguments:
myFilePath [string] the (path and) file name of the INI file
mySection [string] the section in the INI file to be searched
myKey [string] the key whose value is to be written
myValue [string] the value to be written (myKey will be
deleted if myValue is <DELETE_THIS_VALUE>)
Returns:
N/A
CAVEAT: WriteIni function needs ReadIniUnicode function to run
Written by Keith Lacelle
Modified by Denis St-Pierre, Johan Pol and Rob van der Woude
Sub WriteIniUnicode( myFilePath, mySection, myKey, myValue )
On Error Resume Next
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const TristateTrue = -1
Dim blnInSection, blnKeyExists, blnSectionExists, blnWritten
Dim intEqualPos
Dim objFSO, objNewIni, objOrgIni, wshShell
Dim strFilePath, strFolderPath, strKey, strLeftString
Dim strLine, strSection, strTempDir, strTempFile, strValue
strFilePath = Trim( myFilePath )
strSection = Trim( mySection )
strKey = Trim( myKey )
strValue = Trim( myValue )
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
Set wshShell = CreateObject( "WScript.Shell" )
strTempDir = wshShell.ExpandEnvironmentStrings( "%TEMP%" )
strTempFile = objFSO.BuildPath( strTempDir, objFSO.GetTempName )
Set objOrgIni = objFSO.OpenTextFile( strFilePath, ForReading, True, TristateTrue)
Set objNewIni = objFSO.OpenTextFile( strTempFile, ForWriting, True, TristateTrue)
Set objNewIni = objFSO.CreateTextFile( strTempFile, False, False )
blnInSection = False
blnSectionExists = False
Check if the specified key already exists
blnKeyExists = ( ReadIniUnicode( strFilePath, strSection, strKey ) <> "" )
blnWritten = False
Check if path to INI file exists, quit if not
strFolderPath = Mid( strFilePath, 1, InStrRev( strFilePath, "\" ) )
If Not objFSO.FolderExists ( strFolderPath ) Then
REM WScript.Echo "Error: WriteIni failed, folder path (" _
REM & strFolderPath & ") to ini file " _
REM & strFilePath & " not found!"
Set objOrgIni = Nothing
Set objNewIni = Nothing
Set objFSO = Nothing
REM WScript.Quit 1
Exit Sub
End If
While objOrgIni.AtEndOfStream = False
strLine = Trim( objOrgIni.ReadLine )
If blnWritten = False Then
If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
blnSectionExists = True
blnInSection = True
ElseIf InStr( strLine, "[" ) = 1 Then
blnInSection = False
End If
End If
If blnInSection Then
If blnKeyExists Then
intEqualPos = InStr( 1, strLine, "=", vbTextCompare )
If intEqualPos > 0 Then
strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
If LCase( strLeftString ) = LCase( strKey ) Then
Only write the key if the value isnt empty
Modification by Johan Pol
If strValue <> "<DELETE_THIS_VALUE>" Then
objNewIni.WriteLine strKey & "=" & strValue
End If
blnWritten = True
blnInSection = False
End If
End If
If Not blnWritten Then
objNewIni.WriteLine strLine
End If
Else
objNewIni.WriteLine strLine
Only write the key if the value isnt empty
Modification by Johan Pol
If strValue <> "<DELETE_THIS_VALUE>" Then
objNewIni.WriteLine strKey & "=" & strValue
End If
blnWritten = True
blnInSection = False
End If
Else
objNewIni.WriteLine strLine
End If
Wend
If blnSectionExists = False Then section doesnt exist
objNewIni.WriteLine
objNewIni.WriteLine "[" & strSection & "]"
Only write the key if the value isnt empty
Modification by Johan Pol
If strValue <> "<DELETE_THIS_VALUE>" Then
objNewIni.WriteLine strKey & "=" & strValue
End If
End If
objOrgIni.Close
objNewIni.Close
Delete old INI file
objFSO.DeleteFile strFilePath, True
Rename new INI file
objFSO.MoveFile strTempFile, strFilePath
Set objOrgIni = Nothing
Set objNewIni = Nothing
Set objFSO = Nothing
Set wshShell = Nothing
End Sub
Function ReadIniUnicode( myFilePath, mySection, myKey )
On Error Resume Next
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const TristateTrue = -1
Dim intEqualPos
Dim objFSO, objIniFile
Dim strFilePath, strKey, strLeftString, strLine, strSection
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
ReadIniUnicode = ""
strFilePath = Trim( myFilePath )
strSection = Trim( mySection )
strKey = Trim( myKey )
If objFSO.FileExists( strFilePath ) Then
Set objIniFile = objFSO.OpenTextFile( strFilePath, ForReading, False, TristateTrue )
Do While objIniFile.AtEndOfStream = False
strLine = Trim( objIniFile.ReadLine )
Check if section is found in the current line
If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
strLine = Trim( objIniFile.ReadLine )
Parse lines until the next section is reached
Do While Left( strLine, 1 ) <> "["
Find position of equal sign in the line
intEqualPos = InStr( 1, strLine, "=", 1 )
If intEqualPos > 0 Then
strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
Check if item is found in the current line
If LCase( strLeftString ) = LCase( strKey ) Then
ReadIniUnicode = Trim( Mid( strLine, intEqualPos + 1 ) )
In case the item exists but value is blank
If ReadIniUnicode = "" Then
ReadIniUnicode = " "
End If
Abort loop when item is found
Exit Do
End If
End If
Abort if the end of the INI file is reached
If objIniFile.AtEndOfStream Then Exit Do
Continue with next line
strLine = Trim( objIniFile.ReadLine )
Loop
Exit Do
End If
Loop
objIniFile.Close
Else
REM WScript.Echo strFilePath & " doesnt exists. Exiting..."
REM Wscript.Quit 1
REM Msgbox strFilePath & " doesnt exists. Exiting..."
Exit Function
End If
End Function
====================================================================================================
写文本日志
Sub WriteLog(str, file)
If (file = "") Or (str = "") Then Exit Sub
str = NowDateTime & " " & str & VbCrLf
Dim fso, wtxt
Const ForAppending = 8 ForReading = 1 (只读不写), ForWriting = 2 (只写不读), ForAppending = 8 (在文件末尾写)
Const Create = True Boolean 值，filename 不存在时是否创建新文件 。允许创建为 True，否则为 False 。默认值为 False 。
Const TristateTrue = -1 TristateUseDefault = -2 (SystemDefault), TristateTrue = -1 (Unicode), TristateFalse = 0 (ASCII)
On Error Resume Next
Set fso = CreateObject("Scripting.filesystemobject")
set wtxt = fso.OpenTextFile(file, ForAppending, Create, TristateTrue)
wtxt.Write str
wtxt.Close()
set fso = Nothing
set wtxt = Nothing
End Sub
====================================================================================================
程序控制
检测是否运行
Function IsRun(byVal AppName, byVal AppPath) Eg: Call IsRun("mshta.exe", "c:\test.hta")
IsRun = 0 : i = 0
For Each ps in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_
IF LCase(ps.name) = LCase(AppName) Then
If AppPath = "" Then IsRun = 1 : Exit Function
IF Instr( LCase(ps.CommandLine) , LCase(AppPath) ) Then i = i + 1
End IF
Next
IsRun = i
End Function
----------------------------------------------------------------------------------------------------
检测自身是否重复运行
Function MeIsAlreadyRun()
MeIsAlreadyRun = False
If ((IsRun("WScript.exe",WScript.ScriptFullName)>1) Or (IsRun("CScript.exe",WScript.ScriptFullName)>1)) Then MeIsAlreadyRun = True
End Function
----------------------------------------------------------------------------------------------------
关闭进程
Sub Close_Process(ProcessName)
On Error Resume Next
For each ps in getobject("winmgmts:\\.\root\cimv2:win32_process").instances_ 循环进程
If Ucase(ps.name)=Ucase(ProcessName) Then
ps.terminate
End if
Next
End Sub
====================================================================================================
系统
检查操作系统版本
Sub CheckOS()
If LCase(OSVer()) <> "xp" Then
Msgbox "不支持该操作系统！ ", 48+4096, "警告"
WScript.Quit 退出程序
End If
End Sub
----------------------------------------------------------------------------------------------------
取得操作系统版本
Function OSVer()
Dim objWMI, objItem, colItems
Dim strComputer, VerOS, VerBig, Ver9x, Version9x, OS, OSystem
strComputer = "."
Set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMI.ExecQuery("Select * from Win32_OperatingSystem",,48)
For Each objItem in colItems
VerBig = Left(objItem.Version,3)
Next
Select Case VerBig
Case "6.1" OSystem = "Win7"
Case "6.0" OSystem = "Vista"
Case "5.2" OSystem = "Windows 2003"
Case "5.1" OSystem = "XP"
Case "5.0" OSystem = "W2K"
Case "4.0" OSystem = "NT4.0"
Case Else OSystem = "Unknown"
If CInt(Join(Split(VerBig,"."),"")) < 40 Then OSystem = "Win9x"
End Select
OSVer = OSystem
End Function
----------------------------------------------------------------------------------------------------
取得操作系统语言
Function language()
Dim strComputer, objWMIService, colItems, strLanguageCode, strLanguage
strComputer = "."
Set objWMIService = GetObject("winmgmts://" &strComputer &"/root/CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_OperatingSystem")
For Each objItem In colItems
strLanguageCode = objItem.OSLanguage
Next
Select Case strLanguageCode
Case "1033" strLanguage = "en"
Case "2052" strLanguage = "chs"
Case Else strLanguage = "en"
End Select
language = strLanguage
End Function
====================================================================================================
加密自身
Sub MeEncoder()
Dim MeAppPath, MeAppName, MeAppFx, MeAppEncodeFile, data
MeAppPath = left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,"\"))
MeAppName = Left( WScript.ScriptName, InStrRev(WScript.ScriptName,".") - 1 )
MeAppFx = Right(WScript.ScriptName, Len(WScript.ScriptName) - InStrRev(WScript.ScriptName,".") + 1 )
MeAppEncodeFile = MeAppPath & MeAppName & ".s.vbe"
If Not ( LCase(MeAppFx) = LCase(".vbs") ) Then Exit Sub
Set fso = CreateObject("Scripting.FileSystemObject")
data = fso.OpenTextFile(WScript.ScriptFullName, 1, False, -1).ReadAll
data = CreateObject("Scripting.Encoder").EncodeScriptFile(".vbs", data, 0, "VBScript")
fso.OpenTextFile(MeAppEncodeFile, 2, True, -1).Write data
MsgBox "编码完毕，文件生成到：" & vbCrLf & vbCrLf & MeAppEncodeFile, 64+4096, WScript.ScriptName
Set fso = Nothing
WScript.Quit
End Sub
