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

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

procedure GetMasterBoot(var Buf);

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

function GetMaxDrv:Byte;

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

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

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

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

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

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

{Читает сектор(секторы) на указанном диске}

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

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

procedure SetDefaultDrv(Disk:Byte);

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

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

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

procedure SetMasterBoot(var Buf);

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

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

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

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

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

IMPLEMENTATION

uses DOS;

var

Reg:Registers;

procedure Output;

{Формирует значения Disk_Status и Disk_Error}

begin

with Reg do

begin

Disk_Error:=Flags and FCarry=1;

Disk_Status:=ax

end

end; {Output}

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

function ChangeDiskette(Disk:Byte):Boolean;

{Возвращает TRUE, если изменялось положение

запора на указанном приводе гибкого диска}

begin

with Reg do

begin

AH:=$16;

DL:=Disk;

Intr($13,Reg);

Output;

ChangeDiskette:=Disk_Error and (AH=6)

end

end; {ChangeDiskette}

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

procedure FreeListDisk(var List:PListDisk);

{Удаляет список дисковых описателей}

var

P:PListDisk;

begin

while List<>NIL do

begin

P:=List^.NextDisk;

Dispose(List);

List:=P

end

end; {FreeListDisk}

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

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

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

begin

with Reg do

begin

ah:=2; {Операция чтения}

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

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

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

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

es:=seg(Buf);

bx:=ofs(Buf);

Intr($13,Reg);

Output

end

end; {GetAbsSector}

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

function GetCluster(Disk:Byte;Sector:Word):Word;

{Возвращает номер кластера по заданному номеру сектора}

var

DI:TDisk;

begin

GetDiskInfo(Disk,DI);

if not Disk_Error then with DI do

if(Sector-DataLock>=0) and (TotSecs-Sector>=0) then

GetCluster:= {Нормальное обращение}

(Sector-DataLock) div ClusSize+2

else

GetCluster:=0 {Неверный номер сектора}

else GetCluster:=0 {Неверный номер диска}

end; {GetCluster}

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

function GetDefaultDrv:Byte;

{Возвращает номер диска по умолчанию}

begin

with Reg do

begin

AH:=$19;

MSDOS(Reg);

GetDefaultDrv:=AL

end

end; {GetDefaultDrv}

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

procedure GetDirItem(FileName:String;var Item:Dir_Type);

{Возвращает элемент справочника для указанного файла}

var

Dir:array[1..16] of Dir_Type; {Буфер на 1 сектор каталога}

Path:DirStr; {Маршрут поиска}

NameF:NameStr; {Имя файла}

Ext:ExtStr; {Расширение файла}

Disk:Byte; {Номер диска}

Dirs:Word; {Номер сектора}

DirSize:Word; {Размер каталога}

Find:Boolean; {Флаг поиска}

j:Integer; {Номер элемента каталога}

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

procedure FindItem;

{Ищет нужный элемент в секторах каталога}

var

k,i:Integer;

m:array[1..11] of char; {Массив имени}

Clus:word; {Номер кластера}

DI:TDisk;

begin

GetDiskInfo(Disk,DI); {Получаем длину кластера}

ReadSector(Disk,Dirs,1,Dir); {Читаем первый сектор}

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

j:=1; {Текущий элемент каталога}

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

FillChar(m,11,' ');

Move(NameF[1],m[1],Length(NameF));

if ext<>'' then

Move(Ext[2],m[9],Length(ext)-1);

Find:=False;

{Цикл поиска}

repeat

if Dir[j].Name[1]=#0 then

exit; {Обнаружен конец поиска}

if (Dir[j].FAttr and $18)=0 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

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);

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

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;

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

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

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

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 - признак ошибки).

Если ошибка обнаружена, печатает строку S и завершает работу программы}

begin

Intr($13, R);

if R.Flags and FCarry<>0 then

if R.ah<>6 then {Игнорируем ошибку от смены типа дискеты}

begin

WriteLn(S);

SetIntVec($1E, Old); {Восстанавливаем старую ТПД}

Halt

end

end; {Intr13}

Function AccessTime(DSK,TRK: Byte):Real;

{Измеряет время доступа к дорожке и возвращает его своим результатом (в секундах)}

var

E: array [1..18*512] of Byte;

t,k: LongInt;

R: registers;

begin

t:=MemL[0:$046C];

while t=MemL[0:$046C] do;

for k:=1 to 10 do with R do

begin

ah:=2;

al:=9;

ch:=TRK;

cl:=1;

dh:=0;

dl:=DSK;

es:=seg(E);

bx:=ofs(E);

Intr13(R, 'Error')

end;

AccessTime:=(MemL[0:$046C]-t-1)*0.055

end;

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

var

B: array [1..18] of F_Buf; {Буфер для форматирования}

k,N:Integer; {Счетчик цикла}

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

DBT:PDBT_Type; {Указатель на новую ТПД}

