|
Защита данных от несанкционированного доступа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('[pic]')), (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); 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); |
|
