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

        Find:=True;

        i:=1;

        While Find and (i<=11) do

          begin

            Find:=m[i]=Dir[j].NameExt[i];

            inc(i)

          end;

      end;

    if not Find then inc(j);

    if j=17 then

      begin

        inc(k,16);

        if k>=DirSize then

          exit;     {Дошли до конца  каталога}

        j:=1;       {Продолжаем  с первого элемента следующего  сектора}

        if (k div 16) mod DI.ClusSize=0 then

           if succ(Dirs)<DI.DataLock then

            inc(Dirs)          {Корневой каталог}

           else

            begin              {Конец кластера}

              {Новый кластер}

              Clus:=GetFATItem(Disk,GetCluster(Disk,Dirs));

              {Новый сектор}

              Dirs:=GetSector(Disk,Clus)

            end

        else          {Очередной  сектор - в кластере}

          inc(Dirs);

        ReadSector(Disk,Dirs,1,Dir)

      end

  until Find

end;  {FindItem}

{---------}

begin {GetDirItem}

  {Готовим имя файла}

  FileName:=FExpand(FileName);

  FSplit(FileName,Path,NameF,Ext);

  {Искать каталог}

  GetDirSector(Path,Disk,Dirs,DirSize);

  Find:=Dirs<>0;          {Dirs=0 - ошибка в маршруте}

  if Find then

    FindItem;             {Ищем нужный элемент}

  if Find then

    begin

      {Переносим элемент каталога в Item}

      Move(Dir[j],Item,SizeOf(Dir_Type));

      {Сбросить ошибку}

      Disk_Error:=False

    end

  else

    begin            {Файл не найден}

      Disk_Error:=True;

      Disk_Status:=$FFFF

    end

end;   {GetDirItem}

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

Procedure GetDirSector(Path:String;var Disk:Byte;var Dirs,DirSize:Word);

{Возвращает адрес  сектора, в котором содержится  начало

нужного каталога, или 0, если каталог не найден.

Вход:

PATH - полное имя  каталога ('', если каталог - текущий).

Выход:

DISK - номер диска;

DIRS - номер первого  сектора каталога или 0;

DIRSIZE - размер каталога (в элементах DIR_TYPE).}

var

  i,j,k:Integer;                    {Вспомогательные переменные}

  Find:Boolean;                     {Признак поиска}

  m:array[1..11] of Char;           {Массив имени каталога}

  s:string;                         {Вспомогательная переменная}

  DI:TDisk;                         {Информация о диске}

  Dir:array[1..16] of Dir_Type;     {Сектор каталога}

  Clus:Word;                        {Текущий кластер каталога}

label

  err;

