VBS 強(qiáng)制關(guān)閉Symantec Endpoint Protection的代碼

更新時(shí)間：2013年01月14日 18:06:36 作者：

很多企業(yè)電腦系統(tǒng)是Windows Xp，使用Windows server 2003 來控制，其中客戶端得殺毒軟件有不少是使用 Symantec Endpoint Protection

使用這個(gè)腳本，可以隨時(shí)讓它歇下來。當(dāng)然也可以讓它繼續(xù)工作。
前提是，你必須是本機(jī)管理員。
這個(gè)腳本使用一各很過時(shí)的終止程序方法：ntsd.exe -c q -p ProcessID。所以以前有過一個(gè)bat版，之所以用VBS是因?yàn)樾矢咭稽c(diǎn)，而且沒有太多的黑色窗口。
主要思想是：循環(huán)終止程序+停止服務(wù)

代碼如下：

復(fù)制代碼代碼如下:

'On Error Resume Next
' 檢查操作系統(tǒng)版本
Call CheckOS()
Call MeEncoder()

' 程序初始化，取得參數(shù)
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

' 帶參數(shù)運(yùn)行
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

' 恢復(fù)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

' 關(guān)閉進(jìn)程
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

' 停止服務(wù)
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

' 啟動(dòng)服務(wù)
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 正在運(yùn)行", 0+64
        Case "start"
            wso.popup chr(13) + "正在啟動(dòng) SEP，請稍等..        " + chr(13), 20, "StopSEP 已經(jīng)停止", 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

