{+-----------------------------------------------+
 | Эта программа устанавливает автономный антиви-|
 | рус-фаг на любой  EXE-файл  или группу файлов.|
 | Код антивируса берется из файла  FAG.PRG (или |
 | загрузочной части любого другого EXE-файла).  |
 | Формат обращения:                             |
 |          SetFag <EXE> [/F:<FAG>] [/NOBAK]     |
 | <EXE> - имя защищаемого EXE-файла (допускает- |
 |         ся групповое имя с использованием "*" |
 |         и "?";  можно указать маршрут поиска; |
 |         по умолчанию  назначается  расширение |
 |         EXE);                                 |
 | <FAG> - имя EXE-файла с кодом фага; если ключ |
 |         не задан, код берется из файла FAG.PRG|
 | Ключ /NOBAK блокирует создание резервных копий|
 | защищаемых файлов (с расширением BAK).        |
 +-----------------------------------------------+}
Uses F_Anti,DOS;
const
  LT = 63;  {Длина строк сообщения}
  NT = 20;  {Количество строк сообщения}
  Text: array [1..NT] of String[LT] =(
  'Эта программа устанавливает автономный антивирус-фаг на любой',
  'EXE-файл или группу файлов.  Код антивируса берется из файла',
  'FAG.PRG (или загрузочной части любого другого EXE-файла).    ',
  'Формат обращения:',
  '               SetFag <EXE> [/F:<FAG>] [/NOBAK]',
  '<EXE> - имя защищаемого  EXE-файла (допускается групповое имя',
  '        с использованием "*" и "?"; можно указать маршрут по-',
  '        иска; по умолчанию назначается расширение EXE);',
  '<FAG> - имя EXE-файла с кодом фага; если  ключ  не задан, код',
  '        берется из файла FAG.PRG;',
  'Ключ /NOBAK блокирует создание резервных копий защищаемых фай-',
  'лов (с расширением BAK).',
  'Примеры:',
  '                       setfag myprog',
  'Файл MYPROG.EXE будет содержать защищенную программу,MYPROG.BAK',
  '- исходную. Код фага будет взят из файла FAG.PRG',
  '             setfag d:\dir\* /nobak /f:myfag.exe',
  'Защищаются все EXE-файлы из каталога D:\DIR, резервные копии не',
  ' создаются, код фага берется из MYFAG.EXE.',
  '                                         (C) В.В.Фаронов, 1992');
type
  HeadType = record case Byte of
  1:(
    Sign   : Word; {Сигнатура 'MZ' = $5A4D}
    PartPag: Word; {Часть неполного сектора}
    PageCnt: Word; {Количество секторов}
    ReloCnt: Word; {Количество элементов в таблице перемещения}
    HdrSize: Word; {Длина заголовка в параграфах}
    MinMem : Word; {Минимальный размер кучи}
    MaxMem : Word; {Максимальный размер кучи}
    ReloSS : Word; {Начальное значение сегмента стека SS}
    ExeSP  : Word; {Начальное значение указателя стека SP}
    ChkSum : Word; {Контрольная сумма всех слов файла}
    ExeIP  : Word; {Смещениеточки запуска программы}
    ReloCS : Word; {Начальное значение сегмента кода CS});
  2:(W: array [1..12] of Word)
  end;
  TKey = record
    Head24: HeadType; {24 байта эталонного заголовка}
    StartS: Word;     {Относительный сегмент}
    StartO: Word;     {и смещение точки запуска программы}
    Leng24: LongInt;  {Длина незараженной программы минус 24 байта}
    Key   : Word;     {Ключ шифровки}
  end;
  ByteArr = array [1..MaxInt] of Byte;
var
  H,HFag: HeadType;
  HH    : TKey;
  fe,                		{EXE-файл}
  ff: file;          		{Файл с кодом фага}
  LFag: LongInt;     		{Длина кода фага}
  CFag: ^ByteArr;    		{Указатель на код фага}
  NE: String;        		{Имя исходного EXE-файла}
  NF: String;        		{Имя файла с кодом фага}
  S: SearchRec;
  d: DirStr;
  n: NameStr;
  e: ExtStr;
  LS: LongInt;       		{Смещение для фага}
const
  FagName = 'Fag.prg';       	{Имя файла-фага}
  BakFile : Boolean = True;  	{Признак BAK-файлов}
{-------------------}
PROCEDURE Help;
  {Выводит справку об использовании программы и завершает работу}
const
  Bord = 14;
var
  k: Integer;
BEGIN
  for k := 1 to LT+Bord+1 do
    Write('*');
  WriteLn;
  for k := 1 to NT do
    WriteLn('*',' ':Bord div 2,
      Text[k],'*':LT+Bord div 2-Length(Text[k]));
  for k := 1 to LT+Bord+1 do
    Write('*');
  WriteLn;
  Halt
