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

    1: (b:array[0..512*3-1] of Byte);

  end;

begin

  GetDiskInfo(Disk,DI);

  if not Disk_Error then with DI do

    begin

      if (Item>MaxClus) or (Item<2) then

        Item:=$FFFF            {Задан ошибочный номер кластера}

      else

        begin

          if FAT16 then

            begin

              k:=Item div 256;   {Нужный сектор FAT}

              j:=Item mod 256;   {Смещение в секторе}

              n:=1               {Количество читаемых секторов}

            end

          else

            begin

              k:=Item div 1024;          {Нужная тройка секторов FAT}

              j:=(3*Item) shr 1-k*1536;  {Смещение в секторе}

              n:=3                       {Количество читаемых секторов}

            end;

          {Читаем 1 или 3 сектора FAT}

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

          if not Disk_Error then

            begin

              if FAT16 then

                Item:=Fat.w[j]

              else

                begin

                  n:=Item; {Старое значение Item для проверки  четности}

                  Item:=Fat.b[j]+Fat.b[j+1] shl 8;

                  if odd(n) then

                    Item:=Item shr 4

                  else

                    Item:=Item and $FFF;

                  if Item>$FF6 then

                    Item:=$F000+Item

                end;

              GetFatItem:=Item

            end

        end

    end

end;  {GetFATItem}

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

procedure GetIOCTLInfo(Disk:Byte;var IO:IOCTL_Type);

{Получаем информацию  об устройстве согласно общему  вызову IOCTL}

begin

  with Reg do

    begin

      ah:=$44;              {Функция 44}

      al:=$0D;              {Общий вызов IOCTL}

      cl:=$60;              {Дать параметры устройства}

      ch:=$8;               {Устройство - диск}

      bl:=Disk+1;           {Диск 1=А,...}

      bh:=0;

      ds:=seg(IO);

      dx:=ofs(IO);

      Intr($21,Reg);

      Output

    end

end; {GetIOCTLInfo}

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

procedure GetListDisk(var List:PListDisk);

{Формирует список  дисковых описателей}

var

  Disk:Byte;

  DI:TDisk;

  P,PP:PListDisk;

begin

  Disk:=2;         {Начать с диска С:}

  List:=NIL;

  repeat

    GetDiskInfo(Disk,DI);

    if not Disk_Error then

      begin

        New(P);

        if List=NIL then

          List:=P

        else

          PP^.NextDisk:=P;

        with P^ do

          begin

            DiskInfo:=DI;

            NextDisk:=NIL;

            inc(Disk);

            PP:=P

          end

      end

  until Disk_Error;

  Disk_Error:=False

end;  {GetListDisk}

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

procedure GetMasterBoot(var Buf);

{Возвращает в переменной Buf главный загрузочный сектор}

begin

  GetAbsSector($80,0,1,Buf)

end; {GetMasterBoot}

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

function GetMaxDrv:Byte;

{Возвращает количество  логических дисков}

const 

  Max:Byte=0;

begin

  if Max=0 then with Reg do

    begin

      ah:=$19;

      MSDOS(Reg);

      ah:=$0E;

      dl:=al;

      MSDOS(Reg);

      Max:=al

    end;

  GetMaxDrv:=Max

end;  {GetMaxDrv}

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

function GetSector(Disk:Byte;Cluster:Word):Word;

{Преобразуем номер  кластера в номер сектора}

var

  DI:TDisk;

begin

  GetDiskInfo(Disk,DI);

  if not Disk_Error then with DI do

    begin

      Disk_Error:=(Cluster>MaxClus) or (Cluster<2);

      if not Disk_Error then

        GetSector:=(Cluster-2)*ClusSize+DataLock

    end;

  if Disk_Error then

    GetSector:=$FFFF

end; {GetSector}

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

function PackCylSec(Cyl,Sec:Word):Word;

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

begin

  PackCylSec:=Sec+(Cyl and $300) shr 2+(Cyl shl 8)

end;  {PackCylSec}

procedure ReadWriteSector(Disk:Byte;

              Sec:LongInt;NSec:Word; var Buf; Op:Byte);

{Читает или  записывает сектор (секторы):

Ор = 0 - читать; 1 - записать (малый диск)

   = 2 - читать; 3 - записать (большой диск)}