' ====================================================================================================
' ****************************************************************************************************
' * 公共函數(shù)
' * 使用方式：將本段全部代碼加入程序末尾，將以下代碼(1行)加入程序首行即可：
' * Dim WhoAmI, TmpDir, WinDir, AppDataDir, StartupDir, MeDir, UNCHost :   Call GetGloVar() ' 全局變量
' * 取得支持：電郵至 yu2n@qq.com
' * 更新日期：2012-12-10 11:37
' ****************************************************************************************************
' 功能索引
' 命令行支持：
'     檢測環(huán)境：IsCmdMode是否在CMD下運(yùn)行
'     模擬命令：Exist是否存在文件或文件夾、MD創(chuàng)建目錄、Copy復(fù)制文件或文件夾、Del刪除文件或文件夾、
'               Attrib更改文件或文件夾屬性、Ping檢測網(wǎng)絡(luò)聯(lián)通、
' 對話框：
'     提示消息：WarningInfo警告消息、TipInfo提示消息、ErrorInfo錯(cuò)誤消息
'     輸入密碼：GetPassword提示輸入密碼、
' 文件系統(tǒng)：
'     復(fù)制、刪除、更改屬性：參考“命令行支持”。
'     INI文件處理：讀寫INI文件(Unicode)   ReadIniUnicode / WriteIniUnicode
'     注冊表處理：RegRead讀注冊表、RegWrite寫注冊表
'     日志處理：WriteLog寫文本日志
' 字符串處理：
'     提取：RegExpTest
' 程序：
'     檢測：IsRun是否運(yùn)行、MeIsAlreadyRun本程序是否執(zhí)行、、、、
'     執(zhí)行：Run前臺等待執(zhí)行、RunHide隱藏等待執(zhí)行、RunNotWait前臺不等待執(zhí)行、RunHideNotWite后臺不等待執(zhí)行、
'     加密運(yùn)行：MeEncoder
' 系統(tǒng)：
'     版本
'     延時(shí)：Sleep
'     發(fā)送按鍵：SendKeys
' 網(wǎng)絡(luò)：
'     檢測：Ping、參考“命令行支持”。
'     連接：文件共享、、、、、、、、、、
' 時(shí)間：Format_Time格式化時(shí)間、NowDateTime當(dāng)前時(shí)間
' ====================================================================================================
' ====================================================================================================
' 初始化全局變量
' 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) & "\"                               ' 臨時(shí)文件夾路徑
    WinDir = CreateObject("wscript.Shell").ExpandenVironmentStrings("%windir%") & "\"                           ' 本機(jī) %Windir% 文件夾路徑
    AppDataDir = CreateObject("WScript.Shell").SpecialFolders("AppData") & "\"                                  ' 本機(jī) %AppData% 文件夾路徑
    StartupDir = CreateObject("WScript.Shell").SpecialFolders("Startup") & "\"                                  ' 本機(jī)啟動(dòng)文件夾路徑
    MeDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,"\"))                                  ' 腳本所在文件夾路徑
    ' 腳本位于共享的目錄時(shí)，取得共享的電腦名(UNCHost)，進(jìn)行位置驗(yàn)證(If UNCHost <> "SerNTF02" Then WScript.Quit) ' 防止拷貝到本地運(yùn)行
    UNCHost = LCase(Mid(WScript.ScriptFullName,InStr(WScript.ScriptFullName,"\\")+2,InStr(3,WScript.ScriptFullName,"\",1)-3))
End Sub

' ====================================================================================================
' 小函數(shù)
Sub Sleep( sTime )                          ' 延時(shí) sTime 毫秒
    WScript.Sleep sTime
End Sub
Sub SendKeys( strKey )                      ' 發(fā)送按鍵
    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}
' 實(shí)例：切換輸入法（模擬同時(shí)按下：Shift、Ctrl鍵）"+(^)" ；重啟電腦（模擬按下：Ctrl + Esc、u、r鍵）: "^{ESC}ur" 。
' 同時(shí)按鍵：在按 e和 c的同時(shí)按 SHIFT 鍵: "+(ec)" ；在按 e時(shí)只按 c（而不按 SHIFT）: "+ec" 。
' 重復(fù)按鍵：按 10 次 "x": "{x 10}"。按鍵和數(shù)字間有空格。
' 特殊字符：發(fā)送 “+”、“^” 特殊的控制按鍵："{+}"、"{^}"
' 注意：只可以發(fā)送重復(fù)按一個(gè)鍵的按鍵。例如，可以發(fā)送 10次 "x"，但不可發(fā)送 10次 "Ctrl+x"。
' 注意：不能向應(yīng)用程序發(fā)送 PRINT SCREEN鍵{PRTSC}。
Function AppActivate( strWindowTitle )      ' 激活標(biāo)題包含指定字符窗口，例如判斷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 執(zhí)行程序
Sub Run( strCmd )
    CreateObject("WScript.Shell").Run strCmd, 1, True       ' 正常運(yùn)行 + 等待程序運(yùn)行完成
End Sub
Sub RunNotWait( strCmd )
    CreateObject("WScript.Shell").Run strCmd, 1, False      ' 正常運(yùn)行 + 不等待程序運(yùn)行完成
End Sub
Sub RunHide( strCmd )
    CreateObject("WScript.Shell").Run strCmd, 0, True       ' 隱藏后臺運(yùn)行 + 等待程序運(yùn)行完成
End Sub
Sub RunHideNotWait( strCmd )
    CreateObject("WScript.Shell").Run strCmd, 0, False      ' 隱藏后臺運(yùn)行 + 不等待程序運(yùn)行完成
End Sub

' ====================================================================================================
' CMD 命令集
' ----------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------
' 獲取CMD輸出
Function CmdOut(str)
        Set ws = CreateObject("WScript.Shell")
        host = WScript.FullName
        'Demon注：這里不用這么復(fù)雜吧，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
' 檢測是否運(yùn)行于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 創(chuàng)建文件夾路徑
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 復(fù)制文件或文件夾
Sub Copy( ByVal strSource, ByVal strDestination )
    On Error Resume Next ' Required 必選
    Set fso = CreateObject("Scripting.FileSystemObject")
    If (fso.FileExists(strSource)) Then               ' 如果來源是一個(gè)文件
        If (fso.FolderExists(strDestination)) Then    ' 如果目的地是一個(gè)文件夾，加上路徑后綴反斜線“\”
            fso.CopyFile fso.GetFile(strSource).Path, fso.GetFolder(strDestination).Path & "\", True
        Else                                          ' 如果目的地是一個(gè)文件，直接復(fù)制
            fso.CopyFile fso.GetFile(strSource).Path, strDestination, True
        End If
    End If                                             ' 如果來源是一個(gè)文件夾，復(fù)制文件夾
    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)   ' 十進(jìn)制轉(zhuǎn)二進(jìn)制
    For i = 0 To 16                   ' 二進(jìn)制轉(zhuǎn)16位二進(jìn)制
        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 系統(tǒng)文件。
    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,""))   ' 二進(jìn)制轉(zhuǎn)十進(jìn)制
    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)    ' 十進(jìn)制轉(zhuǎn)二進(jìn)制
   Dim remainder
   remainder = number
   Do While remainder > 0
      DecToBin = CStr(remainder Mod 2) & DecToBin
      remainder = remainder \ 2
   Loop
