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;