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]);
{записываем на дискету новый ключ}
ifnotDiskettPrepare(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
{
+--------------------------------------------------------+
| Форматирование дорожки нестандартными секторами с помо-|
| щью прерывания $13. Эта программа готовит дискету для |
| работы с модулем F_Prot. |
+--------------------------------------------------------+}
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;