49689 (Защита программы от нелегального копирования), страница 4
Описание файла
Документ из архива "Защита программы от нелегального копирования", который расположен в категории "". Всё это находится в предмете "информатика" из 1 семестр, которые можно найти в файловом архиве . Не смотря на прямую связь этого архива с , его также можно найти и в других разделах. Архив можно найти в разделе "курсовые/домашние работы", в предмете "информатика, программирование" в общих файлах.
Онлайн просмотр документа "49689"
Текст 4 страницы из документа "49689"
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) 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=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; {Код размера сектора}