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.