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

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} {=======================}