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

            end;

          ReadSector(Disk,FatLock+k*n,n,Fat);

          if not Disk_Error then

            begin

              if FAT16 then

                Fat.w[j]:=Item

              else

                begin

                  if odd(Cluster) then

                    Item:=Item shl 4+Fat.b[j] and $F

                  else

                    Item:=Item+(Fat.b[j+1] and $F0) shl 12;

                  Fat.b[j]:=Lo(Item);

                  Fat.b[j+1]:=Hi(Item)

                end;

              if not FAT16 then

                begin                {Проверяем "хвост" FAT}

                  k:=k*n;            {к - смещение сектора}

                  while k+n>FatSize do dec(n)

                end;

              inc(FATLock,k);        {FATLock - номер сектора в FAT}

              {Записываем изменение в FatCnt копий FAT}

              for k:=0 to pred(FatCnt) do

                WriteSector(Disk,FATLock+k*FatSize,n,Fat)

            end

        end

    end

end; {SetFATItem}

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

procedure SetMasterBoot(var Buf);

{Записываем в главный загрузочный сектор содержимое Buf}

begin

  with Reg do

    begin

      ah:=3;             {Операция записи}

      al:=1;             {Кол-во секторов}

      dl:=$80;           {1-й жесткий диск}

      dh:=0;             {Головка 0} 

      cx:=1;             {1-й сектор 0-й дорожки}

      es:=seg(Buf);

      bx:=ofs(Buf);

      Intr($13,Reg);

      Disk_Error:=(Flags and FCarry<>0);

      if Disk_Error then

        Disk_Status:=ah

      else

        Disk_Status:=0

    end

end; {SetMasterBoot}

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

procedure UnpackCylSec(CSec:Word;var Cyl,Sec:Word);

{Декодируем цилиндр  и сектор для прерывания $13}

begin

  Cyl:=(CSec and 192) shl 2+CSec shr 8;

  Sec:=CSec and 63

end;  {RecodeCylSec}

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

procedure WriteSector(Disk:Byte;Sec:LongInt;NSec:Word;var Buf);

{Записывает сектор (секторы) на указанный диск}

var

  DI:TDisk;

begin

  GetDiskInfo(Disk,DI);

  if DI.TotSecs>$FFFF then

    ReadWriteSector(Disk,Sec,Nsec,Buf,3)

  else

    ReadWriteSector(Disk,Sec,Nsec,Buf,1);

end; {ReadSector}

{=============} end. {Unit F_Disk} {==============} 
 
 
 

2 ТЕКСТ МОДУЛЯ F_PROT 

{==================} Unit F_Prot; {=======================}

{

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

|  Модуль используется  для защиты программ от  |

|  нелегального  копирования. Мобильный вариант |

|  программы  защищается с помощью ключевой  ди- |

|  скеты, стационарный  вариант - за счет кон-  |

|  троля даты создания ПЗУ.                    |

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

                     INTERFACE

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

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

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

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

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

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

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

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

function SetOnHD: Integer;

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

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

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

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

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

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

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

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

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

function RemoveFromHD: Integer;

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

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

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

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

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

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

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

                             IMPLEMENTATION

Uses DOS, F_Disk;

type

  TDate=array[1..4] of Word;

  TKey=record case Byte of

  0:(

    Hard: Word;         {Ключ для шифровки данных}

    Dat: TDate);        {Дата создания ПЗУ}

  1:(KeyW: array[1..5] of Word);

  end;

const

  TRK=80;                      {Номер дорожки}

  HED=0;                       {Номер головки}

  SEC=1;                       {Номер сектора}

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

  ETracks=80;                  {Эталонное количество дорожек  на дискете}

  ETrackSiz=18;                {Эталонное количество секторов  на дорожке}

  Key:TKey=(KeyW:(0,0,0,0,0)); {Ключ стационарной программы}

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

type

  TBuf=array[1..256] of Byte;

var

  P:Pointer;    {Ссылка на прежнюю ТПД}

  Bif:TBuf;     {Буфер чтения/записи сектора}

  R:registers;  {Регистры}

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

function DiskettPrepare(var DSK: Byte):Boolean;

type

  DBT_Type=record                 {Структура таблицы параметров  дискеты}

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

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

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

    Reserv2:array[5..10] of Byte

  end;

var

  Info: TDisk;

  DBT,OldDBT:^DBT_Type;

begin

{проверяем наличие  дискеты}

  DSK:=0;            {начинаем с диска А:}

  repeat

    GetDiskInfo(DSK,Info);

    if Disk_Error then

      if DSK=0 then

        DSK:=1        {Повторяем для диска В:}

      else

        DSK:=2        {Закончить  с ошибкой}

  until not Disk_Error or (DSK=2);

  if Disk_Error then

    begin             {Нет доступа ни к А:, ни к  В:}

      DiskettPrepare:=False;

      Exit

    end;

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

  with Info do

   begin

     if(Tracks<>ETracks) or

       (TrackSiz<>ETrackSiz) then

      begin   {Не эталонный тип}

        DiskettPrepare:=False;

        DSK:=3;

        Exit

      end;

  {Переустанавливаем ТПД}

      GetIntVec($1E,P);

      OldDBT:=P;

      New(DBT);

      DBT^:=OldDBT^;

      with DBT^ do

       begin

         SizeCode:=SIZ;

         LastSect:=ETrackSiz

       end;

      SetIntVec($1E,DBT)

   end;

  DiskettPrepare:=True

end; {DiskettPrepare}

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

function LegalDiskett(var DSK:Byte):Boolean;

{Проверяет легальность  мобильной копии}

var

  k,n:Word;

begin

{Подготавливаем дискету}

  if DiskettPrepare(DSK) then

    begin

    {читаем ключевой сектор}

    for k:=1 to 256 do

      bif[k]:=0;

    With R do

      begin

        ah:=0;

        dl:=DSK;

        Intr($13,R);

        ah:=2;

        al:=1;

        ch:=TRK;

        cl:=SEC;

        dh:=HED;

        dl:=DSK;

        es:=seg(Bif);

        bx:=ofs(Bif);

        Intr($13,R);

        ah:=0;

        dl:=DSK;

        Intr($13,R);

        SetIntVec($1E,P);

        if (Flags and FCarry)<>0 then

          begin

            LegalDiskett:=False;

            DSK:=4;

            Exit

          end

        else

         begin        {проверяем  содержимое сектора}

           for k:=2 to 256 do

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

           N:=0;

           {$R-}

           for k:=2 to 255 do

             N:=N+Bif[k];

           if (N mod 256=Bif[256]) then

             begin

               if N=0 then

                 begin

                   DSK:=4;

                   LegalDiskett:=False;

                   Exit

                 end;

               DSK:=0;

               LegalDiskett:=True

             end

           else

             begin

               DSK:=4;

               LegalDiskett:=False

             end

           end

         end

      end

      else

        LegalDiskett:=False

end; {LegalDiskett}

function LegalHD(var DSK: Byte): Boolean;

  {проверяет легальность стационарной копии}

var

  k:Word;

  Date:^TDate;

  Legal:Boolean;

label

  ExitL;

begin

  {Расшифровываем ключ}

  with Key do for k:=2 to 5 do

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

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

  k:=1;

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

  repeat

    Legal:=Date^[k]=Key.Dat[k];

    inc(k)

  until not Legal or (k=5);

  LegalHD:=Legal;

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

  if Legal then

    DSK:=0

  else

    Legal:=LegalDiskett(DSK); 

  LegalHD:=Legal

end;