网站首页  汉语字词  英语词汇  考试资料  写作素材  旧版资料

请输入您要查询的考试资料：

　

标题 VBS 强制关闭Symantec Endpoint Protection的代码
内容
    很多企业电脑系统是Windows Xp，使用Windows server 2003 来控制，其中客户端得杀毒软件有不少是使用 Symantec Endpoint Protection
    使用这个脚本，可以随时让它歇下来。当然也可以让它继续工作。
    前提是，你必须是本机管理员。
    这个脚本使用一各很过时的终止程序方法：ntsd.exe -c q -p ProcessID。所以以前有过一个bat版，之所以用VBS是因为效率高一点，而且没有太多的黑色窗口。
    主要思想是：循环终止程序+停止服务
    代码如下:
    '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
随便看

　

在线学习网考试资料包含高考、自考、专升本考试、人事考试、公务员考试、大学生村官考试、特岗教师招聘考试、事业单位招聘考试、企业人才招聘、银行招聘、教师招聘、农村信用社招聘、各类资格证书考试等各类考试资料。

　

Copyright © 2002-2024 cuapp.net All Rights Reserved
更新时间：2025/5/17 8:01:51