begin

  {Начальный  этап: готовим путь к каталогу  и диск}

  if Path='' then               {Если каталог текущий,}

    GetDir(0,Path);             {дополняем маршрутом поиска}

  if Path[2]<>':' then          {Если нет диска,}

    Disk:=GetDefaultDrv         {берем текущий}

  else

    begin                       {Иначе проверяем имя диска}

      Disk:=GetDiskNumber(Path[1]);

      if Disk=255 then

        begin                   {Недействительное имя диска}

  Err:    {Точка  входа при неудачном поиске}

          Dirs:=0;              {Нет сектора}

          Disk_Error:=True;     {Флаг ошибки}

          Disk_Status:=$FFFF;   {Статус $FFFF}

          exit

        end;

      Delete(Path,1,2) {Удаляем имя диска из пути}

    end;

  {Готовим цикл поиска}

  if Path[1]='\' then          {Удаляем символы \}

    Delete(Path,1,1);          {в начале}

  if Path[Length(Path)]='\' then

    Delete(Path,Length(Path),1); {и конце маршрута}

  GetDiskInfo(Disk,DI);

  with DI do

    begin

      Dirs:=RootLock;        {Сектор  с каталогом}

      DirSize:=RootSize      {Длина каталога}

    end;

  ReadSector(Disk,Dirs,1,Dir);    {Читаем корневой каталог}

  Clus:=GetCluster(Disk,Dirs);    {Кластер начала каталога}

  {Цикл поиска по каталогам}

  Find:=Path='';                  {Path='' - конец маршрута}

  while not Find do

    begin

      {Получаем в S первое имя до символа \}

      s:=Path;

      if pos('\',Path)<>0 then

        s[0]:=chr(pos('\',Path)-1);

      {Удаляем выделенное имя из маршрута}

      Delete(Path,1,Length(s));

      if Path[1]='\' then

        Delete(Path,1,1);     {Удаляем разделитель \}

      {Готовим массив имени}

      FillChar(m,11,' ');

      move(s[1],m,ord(s[0]));

      {Просмотр очередного каталога}

      k:=0;                          {Количество просмотренных элементов  каталога}

      j:=1;                          {Текущий элемент в Dir}

      repeat                         {Цикл поиска в каталоге}

        if Dir[j].Name[1]=#0 then    {Если имя}

          Goto Err;                  {Начинается с 0 - это конец каталога}

        if Dir[j].FAttr=Directory then

          begin

            Find:=True;

            i:=1;

            while Find and (i<=11) do

              begin                  {Проверяем тип}

                Find:=m[i]=Dir[j].NameExt[i];

                inc(i)

              end

          end;

        if not Find then inc(j);

        if j=17 then

          begin             {Исчерпан сектор каталога}

            j:=1;       {Продолжаем с 1-го элемента следующего сектора}

            inc(k,16);  {k - сколько элементов просмотрели} 

            if k>=DirSize then

              goto Err;   {Дошли до конца каталога}

            if (k div 16) mod DI.ClusSize=0 then

              begin          {Исчерпан кластер - ищем следующий}

                {Получаем новый кластер}

                Clus:=GetFATItem(Disk,Clus);

                {Можно не проверять на конец  цепочки,

                т. к. каталог еще не исчерпан}

                {Получаем новый сектор}

                Dirs:=GetSector(Disk,Clus)

              end

            else      {Очередной сектор - в текущем кластере}

              inc(Dirs);

            ReadSector(Disk,Dirs,1,Dir);

          end

      until Find;

      {Найден каталог для очередного  имени в маршруте}

      Clus:=Dir[j].FirstC;            {Кластер начала}

      Dirs:=GetSector(Disk,Clus);     {Сектор}

      ReadSector(Disk,Dirs,1,Dir);

      Find:=Path=''    {Продолжаем поиск, если не исчерпан путь}

    end {while not Find}

end; {GetDirSector}

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

procedure ReadWriteSector(Disk:Byte;

               Sec:LongInt;Nsec:Word;var Buf;Op:Byte);forward;

procedure GetDiskInfo(Disk:Byte;var DiskInfo:TDisk);

{Возвращает информацию о диске DISK}

var

  Boot:TBoot;

  IO:IOCTL_Type;

  p:PListDisk;

label

  Get;

begin

  Disk_Error:=False;

  if (Disk<2) or (Disks=NIL) then

    goto Get;   {Не искать в списке, если дискета или нет списка}

  {Ищем в списке  описателей}

  p:=Disks;

  while (p^.DiskInfo.Number<>Disk) and (p^.NextDisk<>NIL) do

    p:=p^.NextDisk;     {Если не тот номер диска}

  if p^.DiskInfo.Number=Disk then

    begin               {Найден нужный элемент - выход}

      DiskInfo:=p^.DiskInfo;

      exit

    end;

    {Формируем описатель диска с птмощью вызова IOCTL}

    Get:

    IO.BuildBPB:=True;         {Требуем построить ВРВ}

    GetIOCTLInfo(Disk,IO);     {Получаем информацию}

    if Disk_Error then

      exit;

    with DiskInfo, IO do       {Формируем описатель}

      begin

        Number:=Disk;

        TypeD:=TypeDrv;

        AttrD:=Attrib;

        Cyls:=Cylindrs;

        Media:=BPB.Media;

        SectSize:=BPB.SectSiz;

        TrackSiz:=Add.TrkSecs;

        TotSecs:=BPB.TotSecs;

        if TotSecs=0 then

          begin

            ReadWriteSector(Number,0,1,Boot,2);  {Диск большой емкости}

            TotSecs:=Boot.Add.LargSectors;        {Читаем загрузочный сектор}

          end;

        Heads:=Add.HeadCnt;

        Tracks:=(TotSecs+pred(TrackSiz)) div (TrackSiz*Heads);

        ClusSize:=BPB.ClustSiz;

        FATLock:=BPB.ResSecs;

        FATCnt:=BPB.FatCnt;

        FATSize:=BPB.FatSize;

        RootLock:=FATLock+FATCnt*FATSize;

        RootSize:=BPB.RootSiz;

        DataLock:=RootLock+(RootSize*SizeOf(Dir_Type)) div SectSize;

        MaxClus:=(TotSecs-DataLock) div ClusSize+2;

        FAT16:=(MaxClus>4086) and (TotSecs>20790)

      end

end;  {GetDiskinfo}

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

function GetDiskNumber(c:Char):Byte;

{Преобразует имя  диска A...Z в номер 0...26.

Если указано недействительное имя, возвращает 255}

var

  DrvNumber:Byte; 

begin

  if UpCase(c) in ['A'..'Z'] then

    DrvNumber:=ord(UpCase(c))-ord('A')

  else

    DrvNumber:=255;

  if DrvNumber>GetMaxDrv then

    DrvNumber:=255;

  GetDiskNumber:=DrvNumber;

end;  {GetDiskNumber}

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

function GetFATItem(Disk:Byte;Item:Word):Word;

{Возвращает содержимое  указанного элемента FAT}

var

  DI:TDisk;

  k,j,n:Integer;

  Fat:record

    case Byte of

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