''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 isn''t 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 isn''t 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 doesn''t exist
objNewIni.WriteLine
objNewIni.WriteLine "[" & strSection & "]"
'' Only write the key if the value isn''t 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 & " doesn''t exists. Exiting..."
REM Wscript.Quit 1
REM Msgbox strFilePath & " doesn''t 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