END;  {Help}
{-------------------}
PROCEDURE CheckParam;
  {Проверяет параметры вызова и дает диагностику,
   если нe задано имя защищаемого файла}
var
  k: Integer;
  s,n,e: String;
Function UpString(s: String): string;
var
  k: Integer;
begin
  for k := 1 to Length(s) do
    s[k] := UpCase(s[k]);
  UpString := s
end;  {UpString}
BEGIN {CheckParam}
  NE := '';
  NF := FagName;
  for k := 1 to ParamCount do
    begin
      s := UpString(ParamStr(k));
      if s='/NOBAK' then
        BakFile := False
      else
        if pos('/F:',s)<>0 then
          NF := copy(s,4,Length(s)-3)
        else
          if NE='' then
            NE := s
          else
            begin
              WriteLn('Ошибка в обращении');
              Help
            end
    end;
  if NE = '' then
    Help;
  if pos(':',NF)=0 then
    begin  {Не указан путь к фагу}
      s := ParamStr(0);
      FSplit(s,s,n,e);
      NF := s+NF  {Взять путь к SetFag}
    end
END;  {CheckParam}
{-------------------}
PROCEDURE NotAccess(s: String);
  {Выводит сообщение 'Нет доступа...' и справку}
BEGIN
  WriteLn('Нет доступа к файлу ',s);
  Help
END;  {NotAccess}
{-------------------}
FUNCTION CheckRead(s: String; k,n: Word):Boolean;
  {Проверяет корректность чтения и дает
  сообщение, если требуемое количество K байт
  не равно прочитанному N байт}
BEGIN
  if k<>n then
    begin
      WriteLn('Ошибка чтения из файла ',s);
      CheckRead := False
    end
  else
    CheckRead := True
END;  {CheckRead}
{-------------------}
FUNCTION CheckWrite(s: String;
                    k,n: Word): Boolean;
  {Проверяет корректность записи и дает
   сообщение, если требуемое количество K байт
   не равно записанному N байт}
BEGIN
  if k<>n then
    begin
      WriteLn('Ошибка записи в файл ',s);
      CheckWrite := False
    end
  else
    CheckWrite := True
END;  {CheckRead}
{-------------------}
PROCEDURE OpenFag;
  {Открывает файл-фаг и считывает его код
   в динамическую память}
var
  k: Word;
BEGIN
  Assign(ff,NF);
  {$I-}
  Reset(ff,1);
  {$I+}
  if IOResult <> 0 then
    NotAccess(NF);
  BlockRead(ff,HFag,SizeOf(HFag),k);
  if not CheckRead(NF,SizeOf(HFag),k) then
    Halt;
  LFag := FileSize(ff)-HFag.HdrSize*16-SizeOf(TKey);
  GetMem(CFag,LFag);
  Seek(ff,FileSize(ff)-LFag);
  BlockRead(ff,CFag^,LFag,k);
  if not CheckRead(NF,LFag,k) then
    Halt;
  Close(ff)
END;  {OpenFag}
{-------------------}
FUNCTION CheckFile: Boolean;
  {Проверяет возможность установки защиты
   и готовит новый заголовок файла}
var
  r: registers;
  s: String[1];
  k: Word;
  p: ^ByteArr;
label
  NotFag;
const
  txt1='Файл ';
  txt2=' содержит оверлеи, архив или отладочную информацию.';
BEGIN
  CheckFile := False;
  BlockRead(fe,H,SizeOf(H),k); {Читаем заголовок}
  if not CheckRead(NE,SizeOf(H),k) then
    goto NotFag;               {Ошибка чтения}
  if H.Sign <> $5A4D then
    begin
      WriteLn('Файл ',NE,' не является EXE-программой!');
