'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 。