VBS 强制关闭Symantec Endpoint Protection的代码

当前位置：首页 > 范文|应用文 > IT技术专栏 > 脚本栏目

来源：易贤网阅读：1662 次日期：2016-06-30 11:22:55

温馨提示：易贤网小编为您整理了“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

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

'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

'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

WScript.Sleep 500

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

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 )

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)

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)))

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

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

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

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

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

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

' 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

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

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)

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

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

上一篇：vbsTree VBS脚本模拟tree命令

下一篇：VBS 修改远程桌面端口号的代码

易贤网手机网站地址：VBS 强制关闭Symantec Endpoint Protection的代码

由于各方面情况的不断调整与变化，易贤网提供的所有考试信息和咨询回复仅供参考，敬请考生以权威部门公布的正式信息和咨询为准！