C, D: array[1..1024] of Byte; {Буфер чтения/записи}

Size: Word; {Длина сектора}

Info: TDisk;

begin {Главная программа}

{Проверяем доступ к диску и настраиваем драйвер}

GetDiskInfo(DSK, Info);

if Disk_Error then

begin

WriteLn('Ошибка доступа к диску');

Halt

end;

{Получаем длину сектора в байтах}

case SIZ of

0: Size:=128;

1: Size:=256;

2: Size:=512;

3: Size:=1024

else

WriteLn('Недопустимый код длины сектора')

end;

{Корректируем таблицу параметров дискеты. Поскольку исходная ТПД может быть

в ПЗУ, делаем ее копию в ОЗУ и изменяем нужные элементы}

Old:=ptr(MemW[0:$1E*4+2],MemW[0:$1E*4]);

New(DBT);

DBT^:=Old^; {Получаем копию ТПД в ОЗУ}

SetIntVec($1E,DBT); {Изменяем ссылку на ТПД}

with DBT^ do

begin

SizeCode:=SIZ;

LastSect:=18;

FillChar:='+'

end;

with R do

begin

{Сбрасываем дисковод}

ax:=0;

dl:=DSK;

Intr13(R,'Ошибка доступа к диску');

{Готовим буфер форматирования с обратным фактором чередования секторов}

for k:=1 to 18 do {Для каждого из 18 секторов:}

with B[k] do

begin

Track:=TRK; {указываем номер дорожки}

Head:=0; {номер головки}

Sect:=19-k; {номер сектора в обратной последовательности}

Size:=SIZ {и код размера}

end;

{Форматируем дорожку}

ah:=$05; {Код операции форматирования}

al:=18; {Создаем 18 секторов}

ch:=TRK; {на дорожке TRK}

cl:=1; {начиная с сектора 1}

dh:=0; {на поверхности 0}

dl:=DSK; {диска DSK}

es:=seg(B); {ES:BX - адрес буфера}

bx:=ofs(B);

Intr13(R,'Ошибка форматирования');

{Заполняем сектор случайными числами}

Randomize;

for k:=2 to 255 do

C[k]:=Random(256);

{Запрашиваем количество инсталяций на ЖД}

Write('Кол-во установок на ЖД: ');

ReadLn(C[200]);

C[17]:=0;

{Cчитываем контрольную сумму}

N:=0;

for k:=2 to 255 do

N:=N+C[k];

C[256]:=N mod 256;

{Шифруем сектор}

C[1]:=Random(255)+1;

for k:=2 to 256 do

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

{Записываем сектор}

ah:=$03; {Код операции записи}

al:=1; {Записать 1 сектор}

ch:=TRK; {На дорожке TRK}

cl:=1; {Начиная с сектора 1}

dh:=0; {На поверхности 0}

dl:=DSK; {Диск DSK}

es:=seg(C);{Адрес буфера С для записи}

bx:=ofs(C);

Intr13(R,'Ошибка записи');

{Читаем сектор}

ah:=$02;

al:=1;

ch:=TRK;

cl:=1;

dh:=0;

dl:=DSK;

es:=seg(D); {Адрес буфера D для чтения}

bx:=ofs(D);

Intr13(R,'Ошибка чтения')

end;

{Проверяем совпадение}

for k:=1 to Size do

if c[k]<>d[k] then

begin

WriteLn('Несовпадение данных');

SetIntVec($1E,Old);

Halt

end;

WriteLn('Создана и проверена ',TRK+1,

'-я дорожка с секторами по ',Size,' байт');

{измеряем время доступа к новой дорожке}

Write('Время доступа к скрытой дорожке: ');

WriteLn(AccessTime(DSK,TRK):6:2,' c');

{измеряем время доступа к стандартной дорожке}

DBT^.SizeCode:=2; {Указываем стандартную длину сектора в ТПД}

Write('Доступ к обычной дорожке: ');

WriteLn(AccessTime(DSK,20):6:2,' c');

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

SetIntVec($1E,Old)

end.

2 ТЕКСТ ПРОГРАММЫ TEXT.EXE

uses F_Prot,F_Disk;

procedure Alarm;Far;

begin

writeln('Нелегальная копия')

end;

procedure Norma;Far;

begin

writeln('Легальная копия')

end;

function ParStr:String;

var

S:string;

k:Byte;

begin

S:=ParamStr(1);

for k:=1 to Length(S) do S[k]:=UpCase(S[k]);

ParStr:=S

end;

var

p1,p2:Pointer;

d:Integer;

dsk:Byte;

begin

p1:=@Norma;

p2:=@Alarm;

if ParStr='/SET' then

Writeln('Установка на ЖД: ',SetOnHD)

else

if ParStr='/REMOVE' then

writeln('Удаление с ЖД: ',RemoveFromHD)

else

begin

ProtCheck(p1,p2,d);

Writeln('Результат проверки ',d);

readln

end

end.

Страницы: 1, 2