Описание применения программы
Программа предназначена для защиты данных от несанкционированного доступа; в ней реализованы следующие функции: шифрование файлов; защита паролем исполняемых файлов; защита исполняемых файлов с помощью ключевой дискеты; отслеживание и реакция на ошибки; изменение паролей; привязка к BIOS. Установка системы происходит с ключевой дискеты программой INSTALL.EXE, которая проверяет не была ли установлена система ранее; если нет, то создает на винчестере каталог C:\SUB ROSA и копирует в него файлы системы (Sub Rosa.exe, Block, KeyDisk, Plus, Passw, Setup.res, System.res). При запуске программы Sub Rosa.exe сначала проверяется наличие всех файлов системы. Если хотя бы один файл изменен или удален, то система работать не будет. Для работы с программой необходимо ввести пароль. В верхней части экрана находится полоска меню, состоящая из следующих пунктов: “Файлы”: — “Выбрать” (выбор файла для работы); — “Сменить каталог” (смена текущего каталога); — “Выход в DOS” (временный выход в DOS); — “Завершение” (завершение работы с программой); “Защита”: — “Установить пароль” (защита EXE- и COM-файлов паролем); — “Блокировать винчестер” (запрет записи любых данных на винчестер); “Ключевая дискета”: — “Добавить проверку по ключу” (защита EXE- и COM-файлов с помощью ключевой дискеты); “Криптография”: — “Зашифровать файл данных” (зашифрование выбранного файла); — “Расшифровать файл данных” (расшифрование выбранного файла); “Настройки”: — “Криптография” (изменение настроек криптографии); — “Пароли” (изменение пароля входа в систему); “О Программе” (информация о программе). Во всех случаях , кроме блокировки винчестера, сначала необходимо выбрать файл для работы. Для установки защиты паролем или по ключевой дискете выбирается EXE- или COM-файл, для шифрования — файл любого типа. Заключение В заключении проведем анализ некоторых систем защиты от копирования. Следует отметить, что этот анализ не является исчерпывающим, так как эти системы постоянно развиваются, а также не всегда можно получить исчерпывающее описание алгоритмов — разработчики не стремятся раскрывать принципы их построения. RANK — пакет защиты от НСД. Этот пакет реализует функцию контроля доступа к EXE- и COM-файлам. Следует отметить, что анализ разграничения доступа к программам ставит под серьезное сомнение возможность реализации такой функции без дополнительных мероприятий. LATCH — комплекс программ защиты ПЭВМ от НСД. Этот комплекс обеспечивает безопасность данных , хранящихся на винчестере. При несанкционированном доступе происходит “зависание” ПЭВМ или не обнаруживается НЖМД. Тезис о невозможности обнаружения НЖМД вызывает серьезные сомнения: например, для контроллеров SCSI не требуется определение типа НЖМД в памяти CMOS, так как параметры винчестера могут быть считаны с помощью команды контроллера. Приложение 1 Листинг программы Program Sub_Rosa; Uses App, Dialogs, Drivers, Menus, MsgBox, Objects, Validate, Views, Memory, StdDlg, Editors, {Модули Turbo Vision, далее - TV} CRT, DOS, {Стандартные модули} SetConf; {Модуль функции привязки к BIOS} Var MyRes : TResourceFile; {Переменная файла ресурсов, TV} FName, MainDir, DName: string; {Переменные работы с файлами и каталогами} MainPass, Pass : string; {Переменные паролей} Pos : string[3]; FilePass : file of char; {Переменная файла паролей} OptFile, OptInd : word; {Переменные опций} Int09_Save : pointer; {Переменная адреса 09h прерывания} Const {Константы кодов команд, TV} cmAboutBox = 700; {Окно "О Программе"} cmCode = 1001; {Кодировать файл} cmDeCode = 1002; {Декодировать файл} cmSetPass = 1005; {Установить пароль на вход в систему} cmLockDisk = 1006; {Запретить доступ к винчестеру} cmOptions = 1007; {Опции криптографии} cmKeyDisk = 1008; {Ключевая дискета} cmPasswords = 1009; {Пароль на исполняемый файл} cmChangePass= 1010; {Сменить пароль на вход в систему} SetPass = 'passw.com'; KeyDisk = 'keydisk.com'; RMenuBar: TStreamRec = ( {Запись для работы с потоком, TV} ObjType: 2000; VmtLink: Ofs(TypeOf(TMenuBar)^); Load: @TMenuBar.Load; Store: @TMenuBar.Store); Type {Установка опций криптографии} POptions = ^TOptions; TOptions = object(TDialog) constructor Init; end; {Объект для работы с текстом} PMyStaticText = ^TMyStaticText; TMyStaticText = object(TStaticText) function GetPalette: PPalette; virtual; {Переопределение палитры} end; {Объекты для работы с файлами и каталогами} PMyFDialog = ^TMyFDialog; TMyFDialog = object(TFileDialog) function GetPalette: PPalette; virtual; end; PMyFileDialog = ^TMyFileDialog; TMyFileDialog = object(TMyFDialog) constructor Init(AWildCard: tWildStr; const ATitle, InputName: string; AOptions: Word; HistoryId: Byte); end; PDirDialog = ^TDirDialog; TDirDialog = object(TChDirDialog) function GetPalette: PPalette; virtual; end; PMyChDirDialog = ^TMyChDirDialog; TMyChDirDialog = object(TDirDialog) constructor Init(AOptions: Word; HistoryId: Word); procedure SetUpDialog; function Valid(Command: Word): Boolean; virtual; end;
{Установка основного фона программы} PMyBackground = ^TMyBackground; TMyBackground = object(TBackground) Text: TTitleStr; constructor Init(var Bounds: TRect; AText: TTitleStr); procedure Draw; virtual; end; PMyDesktop = ^TMyDesktop; TMyDesktop = object(TDesktop) procedure InitBackground; virtual; end; {Объект "О Программе"} PAboutBox = ^TAboutBox; TAboutBox = object(TDialog) constructor Init; end; {Основной объект} PMyApp = ^TMyApp; TMyApp = object(TApplication) constructor Init; {инициализация} destructor Done; virtual; {завершение работы} procedure HandleEvent(var Event: TEvent); virtual; {обработка событий} procedure InitMenuBar; virtual; {инициализация меню} procedure InitDeskTop; virtual; {инициализация рабочего поля} procedure InitStatusLine; virtual; {инициализация строки состояния} procedure FileOpen(WildCard: PathStr); {окно для работы с файлами} function GetPalette: PPalette; virtual; {изменение стандартной палитры} end;
{ Русифицированная функция формирования сообщения } function MyMessageBoxRect(var R: TRect; const Msg: string; Params: pointer; AOptions: word): word; const ButtonName: array[0..3] of string[6] = ('Ага', 'Нека', 'Ага', 'Нека'); Commands: array[0..3] of Word = (cmYes, cmNo, cmOK, cmCancel); Titles: array[0..3] of string[11] = ('Предупреждение', 'Ошибка', 'Информация', 'Подтверждение'); var I, X : integer; Dialog : PDialog; Control: PView; S : string; begin Dialog:= New(PDialog, Init(R, Titles[AOptions and $3])); with Dialog^ do begin Options:= Options or ofCentered; R.Assign(3, 2, Size.X - 2, Size.Y - 3); FormatStr(S, Msg, Params^); Insert(New(PStaticText, Init(R, S))); X:= -2; R.Assign(0, 0, 10, 2); for I:= 0 to 3 do if AOptions and ($0100 shl I) <> 0 then Inc(X, R.B.X - R.A.X + 2); X:= (Size.X - X) shr 1; for I:= 0 to 3 do if AOptions and ($0100 shl I) <> 0 then begin Control:= New(PButton, Init( R, ButtonName[I], Commands[i], bfNormal)); Insert(Control); Control^.MoveTo(X, Size.Y - 3); Inc(X, Control^.Size.X + 2); end; SelectNext(False); end; if AOptions and mfInsertInApp = 0 then MyMessageBoxRect:= DeskTop^.ExecView(Dialog) else MyMessageBoxRect:= Application^.ExecView(Dialog); Dispose(Dialog, Done); end; { Русифицированная функция формирования сообщения стандартного размера } function MyMessageBox(const Msg: String; Params: Pointer; AOptions: Word): Word; var R: TRect; begin R.Assign(0, 0, 40, 9); MyMessageBox:= MyMessageBoxRect(R, Msg, Params, AOptions); end; function GetCurDir: DirStr; var CurDir: DirStr; begin GetDir(0, CurDir); if Length(CurDir) > 3 then begin Inc(CurDir[0]); CurDir[Length(CurDir)]:= '\'; end; GetCurDir:= CurDir; end; {Процедура инициализации окна работы с файлами} procedure TMyApp.FileOpen(WildCard: PathStr); var FileName: FNameStr; begin FileName:= '*.*'; if ExecuteDialog(New(PMyFileDialog, Init( WildCard, 'Открыть файл', 'Имя', fdOpenButton, 100)), @FileName) <> cmCancel then FName:=FileName; {открыть файл, потом...} end; {****************************************************************************} {*----------============= К Р И П Т О Г Р А Ф И Я ================----------*} {****************************************************************************} {Шифрование файлов} procedure Shifr(InputFileName: string); const A = 5; {Константы для} C = 27; {генератора} M = 65536; {псевдослучайных чисел, далее - ПСЧ} var TempFile : file of byte; InpF, OutF : file of word; {файлы на входе и выходе} Password, Password1 : string; {переменные для работы с паролями} OutputFileName, Exten : string; {переменные имен файлов} I, J, K, tmp : byte; {переменные кодирования} Temp, SCode, TByte, Code: word; Position : LongInt; {переменные данных о процессе} NowPos : real; TPassword : array [1..255] of word; MasByte, Mas, MasEnd, PS: array [1..64] of word; {массивы перестановок} T : array [0..64] of word; DirInfo, DirInfo1 : SearchRec; {данные о файле} begin if length(FName) > 3 then {Файл выбран?} begin {Получить пароль} Password := ''; Password1 := ''; InputBox('П А Р О Л Ь', ' Введите пароль:', Password, 255); InputBox('П А Р О Л Ь', 'Введите пароль еще раз:', Password1, 255); if (Password = Password1) and (length(Password)<>0) then begin {Преобразовать файл} FindFirst(InputFileName, AnyFile, DirInfo); if DOSError = 0 then begin if DirInfo.Size mod 2 = 1 then begin assign(TempFile, InputFileName); reset(TempFile); while not EOF(TempFile) do read(TempFile, tmp); tmp := 255; write(TempFile, tmp); close(TempFile); end; {Преобразовать имя файла} Position := 0; assign(InpF, InputFileName); reset(InpF); for i := length(InputFileName) downto 1 do if InputFileName[i] = '.' then begin OutputFileName := copy(InputFileName, 1, i) + 'M&A'; break; end; assign(OutF, OutputFileName); rewrite(OutF); for i:= 0 to length(InputFileName) do if InputFileName[length(InputFileName) - i] = '.' then case i of 0: Exten := chr(0) + chr(0) + chr(0); 1: Exten := copy(FName, length(FName)-2, i) + chr(0) + chr(0); 2: Exten := copy(FName, length(FName)-2, i) + chr(0) else Exten := copy(FName, length(FName)-2, 3) end; for i := 1 to 3 do begin Temp := ord(Exten[i]); Write(OutF, Temp); end; {Начать шифрование} k := 1; repeat begin {Считать из исходного файла блок размером 64*word} for i:=1 to 64 do If EOF(InpF) then MasByte[i] := 0 else Read(InpF, MasByte[i]); Mas := MasByte; T[0] := ord(Password[k]); if k < length(Password) then inc(k) else k := 1; for i:= 1 to 64 do begin {Получить текущую позицию процесса} NowPos := 100*Position/DirInfo.Size; inc(Position, 2); if NowPos > 100 then NowPos := 100; Str(Round(NowPos):3, Pos); if OptInd = 0 then begin GoToXY(77, 1); Write(Pos + '%'); end; {Шифровать с помощью ПСЧ} Code:=Mas[i]; T[i] := (A * T[i-1] + C) mod M; Code:=T[i] xor Code; Mas[i] := Code; end; for i:=1 to 8 do { Конечная перестановка } for j:=1 to 8 do case i of 1: MasEnd[8*(j-1)+i] := Mas[41-j]; 2: MasEnd[8*(j-1)+i] := Mas[09-j]; 3: MasEnd[8*(j-1)+i] := Mas[49-j]; 4: MasEnd[8*(j-1)+i] := Mas[17-j]; 5: MasEnd[8*(j-1)+i] := Mas[57-j]; 6: MasEnd[8*(j-1)+i] := Mas[25-j]; 7: MasEnd[8*(j-1)+i] := Mas[65-j]; 8: MasEnd[8*(j-1)+i] := Mas[33-j] end; for i:= 1 to 64 do Write(OutF, MasEnd[i]); end; until eof(InpF); MyMessageBox('Файл '+ InputFileName + ' зашифрован с именем ' + OutputFileName, nil, mfInformation+mfOkButton); Close(InpF); if OptFile = 1 then Erase(InpF); Close(OutF); end else MyMessageBox('Файл '+ InputFileName + ' не существует!', nil, mfInformation+mfOkButton); end else MyMessageBox(' Ошибка ввода пароля!!!', nil, mfError+mfOkButton); end else MyMessageBox(' Файл не выбран!!!', nil, mfError+mfOkButton); end;
procedure DeShifr(InputFileName: String); const A = 5; C = 27; M = 65536; var InpF, OutF : file of word; Password, OutputFileName : string; Password1 : string; Exten : string[3]; SCode, Temp, Ext, TByte, Code: word; I, J, K : byte; Position : LongInt; NowPos : real; TPassword : array [1..255] of word; MasByte, Mas, MasEnd, PS : array [1..64] of word; T : array [0..64] of word; DirInfo : SearchRec; begin if (length(InputFileName) > 3) and (copy(InputFileName, length(InputFileName)-2, 3) = 'M&A') then begin Password := ''; Password1 := ''; InputBox('П А Р О Л Ь', ' Введите пароль:', Password, 255); InputBox('П А Р О Л Ь', 'Введите пароль еще раз:', Password1, 255); if (Password = Password1) and (length(Password)<>0) then begin FindFirst(InputFileName, AnyFile, DirInfo); if DOSError = 0 then begin Assign(InpF, InputFileName); Reset(InpF); Position := 0; Exten := ''; for i:= 1 to 3 do begin Read(InpF, Temp); Exten := Exten + chr(Temp); end; for i := length(InputFileName) downto 1 do if InputFileName[i] = '.' then begin OutputFileName := copy(InputFileName, 1, i) + Exten; break; end; Assign(OutF, OutputFileName); Rewrite(OutF); for i := 1 to length(Password) do TPassword[i]:=ord(Password[i]); k := 1; repeat begin for i:=1 to 64 do Read(InpF, MasByte[i]); for i:=1 to 8 do { начальная перестановка } for j:=1 to 8 do case i of 1: Mas[8*(i-1)+j]:=MasByte[66-8*j]; 2: Mas[8*(i-1)+j]:=MasByte[68-8*j]; 3: Mas[8*(i-1)+j]:=MasByte[70-8*j]; 4: Mas[8*(i-1)+j]:=MasByte[72-8*j]; 5: Mas[8*(i-1)+j]:=MasByte[65-8*j]; 6: Mas[8*(i-1)+j]:=MasByte[67-8*j]; 7: Mas[8*(i-1)+j]:=MasByte[69-8*j]; 8: Mas[8*(i-1)+j]:=MasByte[71-8*j] end; T[0] := ord(Password[k]); if k < length(Password) then inc(k) else k := 1; for i:= 1 to 64 do begin NowPos := 100*Position/DirInfo.Size; inc(Position, 2); If NowPos > 100 then NowPos := 100; Str(Round(NowPos):3, Pos); if OptInd = 0 then begin GoToXY(77, 1); Write(Pos + '%'); end; T[i] := (A * T[i-1] + C) mod M; Code:=Mas[i]; Code:=T[i] xor Code; Mas[i] := Code; end; MasEnd := Mas; for i := 1 to 64 do Write(OutF, MasEnd[i]); end; until eof(InpF); GotoXY(77, 1); write('100%'); MyMessageBox('Файл '+ InputFileName + ' расшифрован в ' + OutputFileName, nil, mfInformation+mfOkButton); Close(InpF); if OptFile = 1 then Erase(InpF); Close(OutF); end else MyMessageBox('Файл '+ InputFileName + ' не существует!', nil, mfInformation+mfOkButton); end else MyMessageBox(' Ошибка ввода пароля!!!', nil, mfError+mfOkButton); end else MyMessageBox(' Файл не выбран!!!', nil, mfError+mfOkButton); end;
{Опции криптографии} constructor TOptions.Init; var R : TRect; Q, Q1: PView; Butt : TRadioButtons; begin R.Assign(0, 0, 60, 11); inherited Init(R, 'Криптография'); Options := Options or ofCentered; R.Assign(10, 8, 20, 10); Insert(New(PButton, Init(R, '~А~га', cmOK, bfDefault)));
R.Assign(40, 8, 50, 10); Insert(New(PButton, Init(R, '~Н~ека', cmCancel, bfNormal))); R.Assign(2, 2, 25, 3); Insert(New(PLabel, Init(R, 'Исходный файл:', Q))); R.Assign(5, 4, 21, 6); Q:=New(PRadioButtons, Init(R, NewSItem('~Н~е удалять', NewSItem('~У~далять', nil)))); Insert(Q); R.Assign(27, 2, 45, 3); Insert(New(PLabel, Init(R, 'Индикатор:', Q1))); R.Assign(30, 4, 50, 6); Q1:=New(PRadioButtons, Init(R, NewSItem('~В~ысвечивать', NewSItem('~Н~е высвечивать', nil)))); Insert(Q1); end; {Изменение пароля на вход в систему} procedure Passwords; var Ps, Ps1: string; I : byte; tmp : char; begin Ps := ''; Ps1 := ''; InputBox('П А Р О Л Ь', 'Введите пароль:', Ps, 255); for i:= 1 to length(Ps) do Ps[i] :=chr(ord(Ps[i]) xor 27); if Ps <> Pass then begin MyMessageBox(' Неверный пароль!!!', nil, mfError+mfOkButton); ClrScr; writeln('Несанкционированный доступ!'); Halt; end; InputBox('И З М Е Н Е Н И Е П А Р О Л Я', 'Введите новый пароль:', Ps, 255); InputBox('И З М Е Н Е Н И Е П А Р О Л Я', ' Повторите ввод:', Ps1, 255); if (Ps = Ps1) and (Ps <> '') then begin Assign(FilePass, 'system.res'); Rewrite(FilePass); for i := 1 to length(PS) do begin tmp := chr(ord(Ps[i]) xor 27); Write(FilePass, tmp); end; Close(FilePass); end else MyMessageBox(' Ошибка ввода пароля!!!', nil, mfError+mfOkButton); end; {Обработка ошибок} procedure CheckExec; var St: string; begin Str(DOSError, St); case DOSError of 2: MyMessageBox(' Ошибка DOS № ' + St + ' "Файл не найден"', nil, mfError + mfOkButton); 3: MyMessageBox(' Ошибка DOS № ' + St + ' "Путь не найден"', nil, mfError + mfOkButton); 5: MyMessageBox(' Ошибка DOS № ' + St + '"Неверный код доступа к файлу"', nil, mfError + mfOkButton); 6: MyMessageBox(' Ошибка DOS № ' + St + '"Неверный код системного обработчика файла"', nil, mfError + mfOkButton); 8: MyMessageBox(' Ошибка DOS № ' + St + ' "Недостаточно памяти"', nil, mfError + mfOkButton); 10: MyMessageBox(' Ошибка DOS № ' + St + ' "Неверная среда"', nil, mfError + mfOkButton); 11: MyMessageBox(' Ошибка DOS № ' + St + ' "Неправильный формат"', nil, mfError + mfOkButton); 18: MyMessageBox(' Ошибка DOS № ' + St + '"Нет свободных обработчиков для файлов"', nil, mfError + mfOkButton); end; end; procedure MakeComFile(k: byte); const S : array [1..4] of string = ('c:\sub_rosa\plus.', 'c:\sub_rosa\passw.', 'c:\sub_rosa\block.', 'c:\sub_rosa\keydisk.'); Size : array [1..4] of word = (1068, 204, 617, 2118); Inden: array [1..4, 1..3] of byte = ((ord('ы'), 26 , ord('Р')), (ord('ы'), 39 , ord('Р')), (ord('щ'), ord('Й'), ord('_')), (ord('щ'), ord('А'), ord('_'))); var I, Tmp : byte; F : array [1..4, 1..2] of file ; M : array [1..2200] of byte ; NumRead, NumWritten: Word; begin assign(F[k, 1], S[k]); reset(F[k, 1], 1); assign(F[k, 2], S[k]+'com'); rewrite(F[k, 2], 1); for i := 1 to 3 do begin BlockRead(F[k, 1], tmp, 1, NumRead); BlockWrite(F[k, 2], Inden[k, i], 1, NumWritten); end; BlockRead(F[k, 1], M, Size[k]-3, NumRead); BlockWrite(F[k, 2], M, Size[k]-3, NumWritten); close(F[k, 1]); close(F[k, 2]); end; procedure DelComFile(k: byte); const { S: array [1..4] of string = ('plus.com', 'passw.com', 'block.com', 'keydisk.com');} S : array [1..4] of string = ('c:\sub_rosa\plus.com', 'c:\sub_rosa\passw.com', 'c:\sub_rosa\block.com', 'c:\sub_rosa\keydisk.com'); var F: array [1..4] of file; begin Assign(F[k], S[k]); Erase(F[k]); end; {****************************************************************************} {*----------=========== Д О П И С А Т Ь К Ф А Й Л У ==========----------*} {****************************************************************************} procedure Plus(WhatDo: string); var FileStr, Err: string; CmdLine : string; I : byte; FileName : FNameStr; Regs : Registers; begin {Проверка условий} if Length(FName) > 3 then begin if (copy(FName, length(FName)-2, 3) = 'EXE') or (copy(FName, length(FName)-2, 3) = 'COM') then begin {Преобразование имени файла} for i:= length(fname) downto 1 do if fname[i] = '\' then begin CmdLine := copy(FName, i+1, length(FName) - i); break; end; for i := 1 to length(CmdLine) do if CmdLine[i] in ['A'..'Z'] then CmdLine[i] := chr(ord(CmdLine[i]) + 32); for i := 1 to length(MainDir) do if MainDir[i] in ['A'..'Z'] then MainDir[i] := chr(ord(MainDir[i]) + 32); MakeComFile(1); If WhatDo = SetPass then MakeComFile(2); If WhatDo = KeyDisk then MakeComFile(4); {Выполнить дописывание} SwapVectors; Exec( MainDir + 'plus.com ', CmdLine + ' ' + MainDir + WhatDo); SwapVectors; DelComFile(1); If WhatDo = SetPass then DelComFile(2); If WhatDo = KeyDisk then DelComFile(4); {Обработчик ошибок} if DosError <> 0 then CheckExec else begin regs.ah := $4D; with regs do msdos(regs); case Regs.AH of 0 : MyMessageBox(' Файл ' + FName + ' защищен.', nil, mfInformation + mfOkButton); 1 : MyMessageBox(' Ctrl-C или Ctrl-Break.', nil, mfError + mfOkButton); 2 : MyMessageBox(' Критическая ошибка устройства.', nil, mfError + mfOkButton); 3 : MyMessageBox(' TSR - программа.', nil, mfError + mfOkButton); end; end; end else MyMessageBox(' Ошибка выбора файла !!! ', nil, mfError + mfOkButton); end else MyMessageBox(' Файл не выбран!!! ', nil, mfError + mfOkButton); end; {****************************************************************************} {*----------===== Б Л О К И Р О В К А В И Н Ч Е С Т Е Р А ======----------*} {****************************************************************************} procedure LockDisk; label end_; var Regs: registers; Err : string; Inst: byte; begin {Проверка наличи программы в памяти} asm push ax push dx mov Inst, 0 mov ax,1059h mov dx,2517h int 13h cmp ax,2517h jne End_ cmp dx,1059h jne End_ mov Inst, 1 End_: pop dx pop ax end; if Inst = 0 then begin MakeComFile(3); {Установить защиту} SwapVectors; SetIntVec($09, Int09_Save); Exec(MainDir + 'block.com', ''); GetIntVec($09, Int09_Save); SwapVectors; {Обраюотчик ошибок} if DosError <> 0 then CheckExec else begin regs.ah := $4D; with regs do msdos(regs); case Regs.AH of 0 : MyMessageBox(' Ненормальное завершение.', nil, mfError + mfOkButton); 1 : MyMessageBox(' Ctrl-C или Ctrl-Break.', nil, mfError + mfOkButton); 2 : MyMessageBox(' Критическая ошибка устройства.', nil, mfError + mfOkButton); 3 : MyMessageBox(' Винчестер блокирован.', nil, mfInformation + mfOkButton); { TSR } end; end; end else MyMessageBox(' Защита уже установлена.', nil, mfError + mfOkButton); end;
{Изменить стандартную палитру} function TDirDialog.GetPalette: PPalette; const {Синяя палитра} CMyCluster = #64#65#66#67#68#69#70#71#72#73#74#75#76#77#78#79#80#81#82+ #83#84#85#86#87#88#89#90#91#92#93#94#95; P: string [32] = CMyCluster; begin GetPalette := @P; end; {Окно работы с каталогами} constructor TMyChDirDialog.Init(AOptions: Word; HistoryId: Word); var R : TRect; ScrollBar: PScrollBar; CurDir : DirStr; begin { Создание окна } R.Assign(16, 2, 64, 20); TDialog.Init(R, 'Изменить катлог'); Options := Options or ofCentered; { Строка ввода имени каталога } R.Assign(3, 3, 30, 4); DirInput := New(PInputLine, Init(R, 68)); Insert(DirInput); R.Assign(2, 2, 17, 3); Insert(New(PLabel, Init( R, '~И~мя каталога', DirInput))); { Список каталогов } R.Assign(32, 6, 33, 16); ScrollBar := New(PScrollBar, Init(R)); Insert(ScrollBar); R.Assign(3, 6, 32, 16); DirList := New(PDirListBox, Init(R, ScrollBar)); Insert(DirList); R.Assign(2, 5, 19, 6); Insert(New(PLabel, Init( R, '~Д~ерево каталогов', DirList))); { Формирование кнопок } R.Assign(35, 6, 45, 8); OkButton := New(PButton, Init( R, '~А~га', cmOK, bfDefault)); Insert(OkButton); Inc(R.A.Y,3); Inc(R.B.Y,3); ChDirButton := New(PButton, Init( R, '~С~мена', cmChangeDir, bfNormal)); Insert(ChDirButton); Inc(R.A.Y,3); Inc(R.B.Y,3); Insert(New(PButton, Init( R, '~Н~ека', cmCancel, bfNormal))); if AOptions and cdNoLoadDir = 0 then SetUpDialog; SelectNext(False); end; procedure TMyChDirDialog.SetUpDialog; var CurDir: DirStr; begin if DirList <> nil then begin CurDir := GetCurDir; DirList^.NewDirectory(CurDir); if (Length(CurDir) > 3) and (CurDir[Length(CurDir)] = '\') then CurDir := Copy(CurDir,1,Length(CurDir)-1); if DirInput <> nil then begin DirInput^.Data^ := CurDir; DirInput^.DrawView; end; end; end; function TMyChDirDialog.Valid(Command: Word): Boolean; var P: PathStr; begin Valid := True; if Command = cmOk then begin P := FExpand(DirInput^.Data^); if (Length(P) > 3) and (P[Length(P)] = '\') then Dec(P[0]); {$I-} ChDir(P); if IOResult <> 0 then begin MyMessageBox(' Неправильный каталог!', nil, mfError + mfOkButton); Valid := False; end; {$I+} end; end;
{Инициализировать рабочее поле} constructor TMyBackground.Init(var Bounds: TRect; AText: TTitleStr); begin inherited Init(Bounds, ' '); Text := AText; while Length(Text) < SizeOf(TTitleStr) - 1 do Text := Text + AText; end; procedure TMyBackground.Draw; var DrawBuffer: TDrawBuffer; begin MoveStr(DrawBuffer, Text, GetColor(1)); WriteLine(0, 0, Size.X, Size.Y, DrawBuffer); end; procedure TMyDesktop.InitBackground; var R: TRect; begin GetExtent(R); Background := New(PMyBackground, Init(R, '___')); end; {Изменить стандартную палитру} function TMyStaticText.GetPalette: PPalette; const {Синяя палитра} CMyCluster = #64#65#66#67#68#69#70#71#72#73#74#75#76#77#78#79#80#81#82+ #83#84#85#86#87#88#89#90#91#92#93#94#95; P: string [32] = CMyCluster; begin GetPalette := @P; end;
{Окно "О Программе"} constructor TAboutBox.Init; var R: TRect; begin R.Assign(0, 0, 30, 16); inherited Init(R, 'О программе'); Options := Options or ofCentered; R.Assign(10, 13, 20, 15); Insert(New(PButton, Init(R, '~А~га', cmOK, bfDefault))); R.Assign(11, 2, 19, 3); Insert(New(pMyStaticText, Init(R, 'Sub Rosa'))); R.Assign(1, 4, 29, 5); Insert(New(pStaticText, Init(R, 'Система защиты данных от НСД'))); R.Assign(5, 5, 29, 6); Insert(New(pStaticText, Init(R, 'выполнена учащимися'))); R.Assign(10, 6, 29, 7); Insert(New(pStaticText, Init(R, 'гр. 4641'))); R.Assign(6, 7, 29, 8); Insert(New(pStaticText, Init(R, 'Егановым Максимом'))); R.Assign(14, 8, 22, 9); Insert(New(pStaticText, Init(R, 'и'))); R.Assign(6, 9, 29, 10); Insert(New(pStaticText, Init(R, 'Юзефовичем Артемом'))); R.Assign(6, 11, 29, 12);P> Insert(New(pStaticText, Init(R, 'МГВРК, Минск, 1996'))); end; {Работа программы начинается здесь...} constructor TMyApp.Init; var ReturnVal, i : Word; DirInfo, DirInfo1, DirInfo2 : SearchRec; DirInfo3, DirInfo4, DirInfo5: SearchRec; Pas : string; st : char; begin OptInd := 1; {Инициализировать файл ресурсов} MyRes.Init(New(PBufStream, Init('Setup.res', stOpen, 1024))); if MyRes.Stream^.Status <> stOK then begin Write('Нарушение целостности!'); halt(1); end; RegisterType(RMenuBar); {Проверить целостность системы} MainDir := GetCurDir; FindFirst('plus', AnyFile, DirInfo); FindFirst('passw', AnyFile, DirInfo1); FindFirst('block', AnyFile, DirInfo2); FindFirst('keydisk', AnyFile, DirInfo3); FindFirst('setup.res', AnyFile, DirInfo4); if (DOSError = 0) and (DirInfo.Size = 1068) and (DirInfo1.Size = 204) and (DirInfo2.Size = 617) and (DirInfo3.Size = 2118) and (DirInfo4.Size = 522) then begin {Получить пароль} Assign(FilePass, 'system.res'); Reset(FilePass); Pass := ''; while not EOF(FilePass) do begin read(FilePass, st); Pass := Pass + st; end; Close(FilePass); {Инициализировать систему} TApplication.Init; Pas := ''; ReturnVal := ExecuteDialog(New(PAboutBox, Init), nil); InputBox('П А Р О Л Ь', 'Введите пароль:', Pas, 255); for i:= 1 to length(Pas) do Pas[i] :=chr(ord(Pas[i]) xor 27); if Pas <> Pass then begin MyMessageBox(' Неверный пароль!!!', nil, mfError+mfOkButton); ClrScr; writeln('Несанкционированный доступ!'); Halt; end; end else begin writeln('Нарушение целостности!'); Halt; end; end; {Завершение работы} destructor TMyApp.Done; begin TApplication.Done; MyRes.Done; end;
{Обработка событий} procedure TMyApp.HandleEvent(var Event: TEvent); procedure ChangeDir; var D: PMyChDirDialog; begin D:= New(PMyChDirDialog, Init(cdNormal, 101)); ExecuteDialog(D, nil); end; var ReturnVal: Word; regs : Registers; R : TRect; begin inherited HandleEvent(Event); case Event.What of evCommand: begin case Event.Command of cmAboutBox : ReturnVal := ExecuteDialog(New(PAboutBox, Init), nil); cmOpen : FileOpen('*.*'); cmChangeDir : ChangeDir; cmSetPass : Plus(SetPass); cmKeyDisk : Plus(KeyDisk); cmCode : Shifr(FName); cmDeCode : DeShifr(FName); cmLockDisk : LockDisk; cmOptions : ReturnVal := ExecuteDialog(New(POptions, Init), @OptFile); cmPasswords : Passwords end; ClearEvent(Event); end; end; end; {Инициализировать меню} procedure TMyApp.InitMenuBar; var R: TRect; begin {Получить меню из файла ресурсов по ключу "Config" - функция получения} {даты BIOS; модуль SetConf} MenuBar := PMenuBar(MyRes.Get(Config)); if MenuBar = nil then begin Write(' Нелегальная копия!!!'); halt(1); end; end; {Инициализировать рабочее поле} procedure TMyApp.InitDesktop; var R: TRect; begin GetExtent(R); R.Grow(0, -1); Desktop := New(PMyDesktop, Init(R)); end; {Инициализировать строку состояния} procedure tMyApp.InitStatusLine; var R: tRect; begin GetExtent(R); R.A.Y:= R.B.Y - 1; StatusLine:= New(pStatusLine, Init(R, NewStatusDef(0, $FFFF, NewStatusKey('~F1~ О программе', kbF1, cmAboutBox, NewStatusKey('~F3~ Файл', kbF3, cmOpen, NewStatusKey('~F5~ Пароль', kbF10, cmMenu, NewStatusKey('~F9~ Настройки', kbF9, cmOptions, NewStatusKey('~F10~ Меню', kbF10, cmMenu, NewStatusKey('~Alt-X~ Выход', kbAltX, cmQuit, nil)))))), nil))); end; {Изменить основную палитру} function TMyApp.GetPalette: PPalette; const P: Array [apColor..apMonochrome] of string[Length(CAppColor)] = (CAppColor, CAppBlackWhite, CAppMonochrome); begin P[apColor, 50] := #$11; {1F} P[apColor, 51] := #$11; {2F} P[apColor, 1] := #$21; {71} GetPalette := @P[AppPalette]; end; {Изменить палитру окна выбора файлов} function TMyFDialog.GetPalette: PPalette; const {Синяя палитра} CMyCluster = #64#65#66#67#68#69#70#71#72#73#74#75#76#77#78#79#80#81#82+ #83#84#85#86#87#88#89#90#91#92#93#94#95; P: string [32] = CMyCluster; begin GetPalette := @P; end; {Инициализировать окно выбора файлов} constructor TMyFileDialog.Init(AWildCard: tWildStr; const ATitle, InputName: string; AOptions: Word; HistoryId: Byte); var ScrollBar: PScrollBar; R : TRect; begin { Создание окна диалога } R.Assign(15, 1, 64, 20); TDialog.Init(R, ATitle); Options:= Options or ofCentered; WildCard:= AWildCard; { Строка ввода имени файла } R.Assign(3, 3, 31, 4); FileName:= New(PFileInputLine, Init(R, 79)); FileName^.Data^:= WildCard; Insert(FileName); R.Assign(2, 2, 6, 3); Insert(New(PLabel, Init(R, InputName, FileName))); R.Assign(31, 3, 34, 4); Insert(New(PHistory, Init(R, FileName, HistoryId))); { Линейка скроллинга и список файлов } R.Assign(3, 14, 34, 15); ScrollBar:= New(PScrollBar, Init(R)); Insert(ScrollBar); R.Assign(3, 6, 34, 14); FileList:= New(PFileList, Init(R, ScrollBar)); Insert(FileList); R.Assign(2, 5, 8, 6); Insert(New(PLabel, Init(R, 'Файлы', FileList))); { Задание кнопок } R.Assign(35, 3, 46, 5); if AOptions and fdOpenButton <> 0 then begin Insert(New(PButton, Init( R, 'Открыть', cmFileOpen, bfDefault))); Inc(R.A.Y,3); Inc(R.B.Y,3); end; if AOptions and fdOkButton <> 0 then begin Insert(New(PButton, Init( R, 'Ага', cmFileOpen, bfNormal))); Inc(R.A.Y,3); Inc(R.B.Y,3); end; if AOptions and fdReplaceButton <> 0 then begin Insert(New(PButton, Init( R, 'Замена',cmFileReplace, bfNormal))); Inc(R.A.Y,3); Inc(R.B.Y,3); end; if AOptions and fdClearButton <> 0 then begin Insert(New(PButton, Init( R, 'Удал.',cmFileClear, bfNormal))); Inc(R.A.Y,3); Inc(R.B.Y,3); end; Insert(New(PButton, Init( R, 'Нека', cmCancel, bfNormal))); { Информационная панель с параметрами файла } R.Assign(1, 16, 48, 18); Insert(New(PFileInfoPane, Init(R))); SelectNext(False); { Загрузка каталога } if AOptions and fdNoLoadDir = 0 then begin FileList^.ReadDirectory(WildCard); Directory:= NewStr(GetCurDir); end; end; Var MyApp: TMyApp; {Переменная основного объекта} Begin WriteLn('Система защиты данных от НСД. Версия 1.0 beta.'+ +' 1996 МГВРК Еганов М. Ю., Юзефович А. Г.'); GetIntVec($09,Int09_Save); MyApp.Init; MyApp.Run; MyApp.Done; SetIntVec($09, Int09_Save); End.
Популярное: Как распознать напряжение: Говоря о мышечном напряжении, мы в первую очередь имеем в виду мускулы, прикрепленные к костям ... Как вы ведете себя при стрессе?: Вы можете самостоятельно управлять стрессом! Каждый из нас имеет право и возможность уменьшить его воздействие на нас... Почему стероиды повышают давление?: Основных причин три... ©2015-2024 megaobuchalka.ru Все материалы представленные на сайте исключительно с целью ознакомления читателями и не преследуют коммерческих целей или нарушение авторских прав. (168)
|
Почему 1285321 студент выбрали МегаОбучалку... Система поиска информации Мобильная версия сайта Удобная навигация Нет шокирующей рекламы |