Защита программы от нелегального копирования

{----------------}

procedure ProtCheck(var P1,P2;var Res:Integer);

{Проверяет легальность  копии:

Р1 - адрес процедуры NORMA; Р2 - адрес процедуры ALARM;

Res - результат работы:

0: был вызов  NORMA;

1: был вызов  ALARM;

2: не вставлена  дискета.

Любое другое значение может быть только при трассировке  программы}

type

  PType = Procedure;

var

  Norma: PType absolute P1;

  Alarm: PType absolute P2;

  DSK: Byte;

label

  L1,L2;

begin

  Res:=-1;

  if Key.Hard=0 then

    if LegalDiskett(DSK) then

      begin

L1:

        Norma;

        Res:=0

      end

    else

     begin

L2:

       if DSK=2 then

         Res:=2

       else

        begin

          Alarm;

          Res:=1

        end

     end

   else

     if LegalHD(DSK) then

       goto L1

     else

       goto L2

end; {ProtCheck}

{---------------}

Procedure HidnSec(var Buf:TBuf;Inst,Limit:Byte);

{Шифрует буфер  ключевого сектора}

var

  k,n:Word;

begin

  Randomize;

  for k:=2 to 254 do

    Buf[k]:=Random(256);

  Buf[1]:=Random(255)+1;    {Ключ для шифровки}

  {$R-}

  Buf[17]:=Inst;            {Счетчик установок}

  Buf[200]:=Limit;          {Лимит установок}

  n:=0;                     {Подсчет КС}

  for k:=2 to 255 do

    n:=n+Buf[k];

  Buf[256]:=n mod 256;      {Контрольная сумма}

  {Шифруем все данные}

  for k:=2 to 256 do

    Buf[k]:=Buf[k] xor Buf[1];

  {$R+}

end;  {HidnSec}

{-----------------}

Function SetOnHD: Integer;

{Устанавливает  стационарную копию на жесткий  диск. Возвращает:

-1 - не вставлена  дискета;

-2 - не мастер-дискета;

-3 - защита от  записи или ошибка записи ГД;

-4 - программа не  скопирована на ЖД;

-5 - ошибка доступа  к ЖД;

-6 - исчерпан лимит  установок;

-7 - программа уже установлена.

>=0 - количество  оставшихся установок}

var

  DSK:Byte;                 {Диск}

  F:file;                   {Файл с программой}

  Date:^TDate;              {Дата ПЗУ}

  NameF:String;             {Имя файла с программой}

  W:array[1..5] of Word;    {Заголовок файла}

  n:Word;                   {Счетчик}

  L:LongInt;                {Файловое смещение}

  Inst:Byte;                {Количество установок}

label

  ErrWrt;

begin

  if Key.Hard<>0 then

    begin

      SetOnHD:=-7;

      Exit

    end;

  {проверяем  резидентность программы}

  NameF:=FExpand(ParamStr(0));

  if NameF[1] in ['A','B'] then

    begin

      SetOnHD:=-4;

      Exit

    end;

  {проверяем дискету}

  if not LegalDiskett(DSK) then

    begin

      case DSK of

      2: SetOnHD:=-1;

      else 

        SetOnHD:=-2;

      end;

      Exit

    end;

  if (Bif[200]<>255) and (Bif[17]>=Bif[200]) then

    begin                {Исчерпан лимит установок}

      SetOnHD:=-6;

      Exit

    end;

    {Запоминаем  дату изготовления ПЗУ}

  Date:=ptr($F000,$FFF5);

  Key.Dat:=Date^;

  {Шифруем параметры}

  Randomize;

  with Key do

    while Hard=0 do Hard:=Random($FFFF);

  for n:=2 to 5 do with Key do

    KeyW[n]:=KeyW[n] xor Hard;

  {Открываем файл с программой}

  Assign(F,NameF);

  Reset(F,1);

  {Читаем заголовок  файла}

  BlockRead(F,W,SizeOf(W),n);

  if n<>SizeOf(W) then

    begin

      SetOnHD:=-5;

      Exit

    end;

  {Ищем в файле положение Hard}

  R.ah:=$62;

  MSDOS(R);

  P:=@Key;

  L:=round((DSeg-R.bx-16+W[5])*16.0)+ofs(P^);

  Seek(F,L);

  {Записываем  в файл}

  BlockWrite(F,Key,SizeOf(Key),n);

  if n<>SizeOf(Key) then

    begin

      SetOnHD:=-5;

      Close(F);

      Exit

    end;

  {Шифруем ключевой сектор}

  Inst:=Bif[200]-Bif[17]-1;

  HidnSec(Bif,Bif[17]+1,Bif[200]);

  {записываем  на дискету новый ключ}

  if not DiskettPrepare(DSK) then

    begin           {Ошибка доступа к дискете: удаляем установку}

  ErrWrt:

      FillChar(Key,SizeOf(Key),0);

      Seek(F,L);

      BlockWrite(F,Key,SizeOf(Key),n);

      SetOnHD:=-3;

      Close(F);

      Exit

    end;

  with R do

    begin

      ah:=0;

      dl:=DSK;

      Intr($13,R);

      ah:=3;

      al:=1;

      ch:=TRK;

      cl:=SEC;

      dh:=HED;

      dl:=DSK;

      es:=seg(Bif);

      bx:=ofs(Bif);

      Intr($13,R);

      if(Flags and FCarry)<>0 then

        goto ErrWrt

    end;

  {Нормальное  завершение}

    SetOnHD:=Inst;

    SetIntVec($1E,P);

    Close(F)