NotFag:
      WriteLn('Защита не установлена');
      Exit
    end
  else
    begin
      if FileSize(fe)-H.HdrSize*16>LFag then
      {Проверяем и блокируем повторную защиту}
        begin
          GetMem(p,LFag);
          Seek(fe,FileSize(fe)-LFag);
          BlockRead(fe,p^,LFag,k);
          k := LFag div 2;   {Сравниваем, начиная с середины кода}
          repeat
            inc(k)
          until (k>LFag) or (p^[k]<>CFag^[k]);
          FreeMem(p,LFag);
          if k > LFag then
            begin
              WriteLn('Файл ',NE,' уже защищен!');
              Exit
            end
        end;
      {Проверяем размер программы}
      Intr($12,r);       {Получаем объем памяти}
      LS := FileSize(fe)+LFag+SizeOf(HH)+15;
      if r.AX*1024.0-LS-H.MinMem*16 <= 0 then
        begin
          WriteLn('Файл ',NE,' слишком велик!');
          goto NotFag
        end;
      if (FileSize(fe)+15) div 16>H.PageCnt+H.HdrSize then
        begin
          WriteLn(txt1,NE,txt2);
          Write('Устанавливать защиту (Y/N,умлч.Y)? ');
          s := '';
          ReadLn(s);
          if s='' then
            s := 'Y';
          if UpCase(s[1]) = 'N' then
            goto NotFag
        end;
      HH.Head24 := H;
      with HH,HH.Head24 do
        begin
          StartS := ReloCS;
          StartO := ExeIP;
          ExeIP  := HFag.ExeIP;
          LS := (FileSize(fe)+15) div 16;
          ReloCS := LS-HdrSize;
          Leng24 := LS*16+LFag+SizeOf(HH)-24;
          PageCnt := (Leng24+24+511) div 512;
          PartPag := (Leng24+24) mod 512;
          if MinMem < 256 then
            MinMem := 256;
          if ExeSP < 4096 then
            ExeSP := 4096;
          CheckFile := True
        end
    end
END;  {CheckFile}
{-------------------}
FUNCTION CorrectName: Boolean;
 {Определяет имя очередного защищаемого файла и открывает его}
const
  FirstName: Boolean = True;
BEGIN
  if FirstName then
    begin
      FirstName := False;
      if pos('.',NE)=0 then
        NE := NE+'.exe';
      FSplit(NE,d,n,e);
      FindFirst(NE,$2F,S);
      if DOSError<>0 then
        NotAccess(NE)
    end
  else
    FindNext(S);
  if DOSError=0 then
    begin
      NE := d+S.Name;
      Assign(fe,NE);
      {$I-}
      Reset(fe,1);
      {$I+}
      if IOResult <> 0 then
        NotAccess(NE);
      CorrectName := CheckFile;
    end
  else
    CorrectName := False;
END;  {CorrectName}
{-------------------}
PROCEDURE SetVirFag;
  {Устанавливает защиту}
var
  p: Pointer;
  s: Word;
  n: String;
  L: LongInt;
  k: Word;
  fb: file;
  fff: file;
  LOld: LongInt;
label
  NotBack,NotFag;
BEGIN
  LOld := FIleSize(fe);   {Запоминаем старую длину файла}
  if BakFile then
    begin
      n := copy(NE,1,pos('.',NE))+'BAK';
      Assign(fb,n);
      {$I-}
      ReWrite(fb,1);
      {I+}
      if IOResult <> 0 then
NotBack:
        WriteLn('Невозможно создать резервную копию ',n)
      else
        begin
          Seek(fe,0);
          L := LOld;
          repeat
            s := 65520;
            if L < s then
              s := L;
            if MaxAvail < s then
              s := MaxAvail;
            GetMem(p,s);
            BlockRead(fe,p^,s,k);
            if not CheckRead(NE,s,k) then
              Exit;
            BlockWrite(fb,p^,s,k);
            if not CheckWrite(n,s,k) then
              goto NotBack;
            FreeMem(p,s);
            dec(L,s)
          until L=0;
          Close(fb)
        end
    end;
  Seek(fe,0);
  BlockWrite(fe,HH,SizeOf(H),k);	{Пишем новый заголовок}
  if CheckWrite(ne,SizeOf(H),k) then
    begin
      Randomize;           	        {Инициируем генератор}
      HH.Key := Random($FFFF);          {Получаем ключ}
      for k := 1 to 12 do with HH,HH.Head24 do
        W[k] := W[k] xor Key; 	        {Шифруем заголовок}
      Seek(fe,LS*16);                   {Смещаем на границу параграфа}
      {Записываем ключ}
      BlockWrite(fe,HH,SizeOf(HH),k);
      if CheckWrite(ne,SizeOf(HH),k) then
        begin
          {Записываем фаг}
          BlockWrite(fe,CFag^,LFag,k);
          if CheckWrite(ne,LFag,k) then
            WriteLn(NE,' защищен')
          else
            goto NotFag
        end
      else
NotFag:
  {Ошибка записи в концe EXE-файла. Восстанавливаем его:}
        begin
          Seek(fe,0);
          BlockWrite(fe,H,SizeOf(H));
          Seek(fe,LOld);
          Truncate(fe)
        end;
    end;
  Close(fe)
END;  {SetVirFag}
{------------------}
BEGIN
  CheckParam;  {Проверяем параметры обращения}
  OpenFag;     {Открываем файл-фаг}
  while CorrectName
   {Получаем имя очередного защищаемого файла}
  do
    SetVirFag  {Устанавливаем защиту}
END.
