关于按键精灵一个很简单的问题，我录制了一个一直循环的脚本，但是里面有一项问题：循环脚本里面有段时间是下载东西。这段时间有时长10秒钟有时是一分钟不等，所以运行脚本的时候如果时间不正确的话，脚本就乱跑了？请问怎么解决？可不可以从图片上面入手？求高手。下面附图！如果能解决可追加分！！
关于按键精灵一个很简单的问题，我录制了一个一直循环的脚本，但是里面有一项问题：循环脚本里面有段时间是下载东西。这段时间有时长10秒钟有时是一分钟不等，所以运行脚本的时候如果时间不正确的话，脚本就乱跑了？请问怎么解决？可不可以从图片上面入手？求高手。下面附图！如果能解决可追加分！！
不区分大小写匿名
我对按键精灵不是很了解， 应该也差不多吧 。&&&& 加个判断应该可以解决。&
其实这种问题最好是发出源代码的，下面给出若干个解决方案。1、找到录制时的延迟执行时间（下载中的延迟）。&&&&& 在click类操作的后面会有delay操作，改成1分半钟，即9W毫秒。（但是更长便会出错）&2、利用网络命令-网络插件追加测试条件。&&&&& 但不清楚你用的是wqm还是按键精灵主体，基本就是捕获窗口句柄，判断是否能获取open标签，但是这个要看页面架构，以及脚本写作者是否熟识写作和分析网页。（较难）&3、利用脚本技巧里的一键抓取鼠标坐标和颜色。&&&&& 既然网页在下载前后所变化，那你就利用这点，抓取的颜色是否与预设的颜色一致，由此判断是否下载完成。&&&& 具体操作：鼠标放在open的那个绿块的位置，先运行一次抓取脚本。得到位置与颜色。&&&&&&&&&&&&&&&&&&&&&& 在你的脚本里添加上变量x1，y1和color1，分别用来保存坐标与颜色。&&&&&&&&&&&&&&&&&&&&&& 然后创建变量x2，y2，color2，用来保存每个一段时间抓取一次的坐标与颜色。&&&&&&&&&&&&&&&&&&&&&& 添加判断条件为：x1，y1，color1和x2，y2，color2相等。&&&&&&&&&&&&&&&&&&&&&& 相等时，文件下载完成，接着下面的步骤，否则循环。具体写法是：dim x,y,color1,color2moveto x,ycolor2=getpixelcolor(x,y)while(color1 && color2)delay 10000endwhile.....继续执行你要的加上这段代码便行了，当然你要自己修改一下关键字的大小写，和录制的源代码的部分。修改的地点就在第一次录制时的延迟位置。
上面的小段的意思是：声明4个变量。------------------------x和y和color1要在声明后用先前抓取的变量进行赋值鼠标移动至变量所在位置。-------------------其实可以不移动的，不惯写按键精灵抓取变量的颜色，并赋值给color2。判断color1和color2是否不等。--------------按键精灵好像用VB为根基的，所以不等号应该是这个。&&&&&& 是，则循环。&&&&&& 不是，则终止循环，并进入后面的语句。
可否留下联系方式？帮帮我。我自己不怎么会按键精灵的语句，谢谢！
兄弟，留个联系方式帮我操作一个。实现是看不懂代码
源代码可以发一下么
相关知识略懂社热议等待您来回答
编程领域专家
& &SOGOU - 京ICP证050897号按键精灵的大师们.有5个数 a.b.c.d.e取出其中3个数,要求这3个数相加等于10的倍数如果有就枚举出每种情况的数组.没有就结束.我知道取余数的方法,if x+y+z mod 10 = 0
最好是数组,例如A（0）到A（10）这样给你个参考Dim aa(10)For a = 0 To 10For b = a + 1 To 10For c = b + 1 To 10If (aa(a) + aa(b) + aa(c)) mod 10 = 0 Then TracePrint a & "," & b & "," & cEnd IfNextNextNext x+y+z mod 10 = 0 这样是不对的,学过初中数学你也应该知道乘除运算优于加减这就变成了 x+y+(z mod 10)
为您推荐：
其他类似问题
扫描下载二维码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.QuitElse&&& 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.QuitEnd 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 IfEnd Sub
' 带参数运行Sub sep( strMode )&&& Select Case LCase(strMode)&&&&&&& Case "stop"&&&&&&&&&&& Call SEP_STOP()&&&&&&& Case "start"&&&&&&&&&&& Call SEP_START()&&& End SelectEnd Sub
' 停止SEPSub 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
' 恢复SEPSub 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 = NothingEnd 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&&&&&&& NextEnd 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 = NothingEnd 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
' 显示提示信息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 = NothingEnd Sub
' Clear processSub 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&&& NextEnd Sub
' ====================================================================================================' ****************************************************************************************************' *& 公共函数' *& 使用方式：将本段全部代码加入程序末尾，将以下代码(1行)加入程序首行即可：' *& Dim WhoAmI, TmpDir, WinDir, AppDataDir, StartupDir, MeDir, UNCHost :&& Call GetGloVar() ' 全局变量' *& 取得支持：电邮至 ' *& 更新日期：& 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, UNCHostSub 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 sTimeEnd SubSub SendKeys( strKey )&&&&&&&&&&&&&&&&&&&&& ' 发送按键&&& CreateObject("WScript.Shell").SendKeys strKeyEnd 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 SubSub TipInfo( strTitle, strMsg, sTime )&&& CreateObject("wscript.Shell").popup strMsg, sTime , strTitle, 64+4096&&& ' 提示信息End SubSub 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 SubSub RunNotWait( strCmd )&&& CreateObject("WScript.Shell").Run strCmd, 1, False&&&&& ' 正常运行 + 不等待程序运行完成End SubSub RunHide( strCmd )&&& CreateObject("WScript.Shell").Run strCmd, 0, True&&&&&& ' 隐藏后台运行 + 等待程序运行完成End SubSub 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.ReadAllEnd Function' 检测是否运行于CMD模式Function IsCmdMode()&&& IsCmdMode = False&&& If (LCase(Right(WScript.FullName,11)) = LCase("CScript.exe")) Then IsCmdMode = TrueEnd 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 = NothingEnd 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 = NothingEnd 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 = NothingEnd 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 = NothingEnd 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 = NothingEnd SubFunction DecToBin(ByVal number)&&& ' 十进制转二进制&& Dim remainder&& remainder = number&& Do While remainder & 0&&&&& DecToBin = CStr(remainder Mod 2) & DecToBin&&&&& remainder = remainder \ 2&& LoopEnd FunctionFunction BinToDec(ByVal binStr)&&& ' 二进制转十进制&& Dim i&& For i = 1 To Len(binStr)&&&&& BinToDec = BinToDec + (CInt(Mid(binStr, i, 1)) * (2 ^ (Len(binStr) - i)))&& NextEnd 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 = nothingEnd Function
' ====================================================================================================' 获取当前的日期时间，并格式化Function NowDateTime()&&& 'MyWeek = "周" & Right(WeekdayName(Weekday(Date())), 1) & " "&&& MyWeek = ""&&& NowDateTime = MyWeek & Format_Time(Now(),2) & " " & Format_Time(Now(),3)End FunctionFunction 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 SelectEnd 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 = NothingEnd 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 = NothingEnd 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'' C***EAT:&&&&&&&& WriteIni function needs ReadIniUnicode function to run'' Written by Keith Lacelle' Modified by Denis St-Pierre, Johan Pol and Rob van der WoudeSub 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 SubFunction 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 IfEnd 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 = NothingEnd 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( mandLine) , LCase(AppPath) ) Then i = i + 1&&&&&&& End IF&&& Next&&& IsRun = iEnd Function' ----------------------------------------------------------------------------------------------------' 检测自身是否重复运行Function MeIsAlreadyRun()&&& MeIsAlreadyRun = False&&& If ((IsRun("WScript.exe",WScript.ScriptFullName)&1) Or (IsRun("CScript.exe",WScript.ScriptFullName)&1)) Then MeIsAlreadyRun = TrueEnd 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&&& NextEnd Sub
' ====================================================================================================' 系统' 检查操作系统版本Sub CheckOS()&&& If LCase(OSVer()) && "xp" Then&&&&&&& Msgbox "不支持该操作系统！　　　　", 48+4096, "警告"&&&&&&& WScript.Quit&&& ' 退出程序&&& End IfEnd 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 = OSystemEnd 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 = strLanguageEnd 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.QuitEnd Sub
大家感兴趣的内容
12345678910
最近更新的内容
常用在线小工具