type

  TBuf0=record

    StartSec:LongInt;

    Secs:Word;

    AdrBuf:Pointer

  end;

var

  Buf0:TBuf0;

  S:Word;

  O:Word;

begin

  if Op>1 then with Buf0 do

    begin

      {Готовим ссылочную структуру  для большого диска}

      AdrBuf:=Ptr(Seg(Buf),Ofs(Buf));

      StartSec:=Sec;

      Secs:=NSec;

      S:=Seg(Buf0);

      O:=Ofs(Buf0);

        asm

          mov CX,$FFFF

          mov AL,Op

          shr AX,1

          mov AL,Disk

          push DS

          push BP

          mov BX,O

          mov DS,S

          jc @1

          int 25H

          jmp @2

      @1: int 26H

      @2: pop DX

          pop BP

          pop DS

          mov BX,1

          jc @3

          mov Bx,0

          xor AX,AX

      @3: mov Disk_Error,BL

          mov Disk_Status,AX

        end

    end

  else                   {Обращение к диску малой емкости}

    asm

      mov DX,Word Ptr Sec       {DX:=Sec}

      mov CX,NSec               {CX:=NSec}

      push DS                   {Сохраняем DS - он будет испорчен}

      push BP                   {Сохраняем BP}

      lds BX,Buf                {DS:BX - адрес буфера}

      mov AL,Op                 {AL:=Op}

      shr AX,1                  {Переносим младший бит Oр в CF}

      mov AL,Disk               {AL:=Disk}

      jc @Write                 {Перейти, если младший бит Ор<>0}

      int 25H                   {Читаем данные}

      jmp @Go                   {Обойти запись}

    @WRITE:

      int 26H                   {Записываем данные}

    @GO:

      pop DX                    {Извлекаем флаги из стека}

      pop BP                    {Восстанавливаем BP}

      pop DS                    {Восстанавливаем DS}

      mov BX,1                  {BX:=True}

      jc @Exit                  {Перейти, если была ошибка}

      mov BX,0                  {BX:=False}

      xor AX,AX                 {Обнуляем код ошибки}

    @EXIT:

      mov Disk_Error,BL         {Флаг  ошибки взять из BX}

      mov Disk_Status,AX        {Код  ошибки взять из AX}

    end

end; {ReadWriteSector}

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

procedure ReadSector(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,2)  {-Да: операция 2}

  else

    ReadWriteSector(Disk,Sec,Nsec,Buf,0)  {-Нет: операция 0}

end;  {ReadSector}

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

procedure SetAbsSector(Disk,Head:Byte;CSec:Word;var Buf);

  {Записывает абсолютный дисковый сектор с помощью прерывания $13}

begin

  with Reg do

    begin

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

      dl:=Disk;      {Номер привода}

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

      cx:=CSec;      {Цилиндр/сектор}

      al:=1;         {Читаем  один сектор}

      es:=seg(Buf);

      bx:=ofs(Buf);

      Intr($13,Reg);

      Output

    end

end; {SetAbsSector}

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

procedure SetDefaultDrv(Disk:Byte);

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

begin

  if Disk<=GetMaxDrv then with Reg do

    begin

      AH:=$E;

      DL:=Disk;

      MSDOS(Reg)

    end

end;

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

procedure SetFATItem(Disk:Byte;Cluster,Item:Word);

{Устанавливаем  содержимое ITEM в элемент CLUSTER таблицы  FAT}

var

  DI:TDisk;

  k,j,n:Integer;

  Fat:record

    case Byte of

    0:(w: array[0..255] of Word);

    1:(b: array[0..512*3-1] of Byte);

  end;

begin

  GetDiskInfo(Disk,DI);

  if not Disk_Error then with DI do

    begin

      if (Cluster<=MaxClus) and (Cluster>=2) then

        begin

          if FAT16 then

            begin

              k:=Cluster div 256;        {Нужный сектор FAT}

              j:=Cluster mod 256;        {Смещение в секторе}

              n:=1

            end

          else

            begin

              k:=Cluster div 1024;       {Нужная тройка секторов FAT}

              j:=(3*Cluster) shr 1-k*1536;

              n:=3