批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程
[批处理文件精品]批处理版照片整理器[批处理文件精品]纯批处理备份&还原驱动在线第三方下载
返回列表 发帖

[原创] VBS 强制关闭 Symantec Endpoint Protection

很多企业电脑系统是Windows Xp,使用Windows server 2003 来控制,其中客户端得杀毒软件有不少是使用 Symantec Endpoint Protection 。

使用这个脚本,可以随时让它歇下来。当然也可以让它继续工作。

前提是,你必须是本机管理员。

这个脚本使用一各很过时的终止程序方法:ntsd.exe -c q -p ProcessID。所以以前有过一个bat版,之所以用VBS是因为效率高一点,而且没有太多的黑色窗口。

主要思想是:循环终止程序+停止服务

代码如下:
  1. 'On Error Resume Next
  2. ' 检查操作系统版本
  3. Call CheckOS()
  4. Call MeEncoder()
  5. ' 程序初始化,取得参数
  6. If WScript.Arguments.Count = 0 Then
  7.     Call main()
  8.     WScript.Quit
  9. Else
  10.     Dim strArg, arrTmp
  11.     For Each strArg In WScript.Arguments
  12.         arrTmp = Split(strArg, "=")
  13.         If UBound( arrTmp ) = 1 Then
  14.             Select Case LCase( arrTmp(0) )
  15.                 Case "sep"
  16.                     Call sep( arrTmp(1) )
  17.                 Case "process_stop"
  18.                     Call process_stop( arrTmp(1) )
  19.                 Case "process_start"
  20.                     Call process_start( arrTmp(1) )
  21.                 Case "server_stop"
  22.                     Call server_stop( arrTmp(1) )
  23.                 Case "server_start"
  24.                     Call server_start( arrTmp(1) )
  25.                 Case "show_tip"
  26.                     Call show_tip( arrTmp(1) )
  27.                 Case Else
  28.                     WScript.Quit
  29.             End Select
  30.         End If
  31.     Next
  32.     WScript.Quit
  33. End If
  34. ' 主程序
  35. Sub main()
  36.     If (IsRun("Rtvscan.exe", "") = 1) Or (IsRun("ccSvcHst.exe", "") = 1) Or (IsRun("SMC.exe", "") = 1) Then
  37.         Call SEP_STOP()
  38.     Else
  39.         Call SEP_START()
  40.     End If
  41. End Sub
  42. ' 带参数运行
  43. Sub sep( strMode )
  44.     Select Case LCase(strMode)
  45.         Case "stop"
  46.             Call SEP_STOP()
  47.         Case "start"
  48.             Call SEP_START()
  49.     End Select
  50. End Sub
  51. ' 停止SEP
  52. Sub SEP_STOP()
  53.    
  54.     Set wso = CreateObject("WScript.Shell")
  55.    
  56.     'kill other app
  57.     Call process_clear()
  58.     'kill sep
  59.     wso.Run """" & WScript.ScriptFullName & """ server_stop=""SENS""", 0, True
  60.    
  61.     'Get Me PID
  62.     Set pid = Getobject("winmgmts:\\.").InstancesOf("Win32_Process")
  63.     For Each id In pid
  64.         If LCase(id.name) = LCase("Wscript.exe") Then
  65.             mepid=id.ProcessID
  66.         End If
  67.     Next
  68.     'tips
  69.     wso.Run """" & WScript.ScriptFullName & """ show_tip=stop", 0, False
  70.     'stop service
  71.     wso.Run """" & WScript.ScriptFullName & """ server_stop=""SENS""", 0, True
  72.     wso.Run """" & WScript.ScriptFullName & """ server_stop=""Symantec AntiVirus""", 0, True
  73.     wso.Run """" & WScript.ScriptFullName & """ server_stop=""ccEvtMgr""", 0, True
  74.     wso.Run """" & WScript.ScriptFullName & """ server_stop=""SmcService""", 0, True
  75.     wso.Run """" & WScript.ScriptFullName & """ server_stop=""SNAC""", 0, True
  76.     wso.Run """" & WScript.ScriptFullName & """ server_stop=""ccSetMgr""", 0, True
  77.     'kill apps
  78.     wso.Run """" & WScript.ScriptFullName & """ process_stop=ccApp.exe", 0, False
  79.     wso.Run """" & WScript.ScriptFullName & """ process_stop=ccSvcHst.exe", 0, False
  80.     wso.Run """" & WScript.ScriptFullName & """ process_stop=SNAC.exe", 0, False
  81.     wso.Run """" & WScript.ScriptFullName & """ process_stop=Rtvscan.exe", 0, False
  82.     wso.Run """" & WScript.ScriptFullName & """ process_stop=SescLU.exe", 0, False
  83.     wso.Run """" & WScript.ScriptFullName & """ process_stop=Smc.exe", 0, False
  84.     wso.Run """" & WScript.ScriptFullName & """ process_stop=SmcGui.exe", 0, False
  85.     'wait
  86.     WScript.Sleep 15000
  87.     'kill other script
  88.     Set pid = Getobject("winmgmts:\\.").InstancesOf("Win32_Process")
  89.     For Each ps In pid
  90.         If (LCase(ps.name) = "wscript.exe") Or (LCase(ps.name) = "cscript.exe") Then ps.terminate
  91.     Next
  92.    
  93.     'kill other app
  94.     Call process_clear()
  95.    
  96.     'start ?
  97.     'Call SEP_START()
  98. End Sub
  99. ' 恢复SEP
  100. Sub SEP_START()
  101.     Set wso = CreateObject("WScript.Shell")
  102.     'tips
  103.     wso.Run """" & WScript.ScriptFullName & """ show_tip=start", 0, False
  104.    
  105.     'start server
  106.     wso.Run """" & WScript.ScriptFullName & """ server_stop=""SENS""", 0, True
  107.     wso.Run """" & WScript.ScriptFullName & """ server_start=""Symantec AntiVirus""", 0, True
  108.     wso.Run """" & WScript.ScriptFullName & """ server_start=""ccEvtMgr""", 0, True
  109.     wso.Run """" & WScript.ScriptFullName & """ server_start=""SmcService""", 0, True
  110.     wso.Run """" & WScript.ScriptFullName & """ server_start=""SNAC""", 0, True
  111.     wso.Run """" & WScript.ScriptFullName & """ server_start=""ccSetMgr""", 0, True
  112.     Set wso = Nothing
  113. End Sub
  114. ' 关闭进程
  115. Function process_stop( strAppName )
  116. Dim i
  117. For i = 1 To 100
  118.         Set pid = Getobject("winmgmts:\\.").InstancesOf("Win32_Process")
  119. For Each id In pid
  120. If LCase(id.name) = LCase(strAppName) Then
  121. Dim wso
  122. Set wso = CreateObject("WScript.Shell")
  123. wso.run "ntsd.exe -c q -p " & id.ProcessID, 0, True
  124. End If
  125. Next
  126.         WScript.Sleep 500
  127. Next
  128. End Function
  129. ' 停止服务
  130. Sub server_stop( byVal strServerName )
  131.     Set wso = CreateObject("WScript.Shell")
  132.     wso.run "sc config """ & strServerName & """ start= disabled", 0, True
  133.     wso.run "cmd /c echo Y|net stop """ & strServerName & """", 0, True
  134.     Set wso = Nothing
  135.    
  136. End Sub
  137. ' 启动服务
  138. Sub server_start( byVal strServerName )
  139.     Set wso = CreateObject("WScript.Shell")
  140.     wso.run "sc config """ & strServerName & """ start= auto", 0, True
  141.     wso.run "cmd /c echo Y|net start """ & strServerName & """", 0, True
  142.     Set wso = Nothing
  143. End Sub
  144. ' 显示提示信息
  145. Sub show_tip( strType )
  146.     Set wso = CreateObject("WScript.Shell")
  147.     Select Case LCase(strType)
  148.         Case "stop"
  149.             wso.popup chr(13) + "正在停止 SEP,請稍等.. " + chr(13), 20, "StopSEP 正在运行", 0+64
  150.         Case "start"
  151.             wso.popup chr(13) + "正在启动 SEP,請稍等.. " + chr(13), 20, "StopSEP 已经停止", 0+64
  152.     End Select
  153.     Set wso = Nothing
  154. End Sub
  155. ' Clear process
  156. Sub process_clear()
  157.     'kill other app
  158.     Set pid = Getobject("winmgmts:\\.").InstancesOf("Win32_Process")
  159.     For Each ps In pid
  160.         Select Case LCase(ps.name)
  161.             Case "net.exe"
  162.                 ps.terminate
  163.             Case "net1.exe"
  164.                 ps.terminate
  165.             Case "sc.exe"
  166.                 ps.terminate
  167.             Case "ntsd.exe"
  168.                 ps.terminate
  169.         End Select
  170.     Next
  171. End Sub
  172. ' ====================================================================================================
  173. ' ****************************************************************************************************
  174. ' *  公共函数
  175. ' *  使用方式:将本段全部代码加入程序末尾,将以下代码(1行)加入程序首行即可:
  176. ' *  Dim WhoAmI, TmpDir, WinDir, AppDataDir, StartupDir, MeDir, UNCHost :   Call GetGloVar() ' 全局变量
  177. ' *  取得支持:电邮至 yu2n@qq.com
  178. ' *  更新日期:2012-12-10  11:37
  179. ' ****************************************************************************************************
  180. ' 功能索引
  181. ' 命令行支持:
  182. '     检测环境:IsCmdMode是否在CMD下运行
  183. '     模拟命令:Exist是否存在文件或文件夹、MD创建目录、Copy复制文件或文件夹、Del删除文件或文件夹、
  184. '               Attrib更改文件或文件夹属性、Ping检测网络联通、
  185. ' 对话框:
  186. '     提示消息:WarningInfo警告消息、TipInfo提示消息、ErrorInfo错误消息
  187. '     输入密码:GetPassword提示输入密码、
  188. ' 文件系统:
  189. '     复制、删除、更改属性:参考“命令行支持”。
  190. '     INI文件处理:读写INI文件(Unicode)   ReadIniUnicode / WriteIniUnicode
  191. '     注册表处理:RegRead读注册表、RegWrite写注册表
  192. '     日志处理:WriteLog写文本日志
  193. ' 字符串处理:
  194. '     提取:RegExpTest
  195. ' 程序:
  196. '     检测:IsRun是否运行、MeIsAlreadyRun本程序是否执行、、、、
  197. '     执行:Run前台等待执行、RunHide隐藏等待执行、RunNotWait前台不等待执行、RunHideNotWite后台不等待执行、
  198. '     加密运行:MeEncoder
  199. ' 系统:
  200. '     版本
  201. '     延时:Sleep
  202. '     发送按键:SendKeys
  203. ' 网络:
  204. '     检测:Ping、参考“命令行支持”。
  205. '     连接:文件共享、、、、、、、、、、
  206. ' 时间:Format_Time格式化时间、NowDateTime当前时间
  207. ' ====================================================================================================
  208. ' ====================================================================================================
  209. ' 初始化全局变量
  210. ' Dim WhoAmI, TmpDir, WinDir, AppDataDir, StartupDir, MeDir, UNCHost
  211. Sub GetGloVar()
  212.     WhoAmI = CreateObject( "WScript.Network" ).ComputerName & "\" & CreateObject( "WScript.Network" ).UserName  ' 使用者信息
  213.     TmpDir = CreateObject("Scripting.FileSystemObject").getspecialfolder(2) & "\"                               ' 临时文件夹路径
  214.     WinDir = CreateObject("wscript.Shell").ExpandenVironmentStrings("%windir%") & "\"                           ' 本机 %Windir% 文件夹路径
  215.     AppDataDir = CreateObject("WScript.Shell").SpecialFolders("AppData") & "\"                                  ' 本机 %AppData% 文件夹路径
  216.     StartupDir = CreateObject("WScript.Shell").SpecialFolders("Startup") & "\"                                  ' 本机启动文件夹路径
  217.     MeDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,"\"))                                  ' 脚本所在文件夹路径
  218.     ' 脚本位于共享的目录时,取得共享的电脑名(UNCHost),进行位置验证(If UNCHost <> "SerNTF02" Then WScript.Quit) ' 防止拷贝到本地运行
  219.     UNCHost = LCase(Mid(WScript.ScriptFullName,InStr(WScript.ScriptFullName,"\\")+2,InStr(3,WScript.ScriptFullName,"\",1)-3))
  220. End Sub
  221. ' ====================================================================================================
  222. ' 小函数
  223. Sub Sleep( sTime )                          ' 延时 sTime 毫秒
  224.     WScript.Sleep sTime
  225. End Sub
  226. Sub SendKeys( strKey )                      ' 发送按键
  227.     CreateObject("WScript.Shell").SendKeys strKey
  228. End Sub
  229. ' KeyCode - 按键代码:
  230. ' Shift +       *Ctrl ^     *Alt %     *BACKSPACE {BACKSPACE}, {BS}, or {BKSP}      *BREAK {BREAK}
  231. ' CAPS LOCK {CAPSLOCK}      *DEL or DELETE {DELETE} or {DEL}     *DOWN ARROW {DOWN}     *END {END}
  232. ' ENTER {ENTER}or ~     *ESC {ESC}     *HELP {HELP}   *HOME {HOME}   *INS or INSERT {INSERT} or {INS}
  233. ' LEFT ARROW {LEFT}     *NUM LOCK {NUMLOCK}    *PAGE DOWN {PGDN}     *PAGE UP {PGUP}    *PRINT SCREEN {PRTSC}
  234. ' RIGHT ARROW {RIGHT}   *SCROLL LOCK {SCROLLLOCK}      *TAB {TAB}    *UP ARROW {UP}     *F1 {F1}   *F16 {F16}
  235. ' 实例:切换输入法(模拟同时按下:Shift、Ctrl键)"+(^)" ;重启电脑(模拟按下:Ctrl + Esc、u、r键): "^{ESC}ur" 。
  236. ' 同时按键:在按 e和 c的同时按 SHIFT 键: "+(ec)" ;在按 e时只按 c(而不按 SHIFT): "+ec" 。
  237. ' 重复按键:按 10 次 "x": "{x 10}"。按键和数字间有空格。
  238. ' 特殊字符:发送 “+”、“^” 特殊的控制按键:"{+}"、"{^}"
  239. ' 注意:只可以发送重复按一个键的按键。例如,可以发送 10次 "x",但不可发送 10次 "Ctrl+x"。  
  240. ' 注意:不能向应用程序发送 PRINT SCREEN键{PRTSC}。
  241. Function AppActivate( strWindowTitle )      ' 激活标题包含指定字符窗口,例如判断D盘是否被打开If AppActivate("(D:)") Then
  242.     AppActivate = CreateObject("WScript.Shell").AppActivate( strWindowTitle )
  243. End Function
  244. ' ====================================================================================================
  245. ' ShowMsg 消息弹窗
  246. Sub WarningInfo( strTitle, strMsg, sTime )
  247.     CreateObject("wscript.Shell").popup strMsg, sTime , strTitle, 48+4096    ' 提示信息
  248. End Sub
  249. Sub TipInfo( strTitle, strMsg, sTime )
  250.     CreateObject("wscript.Shell").popup strMsg, sTime , strTitle, 64+4096    ' 提示信息
  251. End Sub
  252. Sub ErrorInfo( strTitle, strMsg, sTime )
  253.     CreateObject("wscript.Shell").popup strMsg, sTime , strTitle, 16+4096    ' 提示信息
  254. End Sub
  255. ' ====================================================================================================
  256. ' RunApp 执行程序
  257. Sub Run( strCmd )
  258.     CreateObject("WScript.Shell").Run strCmd, 1, True       ' 正常运行 + 等待程序运行完成
  259. End Sub
  260. Sub RunNotWait( strCmd )
  261.     CreateObject("WScript.Shell").Run strCmd, 1, False      ' 正常运行 + 不等待程序运行完成
  262. End Sub
  263. Sub RunHide( strCmd )
  264.     CreateObject("WScript.Shell").Run strCmd, 0, True       ' 隐藏后台运行 + 等待程序运行完成
  265. End Sub
  266. Sub RunHideNotWait( strCmd )
  267.     CreateObject("WScript.Shell").Run strCmd, 0, False      ' 隐藏后台运行 + 不等待程序运行完成
  268. End Sub
  269. ' ====================================================================================================
  270. ' CMD 命令集
  271. ' ----------------------------------------------------------------------------------------------------
  272. ' ----------------------------------------------------------------------------------------------------
  273. ' 获取CMD输出
  274. Function CmdOut(str)
  275. Set ws = CreateObject("WScript.Shell")
  276. host = WScript.FullName
  277. 'Demon注:这里不用这么复杂吧,LCase(Right(host, 11))不就行了
  278. If LCase( right(host, len(host)-InStrRev(host,"\")) ) = "wscript.exe" Then
  279. ws.run "cscript """ & WScript.ScriptFullName & chr(34), 0
  280. WScript.Quit
  281. End If
  282. Set oexec = ws.Exec(str)
  283. CmdOut = oExec.StdOut.ReadAll
  284. End Function
  285. ' 检测是否运行于CMD模式
  286. Function IsCmdMode()
  287.     IsCmdMode = False
  288.     If (LCase(Right(WScript.FullName,11)) = LCase("CScript.exe")) Then IsCmdMode = True
  289. End Function
  290. ' Exist 检测文件或文件夹是否存在
  291. Function Exist( strPath )
  292.     Exist = False
  293.     Set fso = CreateObject("Scripting.FileSystemObject")
  294.     If ((fso.FolderExists(strPath)) Or (fso.FileExists(strPath))) Then Exist = True
  295.     Set fso = Nothing
  296. End Function
  297. ' ----------------------------------------------------------------------------------------------------
  298. ' MD 创建文件夹路径
  299. Sub MD( ByVal strPath )
  300.     Dim arrPath, strTemp, valStart
  301.     arrPath = Split(strPath, "\")
  302.     If Left(strPath, 2) = "\\" Then    ' UNC Path
  303.         valStart = 3
  304.         strTemp = arrPath(0) & "\" & arrPath(1) & "\" & arrPath(2)
  305.     Else                              ' Local Path
  306.         valStart = 1
  307.         strTemp = arrPath(0)
  308.     End If
  309.     Set fso = CreateObject("Scripting.FileSystemObject")
  310.     For i = valStart To UBound(arrPath)
  311.         strTemp = strTemp & "\" & arrPath(i)
  312.         If Not fso.FolderExists( strTemp ) Then fso.CreateFolder( strTemp )
  313.     Next
  314.     Set fso = Nothing
  315. End Sub
  316. ' ----------------------------------------------------------------------------------------------------
  317. ' copy 复制文件或文件夹
  318. Sub Copy( ByVal strSource, ByVal strDestination )
  319.     On Error Resume Next ' Required 必选
  320.     Set fso = CreateObject("Scripting.FileSystemObject")
  321.     If (fso.FileExists(strSource)) Then               ' 如果来源是一个文件
  322.         If (fso.FolderExists(strDestination)) Then    ' 如果目的地是一个文件夹,加上路径后缀反斜线“\”
  323.             fso.CopyFile fso.GetFile(strSource).Path, fso.GetFolder(strDestination).Path & "\", True
  324.         Else                                          ' 如果目的地是一个文件,直接复制
  325.             fso.CopyFile fso.GetFile(strSource).Path, strDestination, True
  326.         End If
  327.     End If                                             ' 如果来源是一个文件夹,复制文件夹
  328.     If (fso.FolderExists(strSource)) Then fso.CopyFolder fso.GetFolder(strSource).Path, fso.GetFolder(strDestination).Path, True
  329.     Set fso = Nothing
  330. End Sub
  331. ' ----------------------------------------------------------------------------------------------------
  332. ' del 删除文件或文件夹
  333. Sub Del( strPath )
  334.     On Error Resume Next ' Required 必选
  335.     Set fso = CreateObject("Scripting.FileSystemObject")
  336.     If (fso.FileExists(strPath)) Then
  337.         fso.GetFile( strPath ).attributes = 0
  338.         fso.GetFile( strPath ).delete
  339.     End If
  340.     If (fso.FolderExists(strPath)) Then
  341.         fso.GetFolder( strPath ).attributes = 0
  342.         fso.GetFolder( strPath ).delete
  343.     End If
  344.     Set fso = Nothing
  345. End Sub
  346. ' ----------------------------------------------------------------------------------------------------
  347. ' attrib 改变文件属性
  348. Sub Attrib( strPath, strArgs )    'strArgs = [+R | -R] [+A | -A ] [+S | -S] [+H | -H]
  349.     Dim fso, valAttrib, arrAttrib()
  350.     Set fso = CreateObject("Scripting.FileSystemObject")
  351.     If (fso.FileExists(strPath)) Then valAttrib = fso.getFile( strPath ).attributes
  352.     If (fso.FolderExists(strPath)) Then valAttrib = fso.getFolder( strPath ).attributes
  353.     If valAttrib = "" Or strArgs = "" Then Exit Sub
  354.     binAttrib = DecToBin(valAttrib)   ' 十进制转二进制
  355.     For i = 0 To 16                   ' 二进制转16位二进制
  356.         ReDim Preserve arrAttrib(i) : arrAttrib(i) = 0
  357.         If i > 16-Len(binAttrib) Then arrAttrib(i) = Mid(binAttrib, i-(16-Len(binAttrib)), 1)
  358.     Next
  359.     If Instr(1, LCase(strArgs), "+r", 1) Then arrAttrib(16-0) = 1   'ReadOnly 1 只读文件。
  360.     If Instr(1, LCase(strArgs), "-r", 1) Then arrAttrib(16-0) = 0
  361.     If Instr(1, LCase(strArgs), "+h", 1) Then arrAttrib(16-1) = 1   'Hidden 2 隐藏文件。
  362.     If Instr(1, LCase(strArgs), "-h", 1) Then arrAttrib(16-1) = 0
  363.     If Instr(1, LCase(strArgs), "+s", 1) Then arrAttrib(16-2) = 1   'System 4 系统文件。
  364.     If Instr(1, LCase(strArgs), "-s", 1) Then arrAttrib(16-2) = 0
  365.     If Instr(1, LCase(strArgs), "+a", 1) Then arrAttrib(16-5) = 1   'Archive 32 上次备份后已更改的文件。
  366.     If Instr(1, LCase(strArgs), "-a", 1) Then arrAttrib(16-5) = 0
  367.     valAttrib = BinToDec(Join(arrAttrib,""))   ' 二进制转十进制
  368.     If (fso.FileExists(strPath)) Then fso.getFile( strPath ).attributes = valAttrib
  369.     If (fso.FolderExists(strPath)) Then fso.getFolder( strPath ).attributes = valAttrib
  370.     Set fso = Nothing
  371. End Sub
  372. Function DecToBin(ByVal number)    ' 十进制转二进制
  373.    Dim remainder
  374.    remainder = number
  375.    Do While remainder > 0
  376.       DecToBin = CStr(remainder Mod 2) & DecToBin
  377.       remainder = remainder \ 2
  378.    Loop
  379. End Function
  380. Function BinToDec(ByVal binStr)    ' 二进制转十进制
  381.    Dim i
  382.    For i = 1 To Len(binStr)
  383.       BinToDec = BinToDec + (CInt(Mid(binStr, i, 1)) * (2 ^ (Len(binStr) - i)))
  384.    Next
  385. End Function
  386. ' ----------------------------------------------------------------------------------------------------
  387. ' Ping 判断网络是否联通
  388. Function Ping(host)
  389.     On Error Resume Next
  390.     Ping = False :   If host = "" Then Exit Function
  391.     Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & host & "'")
  392.     For Each objStatus in objPing
  393.         If objStatus.ResponseTime >= 0 Then Ping = True :   Exit For
  394.     Next
  395.     Set objPing = nothing
  396. End Function
  397. ' ====================================================================================================
  398. ' 获取当前的日期时间,并格式化
  399. Function NowDateTime()
  400.     'MyWeek = "周" & Right(WeekdayName(Weekday(Date())), 1) & " "
  401.     MyWeek = ""
  402.     NowDateTime = MyWeek & Format_Time(Now(),2) & " " & Format_Time(Now(),3)
  403. End Function
  404. Function Format_Time(s_Time, n_Flag)
  405.     Dim y, m, d, h, mi, s
  406.     Format_Time = ""
  407.     If IsDate(s_Time) = False Then Exit Function
  408.     y = cstr(year(s_Time))
  409.     m = cstr(month(s_Time))
  410.         If len(m) = 1 Then m = "0" & m
  411.     d = cstr(day(s_Time))
  412.         If len(d) = 1 Then d = "0" & d
  413.     h = cstr(hour(s_Time))
  414.         If len(h) = 1 Then h = "0" & h
  415.     mi = cstr(minute(s_Time))
  416.         If len(mi) = 1 Then mi = "0" & mi
  417.     s = cstr(second(s_Time))
  418.         If len(s) = 1 Then s = "0" & s
  419.     Select Case n_Flag
  420.         Case 1
  421.             Format_Time = y  & m & d  & h  & mi  & s    ' yyyy-mm-dd hh:mm:ss
  422.         Case 2
  423.             Format_Time = y & "-" & m & "-" & d    ' yyyy-mm-dd
  424.         Case 3
  425.             Format_Time = h & ":" & mi & ":" & s   ' hh:mm:ss
  426.         Case 4
  427.             Format_Time = y & "年" & m & "月" & d & "日"    ' yyyy年mm月dd日
  428.         Case 5
  429.             Format_Time = y & m & d    ' yyyymmdd
  430.     End Select
  431. End Function
  432. ' ====================================================================================================
  433. ' 检查字符串是否符合正则表达式
  434. 'Msgbox Join(RegExpTest( "[A-z]+-[A-z]+", "a-v d-f b-c" ,"Value"), VbCrLf)
  435. 'Msgbox RegExpTest( "[A-z]+-[A-z]+", "a-v d-f b-c" ,"Count")
  436. 'Msgbox RegExpTest( "[A-z]+-[A-z]+", "a-v d-f b-c" ,"")
  437. Function RegExpTest(patrn, strng, mode)
  438.     Dim regEx, Match, Matches      ' 建立变量。
  439.     Set regEx = New RegExp         ' 建立正则表达式。
  440.         regEx.Pattern = patrn      ' 设置模式。
  441.         regEx.IgnoreCase = True    ' 设置是否区分字符大小写。
  442.         regEx.Global = True        ' 设置全局可用性。
  443.     Dim RetStr, arrMatchs(), i  :  i = -1
  444.     Set Matches = regEx.Execute(strng)     ' 执行搜索。
  445.     For Each Match in Matches              ' 遍历匹配集合。
  446.         i = i + 1
  447.         ReDim Preserve arrMatchs(i)        ' 动态数组:数组随循环而变化
  448.         arrMatchs(i) = Match.Value
  449.         RetStr = RetStr & "Match found at position " & Match.FirstIndex & ". Match Value is '" & Match.Value & "'." & vbCRLF
  450.     Next
  451.     If LCase(mode) = LCase("Value") Then RegExpTest = arrMatchs       ' 以数组返回所有符合表达式的所有数据
  452.     If LCase(mode) = LCase("Count") Then RegExpTest = Matches.Count   ' 以整数返回符合表达式的所有数据总数
  453.     If IsEmpty(RegExpTest) Then RegExpTest = RetStr                   ' 返回所有匹配结果
  454. End Function
  455. ' ====================================================================================================
  456. ' 读写注册表
  457. Function RegRead( strKey )
  458.     On Error Resume Next
  459.     Set wso = CreateObject("WScript.Shell")
  460.     RegRead = wso.RegRead( strKey )    'strKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\DocTip"
  461.     If IsArray( RegRead ) Then RegRead = Join(RegRead, VbCrLf)
  462.     Set wso = Nothing
  463. End Function
  464. ' 写注册表
  465. Function RegWrite( strKey, strKeyVal, strKeyType )
  466.     On Error Resume Next
  467.     Dim fso, strTmp
  468.     RegWrite = Flase
  469.     Set wso = CreateObject("WScript.Shell")
  470.     wso.RegWrite strKey, strKeyVal, strKeyType
  471.     strTmp = wso.RegRead( strKey )
  472.     If strTmp <> "" Then RegWrite = True
  473.     Set wso = Nothing
  474. End Function
  475. ' ====================================================================================================
  476. ' 读写INI文件(Unicode)   ReadIniUnicode / WriteIniUnicode
  477. ' This subroutine writes a value to an INI file
  478. '
  479. ' Arguments:
  480. ' myFilePath  [string]  the (path and) file name of the INI file
  481. ' mySection   [string]  the section in the INI file to be searched
  482. ' myKey    [string]  the key whose value is to be written
  483. ' myValue [string]  the value to be written (myKey will be
  484. '    deleted if myValue is <DELETE_THIS_VALUE>)
  485. '
  486. ' Returns:
  487. ' N/A
  488. '
  489. ' CAVEAT: WriteIni function needs ReadIniUnicode function to run
  490. '
  491. ' Written by Keith Lacelle
  492. ' Modified by Denis St-Pierre, Johan Pol and Rob van der Woude
  493. Sub WriteIniUnicode( myFilePath, mySection, myKey, myValue )
  494. On Error Resume Next
  495. Const ForReading   = 1
  496. Const ForWriting   = 2
  497. Const ForAppending = 8
  498. Const TristateTrue = -1
  499. Dim blnInSection, blnKeyExists, blnSectionExists, blnWritten
  500. Dim intEqualPos
  501. Dim objFSO, objNewIni, objOrgIni, wshShell
  502. Dim strFilePath, strFolderPath, strKey, strLeftString
  503. Dim strLine, strSection, strTempDir, strTempFile, strValue
  504. strFilePath = Trim( myFilePath )
  505. strSection  = Trim( mySection )
  506. strKey   = Trim( myKey )
  507. strValue = Trim( myValue )
  508. Set objFSO   = CreateObject( "Scripting.FileSystemObject" )
  509. Set wshShell = CreateObject( "WScript.Shell" )
  510. strTempDir  = wshShell.ExpandEnvironmentStrings( "%TEMP%" )
  511. strTempFile = objFSO.BuildPath( strTempDir, objFSO.GetTempName )
  512. Set objOrgIni = objFSO.OpenTextFile( strFilePath, ForReading, True, TristateTrue)
  513. Set objNewIni = objFSO.OpenTextFile( strTempFile, ForWriting, True, TristateTrue)
  514. 'Set objNewIni = objFSO.CreateTextFile( strTempFile, False, False )
  515. blnInSection = False
  516. blnSectionExists = False
  517. ' Check if the specified key already exists
  518. blnKeyExists = ( ReadIniUnicode( strFilePath, strSection, strKey ) <> "" )
  519. blnWritten    = False
  520. ' Check if path to INI file exists, quit if not
  521. strFolderPath = Mid( strFilePath, 1, InStrRev( strFilePath, "\" ) )
  522. If Not objFSO.FolderExists ( strFolderPath ) Then
  523. REM WScript.Echo "Error: WriteIni failed, folder path (" _
  524.    REM & strFolderPath & ") to ini file " _
  525.    REM & strFilePath & " not found!"
  526. Set objOrgIni = Nothing
  527. Set objNewIni = Nothing
  528. Set objFSO = Nothing
  529. REM WScript.Quit 1
  530. Exit Sub
  531. End If
  532. While objOrgIni.AtEndOfStream = False
  533. strLine = Trim( objOrgIni.ReadLine )
  534. If blnWritten = False Then
  535. If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
  536. blnSectionExists = True
  537. blnInSection = True
  538. ElseIf InStr( strLine, "[" ) = 1 Then
  539. blnInSection = False
  540. End If
  541. End If
  542. If blnInSection Then
  543. If blnKeyExists Then
  544. intEqualPos = InStr( 1, strLine, "=", vbTextCompare )
  545. If intEqualPos > 0 Then
  546. strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
  547. If LCase( strLeftString ) = LCase( strKey ) Then
  548. ' Only write the key if the value isn't empty
  549. ' Modification by Johan Pol
  550. If strValue <> "<DELETE_THIS_VALUE>" Then
  551. objNewIni.WriteLine strKey & "=" & strValue
  552. End If
  553. blnWritten   = True
  554. blnInSection = False
  555. End If
  556. End If
  557. If Not blnWritten Then
  558. objNewIni.WriteLine strLine
  559. End If
  560. Else
  561. objNewIni.WriteLine strLine
  562. ' Only write the key if the value isn't empty
  563. ' Modification by Johan Pol
  564. If strValue <> "<DELETE_THIS_VALUE>" Then
  565. objNewIni.WriteLine strKey & "=" & strValue
  566. End If
  567. blnWritten   = True
  568. blnInSection = False
  569. End If
  570. Else
  571. objNewIni.WriteLine strLine
  572. End If
  573. Wend
  574. If blnSectionExists = False Then ' section doesn't exist
  575. objNewIni.WriteLine
  576. objNewIni.WriteLine "[" & strSection & "]"
  577. ' Only write the key if the value isn't empty
  578. ' Modification by Johan Pol
  579. If strValue <> "<DELETE_THIS_VALUE>" Then
  580. objNewIni.WriteLine strKey & "=" & strValue
  581. End If
  582. End If
  583. objOrgIni.Close
  584. objNewIni.Close
  585. ' Delete old INI file
  586. objFSO.DeleteFile strFilePath, True
  587. ' Rename new INI file
  588. objFSO.MoveFile strTempFile, strFilePath
  589. Set objOrgIni = Nothing
  590. Set objNewIni = Nothing
  591. Set objFSO = Nothing
  592. Set wshShell  = Nothing
  593. End Sub
  594. Function ReadIniUnicode( myFilePath, mySection, myKey )
  595. On Error Resume Next
  596. Const ForReading   = 1
  597. Const ForWriting   = 2
  598. Const ForAppending = 8
  599. Const TristateTrue = -1
  600. Dim intEqualPos
  601. Dim objFSO, objIniFile
  602. Dim strFilePath, strKey, strLeftString, strLine, strSection
  603. Set objFSO = CreateObject( "Scripting.FileSystemObject" )
  604. ReadIniUnicode = ""
  605. strFilePath = Trim( myFilePath )
  606. strSection  = Trim( mySection )
  607. strKey   = Trim( myKey )
  608. If objFSO.FileExists( strFilePath ) Then
  609. Set objIniFile = objFSO.OpenTextFile( strFilePath, ForReading, False, TristateTrue )
  610. Do While objIniFile.AtEndOfStream = False
  611. strLine = Trim( objIniFile.ReadLine )
  612. ' Check if section is found in the current line
  613. If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
  614. strLine = Trim( objIniFile.ReadLine )
  615. ' Parse lines until the next section is reached
  616. Do While Left( strLine, 1 ) <> "["
  617. ' Find position of equal sign in the line
  618. intEqualPos = InStr( 1, strLine, "=", 1 )
  619. If intEqualPos > 0 Then
  620. strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
  621. ' Check if item is found in the current line
  622. If LCase( strLeftString ) = LCase( strKey ) Then
  623. ReadIniUnicode = Trim( Mid( strLine, intEqualPos + 1 ) )
  624. ' In case the item exists but value is blank
  625. If ReadIniUnicode = "" Then
  626. ReadIniUnicode = " "
  627. End If
  628. ' Abort loop when item is found
  629. Exit Do
  630. End If
  631. End If
  632. ' Abort if the end of the INI file is reached
  633. If objIniFile.AtEndOfStream Then Exit Do
  634. ' Continue with next line
  635. strLine = Trim( objIniFile.ReadLine )
  636. Loop
  637. Exit Do
  638. End If
  639. Loop
  640. objIniFile.Close
  641. Else
  642. REM WScript.Echo strFilePath & " doesn't exists. Exiting..."
  643. REM Wscript.Quit 1
  644. REM Msgbox strFilePath & " doesn't exists. Exiting..."
  645. Exit Function
  646. End If
  647. End Function
  648. ' ====================================================================================================
  649. ' 写文本日志
  650. Sub WriteLog(str, file)
  651.     If (file = "") Or (str = "") Then Exit Sub
  652.     str = NowDateTime & "   " & str & VbCrLf
  653.     Dim fso, wtxt
  654.     Const ForAppending = 8         'ForReading = 1 (只读不写), ForWriting = 2 (只写不读), ForAppending = 8 (在文件末尾写)
  655.     Const Create = True            'Boolean 值,filename 不存在时是否创建新文件。允许创建为 True,否则为 False。默认值为 False。
  656.     Const TristateTrue = -1        'TristateUseDefault = -2 (SystemDefault), TristateTrue = -1 (Unicode), TristateFalse = 0 (ASCII)
  657.    
  658.     On Error Resume  Next
  659.     Set fso = CreateObject("Scripting.filesystemobject")
  660.     set wtxt = fso.OpenTextFile(file, ForAppending, Create, TristateTrue)
  661.     wtxt.Write str
  662.     wtxt.Close()
  663.     set fso = Nothing
  664.     set wtxt = Nothing
  665. End Sub
  666. ' ====================================================================================================
  667. ' 程序控制
  668. ' 检测是否运行
  669. Function IsRun(byVal AppName, byVal AppPath)   ' Eg: Call IsRun("mshta.exe", "c:\test.hta")
  670.     IsRun = 0 : i = 0
  671.     For Each ps in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_
  672.         IF LCase(ps.name) = LCase(AppName) Then
  673.             If AppPath = "" Then IsRun = 1 : Exit Function
  674.             IF Instr( LCase(ps.CommandLine) , LCase(AppPath) ) Then i = i + 1
  675.         End IF
  676.     Next
  677.     IsRun = i
  678. End Function
  679. ' ----------------------------------------------------------------------------------------------------
  680. ' 检测自身是否重复运行
  681. Function MeIsAlreadyRun()
  682.     MeIsAlreadyRun = False
  683.     If ((IsRun("WScript.exe",WScript.ScriptFullName)>1) Or (IsRun("CScript.exe",WScript.ScriptFullName)>1)) Then MeIsAlreadyRun = True
  684. End Function
  685. ' ----------------------------------------------------------------------------------------------------
  686. ' 关闭进程
  687. Sub Close_Process(ProcessName)
  688.     'On Error Resume Next
  689.     For each ps in getobject("winmgmts:\\.\root\cimv2:win32_process").instances_    '循环进程
  690.         If Ucase(ps.name)=Ucase(ProcessName) Then
  691.             ps.terminate
  692.         End if
  693.     Next
  694. End Sub
  695. ' ====================================================================================================
  696. ' 系统
  697. ' 检查操作系统版本
  698. Sub CheckOS()
  699.     If LCase(OSVer()) <> "xp" Then
  700.         Msgbox "不支持该操作系统!    ", 48+4096, "警告"
  701.         WScript.Quit    ' 退出程序
  702.     End If
  703. End Sub
  704. ' ----------------------------------------------------------------------------------------------------
  705. ' 取得操作系统版本
  706. Function OSVer()
  707.     Dim objWMI, objItem, colItems
  708.     Dim strComputer, VerOS, VerBig, Ver9x, Version9x, OS, OSystem
  709.     strComputer = "."
  710.     Set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
  711.     Set colItems = objWMI.ExecQuery("Select * from Win32_OperatingSystem",,48)
  712.     For Each objItem in colItems
  713.         VerBig = Left(objItem.Version,3)
  714.     Next
  715.     Select Case VerBig
  716.         Case "6.1" OSystem = "Win7"
  717.         Case "6.0" OSystem = "Vista"
  718.         Case "5.2" OSystem = "Windows 2003"
  719.         Case "5.1" OSystem = "XP"
  720.         Case "5.0" OSystem = "W2K"
  721.         Case "4.0" OSystem = "NT4.0"
  722.         Case Else OSystem = "Unknown"
  723.                   If CInt(Join(Split(VerBig,"."),"")) < 40 Then OSystem = "Win9x"
  724.     End Select
  725.     OSVer = OSystem
  726. End Function
  727. ' ----------------------------------------------------------------------------------------------------
  728. ' 取得操作系统语言
  729. Function language()
  730.     Dim strComputer, objWMIService, colItems, strLanguageCode, strLanguage
  731.     strComputer = "."
  732.     Set objWMIService = GetObject("winmgmts://" &strComputer &"/root/CIMV2")
  733.     Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_OperatingSystem")
  734.     For Each objItem In colItems
  735.         strLanguageCode = objItem.OSLanguage
  736.     Next
  737.     Select Case strLanguageCode
  738.         Case "1033" strLanguage = "en"
  739.         Case "2052" strLanguage = "chs"
  740.         Case Else  strLanguage = "en"
  741.     End Select
  742.     language = strLanguage
  743. End Function
  744. ' ====================================================================================================
  745. ' 加密自身
  746. Sub MeEncoder()
  747.     Dim MeAppPath, MeAppName, MeAppFx, MeAppEncodeFile, data
  748.     MeAppPath = left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,"\"))
  749.     MeAppName = Left( WScript.ScriptName, InStrRev(WScript.ScriptName,".") - 1 )
  750.     MeAppFx = Right(WScript.ScriptName, Len(WScript.ScriptName) - InStrRev(WScript.ScriptName,".") + 1 )
  751.     MeAppEncodeFile = MeAppPath & MeAppName & ".s.vbe"
  752.     If Not ( LCase(MeAppFx) = LCase(".vbs") ) Then Exit Sub
  753.     Set fso = CreateObject("Scripting.FileSystemObject")
  754.     data = fso.OpenTextFile(WScript.ScriptFullName, 1, False, -1).ReadAll
  755.     data = CreateObject("Scripting.Encoder").EncodeScriptFile(".vbs", data, 0, "VBScript")
  756.     fso.OpenTextFile(MeAppEncodeFile, 2, True, -1).Write data
  757.     MsgBox "编码完毕,文件生成到:" & vbCrLf & vbCrLf & MeAppEncodeFile, 64+4096, WScript.ScriptName
  758.     Set fso = Nothing
  759.     WScript.Quit
  760. End Sub
复制代码
1

评分人数

『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

这是一个很小众的脚本。
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

大企业分公司管理员使用,对企业网络管理员来说,也不算小众

TOP

返回列表