end; {SetOnHD}

{----------------}

function RemoveFromHD: Integer;

{Удаляет стационарную  копию. Возвращает:

-1 - не вставлена  дискета;

-2 - не мастер-дискета;

-3 - защита от  записи или ошибка записи ГД;

-4 - программа не  скопирована на ЖД;

-5 - ошибка доступа  к ЖД;

>=0 - количество  оставшихся установок}

var

  k,n:Integer;

  NameF:String;

  B:array[1..512] of Byte;

  F:file;

  DSK,Inst:Byte;

begin

  if Key.Hard=0 then

    begin

      RemoveFromHD:=-4;

      Exit

    end;

  if not LegalDiskett(DSK) then

    begin

      if DSK=2 then

        RemoveFromHD:=-1

      else

        RemoveFromHD:=-2;

      Exit

    end;

  {Стираем файл с программой на ЖД}

  NameF:=FExpand(ParamStr(0));

  if NameF[1] in ['A'..'B'] then

    begin

      RemoveFromHD:=-4;

      Exit

    end;

  Assign(F,NameF);

  {$I-}

  Reset(F,1);

  {$I+}

  if IOResult<>0 then

    begin

      RemoveFromHD:=-5;

      Exit

    end;

  {Уничтожаем заголовок файла}

  FillChar(B,512,0);

  BlockWrite(F,B,512,n);

  if n<>512 then

    begin

      RemoveFromHD:=-5;

      Exit

    end;

  Close(F);

  Erase(F);             {Стереть файл}

  {Шифруем ключевой сектор}

  Inst:=Bif[200]-Bif[17]+1;

  HidnSec(Bif,Bif[17]-1,Bif[200]);

  {Записываем  на дискету новый ключ}

  if not DiskettPrepare(DSK) then

    begin

      RemoveFromHD:=-1;

      Exit

    end;

  with R do

    begin

      ah:=0;

      dl:=DSK;

      Intr($13,R);

      ah:=3;

      al:=1;

      ch:=TRK;

      cl:=SEC;

      dh:=HED;

      dl:=DSK;

      es:=seg(Bif);

      bx:=ofs(Bif);

      Intr($13,R);

      if (Flags and FCarry)<>0 then

        RemoveFromHD:=-3

      else

        RemoveFromHD:=Inst

    end;

end; {RemoveFormHD}

{==================} end. {F_Prot} {=======================} 
 

3   ТЕКСТ ПРОГРАММЫ DISKETT 

{

+--------------------------------------------------------+

| Форматирование  дорожки нестандартными секторами с помо-|

| щью прерывания $13. Эта программа готовит дискету  для  |

| работы с модулем  F_Prot.                               |

+--------------------------------------------------------+}

Program Diskett;

Uses DOS, F_disk;

const

  TRK=80;   {Номер  нестандартной дорожки}

  DSK=0;    {Номер диска}

  SIZ=1;    {Код размера сектора}

type

  PDBT_Type=^DBT_Type; {Указатель  на ТПД}

  {Таблица параметров  дискеты}

  DBT_Type=record

   Reserv1 : array [0..2] of Byte;

   SizeCode: Byte;      {Код размера сектора}

   LastSect: Byte;      {Количество секторов на дорожке}

   Reserv2 : array [5..7] of Byte;

   FillChar: Char;      {Символ-заполнитель форматирования}

   Reserv3 : Word

  end;

  {Элемент буфера  форматирования}

  F_Buf=record

    Track:Byte;  {Номер дорожки}

    Head:Byte;   {Номер головки}

    Sect:Byte;   {Номер сектора}

    Size:Byte    {Код размера}

  end;

var

  Old: PDBT_Type;   {Указатель на исходную ТПД}

{-------------------}

Procedure Intr13(var R: registers; S: String);

{Обращается к  прерыванию 13 и анализирует ошибку (CF=1 - признак ошибки).