End Function
Function BinToDec(ByVal binStr)    ' 二進(jìn)制轉(zhuǎn)十進(jìn)制
   Dim i
   For i = 1 To Len(binStr)
      BinToDec = BinToDec + (CInt(Mid(binStr, i, 1)) * (2 ^ (Len(binStr) - i)))
   Next
End Function
' ----------------------------------------------------------------------------------------------------
' Ping 判斷網(wǎng)絡(luò)是否聯(lián)通
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

' ====================================================================================================
' 獲取當(dāng)前的日期時(shí)間，并格式化
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

' ====================================================================================================
' 檢查字符串是否符合正則表達(dá)式
'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         ' 建立正則表達(dá)式。
        regEx.Pattern = patrn      ' 設(shè)置模式。
        regEx.IgnoreCase = True    ' 設(shè)置是否區(qū)分字符大小寫。
        regEx.Global = True        ' 設(shè)置全局可用性。
    Dim RetStr, arrMatchs(), i : i = -1
    Set Matches = regEx.Execute(strng)     ' 執(zhí)行搜索。
    For Each Match in Matches              ' 遍歷匹配集合。
        i = i + 1
        ReDim Preserve arrMatchs(i)        ' 動(dòng)態(tài)數(shù)組：數(shù)組隨循環(huán)而變化
        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       ' 以數(shù)組返回所有符合表達(dá)式的所有數(shù)據(jù)
    If LCase(mode) = LCase("Count") Then RegExpTest = Matches.Count   ' 以整數(shù)返回符合表達(dá)式的所有數(shù)據(jù)總數(shù)
    If IsEmpty(RegExpTest) Then RegExpTest = RetStr                   ' 返回所有匹配結(jié)果
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 不存在時(shí)是否創(chuàng)建新文件。允許創(chuàng)建為 True，否則為 False。默認(rèn)值為 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

' ====================================================================================================
' 程序控制
' 檢測是否運(yùn)行
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
' ----------------------------------------------------------------------------------------------------
' 檢測自身是否重復(fù)運(yùn)行
Function MeIsAlreadyRun()
    MeIsAlreadyRun = False
    If ((IsRun("WScript.exe",WScript.ScriptFullName)>1) Or (IsRun("CScript.exe",WScript.ScriptFullName)>1)) Then MeIsAlreadyRun = True
End Function
' ----------------------------------------------------------------------------------------------------
' 關(guān)閉進(jìn)程
Sub Close_Process(ProcessName)
    'On Error Resume Next
    For each ps in getobject("winmgmts:\\.\root\cimv2:win32_process").instances_    '循環(huán)進(jìn)程
        If Ucase(ps.name)=Ucase(ProcessName) Then
            ps.terminate
        End if
    Next
End Sub

' ====================================================================================================
' 系統(tǒng)
' 檢查操作系統(tǒng)版本
Sub CheckOS()
    If LCase(OSVer()) <> "xp" Then
        Msgbox "不支持該操作系統(tǒng)！　　　　", 48+4096, "警告"
        WScript.Quit    ' 退出程序
    End If
End Sub
' ----------------------------------------------------------------------------------------------------
' 取得操作系統(tǒng)版本
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
' ----------------------------------------------------------------------------------------------------
' 取得操作系統(tǒng)語言
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