ПРОГРАММА ANTIVIR
П9.1. Текст программы AntiVir
{$Х+.Т-}
{
Программа контроля исполняемых файлов на возможность заражения компьютерным вирусом. При запуске командой ANTIVIR инициируется диалоговый режим, при запуске командой ANTIVIR /AUTO осуществляется автоматический контроль файлов, параметры которых хранятся в файле ANTIVIR.DAT.
}
Uses F Anti, {Включаем автоконтроль программы} CRT, DOS, F_Disk, Memory, StdDIg, MsgBox, HelpFile, {Этот модуль в исходном тексте входит в поставку TV и обычно
располагается в каталоге \bp\examples\idos\tvd.emos} Арр, Dialogs, Objects, Drivers,Views, Menus;
!
+-.--—--—---——-——-——---------————-—--+
1 Глобальные определения I
+-——-----——-------—-———————-----+
/
type
(Описатель раздела ЖД) Part_Type а" record
BootF: Byte; (Флаг активности раздела}
BegHd: Byte; (Головка для начала раздела}
BegSC: Word; (сектор/цилиндр!
Sys : Byte; (Код системы}
EndHd: Byte; (Головка для конца раздела}
EndSC: Word; (сектор/цилиндр}
Sees : Longint; (Относительный номер начального сектора}
Size : Longint; (Длина раздела в секторах} end; (Part Type)
(Структура загрузочного сектора} BootSecType = record
a: array [0..$1BD] of Byte;
Part: array [1..4] of Part_Type;
b: array (1..2] of Byte end;
(Первый сектор файла} LType = record case Byte of 1: (Boot: BootSecType);
2: (W: array [1..256] of Word);
end;
(Описание логического диска в заголовке архивного файла} TLogicD - record
BHd: Byte; (Начальная головка}
BSC: Word; (Сектор-цилиндр)
Space: Longint; {Объем а секторах} end;
(Описание структуры ЖЯ в резервном файле} TStruc ~ record
BHd: Byte;
BSC: Word;
Sec: BootSecType end;
(Описание файла в архивной файле} CheckType = record
Name: PathStr; {Полное имя файла}
SecO: LType; (Эталон первого сектора}
SizO: Longint {Эталонная длина файла} end;
(Заголовок архивного файла} THead = record case Byte of 0:(
HD String [7]; ('ANTIVIR'}
BIOS Longint; (Контр.сумма BIOS}
Intl3 Pointer; {Адрес входа в Intl3}
NDisk Byte; {Количество ЛД}
SecTr Byte; {# секторов на дорожке!
Heads Byte; (Количество головок}
LDisk array [1..48] of TLogicD; (Ссылки на ЛД и их описатели}
Begl3 array [I..SizeOf(CheckType)-27-
48*SizeOf(TLogicD)] of Byte); {Начало Intl3) 1:(CT: CheckType) end;
{Turbo Vision программа, обеспечивающая диалог)
PVir •^TVir;
TVir = object (TApplication)
HelpFile: String; (Пия Help-файла}
Procedure InitStatusLine; Virtual;
Procedure Run; Virtual;
Procedure DoHelp;
end;
var
F: File of CheckType; (Архивный файл} Head: THead; {Его заголовок} FColl: PCollection; (Архив в памяти}
BegDat: Longint; (Начало файловой области я архиве) сопзЪ
Stop : Boolean = True; (Признак отказа от контроля) IsVirus: Boolean = False; (Признак обнаруженного вируса) Files : Word •= 0; {Счетчик файлов} AntiV : PVir °- mii; (Указатель на диалог) FChange: Boolean = Fal&e; {Признак изменения коллекции)
{
+----—————————-——————-——————————+
¦ Типы, процедуры и функции, реализующие I I контроль загрузочных секторов и файлов 1 1 на возможное заражение вирусами 1 ] и лечение пораженных файлов (секторов) I
+———————————————————,—————————+
} Procedure Msg(S: String);
(Контролирует текущий видеорежш и susemv сообщение S с помощью Turbo Vision или оператором ftritstiii) var
R: TRect;
С: Char;
AOpt: Word;
begin
if AntiV=MXb then
begin (Обычный режим вывода) WriteLn(S) ;
Write(IНажмите любую клавишу...');
С :° ReadKey;
While KeyPressed do
С :° ReadKey end else
begin (Вывод в Turbo Vision) AOpt := mfOKButton;
AOpt :•= MessageBox(S, KIL,AOpt) end end; (Msg) {...- ————————— ;
Procedure WriteFile(Source: CheckType);
(Записывает в файл F очередную запись и контролирует ошибку) var
k: Integer;
begin
{$1-1
Write(F,Source);
($!+)
if IQResultoO then begin
Msg('Ошибка записи в архивный файл');
Halt end end; {WriteFile} /-._——————————;
Procedure CheckErr(S: String);
{Проверяет статус диска, выводит сообщение S и останавливает счет, если
Dis^Error^True }
begin
if not Disk_Error then Exit;
Msg(S) ;
Halt
end; {CheckErr} /-^——————————/
Function Equal(var A,B; Size: Word): Boolean;
(Сравнивает Size байт из переменных А и В и возвращает TRUE, если они совпадают} var
Х: array [1..65535] of Byte absolute A;
Y: array [1..65535] of Byte absolute B;
Res: Boolean;
k : Word;
begin
k := 1;
repeat
Res :° X[k]=Y[k];
inc(k)
until not Res or (k>Size);
Equal := Res end; {Equal} {,...—————————}
Function Okay(s: String): Boolean;
{Дает сообщение S, возвращает TRUE,если нажата клавиша Y} var
с: Char;
begin {Okay}
Write(s+' (Y/N,Enter=Y)? ');
repeat
с := UpCase(ReadKey) ;
if KeyPressed then it ReadKey=' ' then;
case с of
#13: с := •Y';
'У :;
'N' :;
else Write(*7) end;
until (c-'Y') or (c°'N');
WriteLn(c) ;
Okay := c='Y' end; {Okay} ^_——————————/
Procedure ReStartDOS;
(Осуществляет перезапуск DOS! begin asm
mov ax,$FOOO (Сегмент перезапуска) push ax (Помещаем его в стек} mov ax,$FFFO {Смещение}
push ax {Помещаем в стек) retf {Перезапуск ДОС} end end; {ReStartDos} {.-, ————_———_——}
const
Intl3Addr: Pointer=»NIL; {Адрес Intl3 в BIOS}
01d62: Pointer=NII.; (Старый вектор $62} /————.—————_——;
Procedure RWSecIntl3(Op,Hd,SC: Word; var Targ);
{Читает или записывает абсолютный сектор ВД с помощью непосредственного вызова Intl3 из BIOS} var
R: Registers;
begin
if Intl3AddrONIL then with R do begin
ah := Op;
al :- 1;
dh :- Hd;
dl := $80;
ex := SC;
es := Seg(Targ) ;
bx :"= Ofs (Targ);
Intr($62,R) ;
Disk Error := Flags and FCarryoO end else
GetAbsSector($80,Hd,SC,Targ) end; {R»SecIntl3} _•————————————;
Procedure Alarm;
/'Вызывается в случае обнаружения изменений в структуре ЖД} var
k: Integer;
Fl: File of TStruc;
c: CheckType;
Boot: BootSecType;
S,ss: String;
Procedure Save(H: Byte; SC: Word);
(Записывает абсолютные координаты сектора и сам сектор в файл Fl} var
LD: TStruc;
begin
if so'' then with LD do begin
BHD := H;
BSC := SC;
GetAbsSector($80,BHD,BSC,Sec) ;
Write(F1,LD) end end;
const
t: array [1..9] of String [80]=(
'Обнаружены изменения в структуре жесткого диска, которые могут быть",
'следствием заражения ПК вирусом!',
'Лечение загрузочного вируса основано на восстановлении структуры ЖД',
'в том виде, в каком она была к моменту создания архивного файла.',
'Эта операция может нанести непоправимый вред Вашему ПК, '+
"если архивный файл",
'содержит ошибочную информацию (например, взят от другого ПК) ' +
'или не учитывает',
'новое разбиение жесткого диска на логические разделы.',
'Рекомендую перезагрузить DOS с эталонной дискеты и убедиться в том, '+
'что вирус',
'действительно существует (с помощью AIDSTEST, PCTOOLS и т.п.).');
begin
(Предупреждаем об опасности) for k := 1 to 9 do
begin
GotoXY((8O-Length(t[k])) div 2,WhereY);
WriteLn(t[k])
end;
Write(#7); (Звуковой сигнал} if Okay(*13#10'Перезагрузить DOS') then
ReStartDOS; (Перезагружаем ДОС} Write('Лечить (Y/N,Enter=N)? ');
if UpCase(ReadKey)<>'X' then
Halt;
{Запрашиваем дублирование на ГД и готовим файл с копиями зараженных секторов}
if Okay('Сохранить копию структуры ЖД на дискете') then repeat
Write('Вставьте дискету с открытой прорезью и введите имя ГД: ');
ReadLn(S) ;
s[l] := UpCase(s[l]);
if Length (s)=l then
s := s+':' until (s='A:') or (s='B:');
if so' 1 then begin
Assign(Fl,s+'\VIRDAT.$V$') ;
Rewrite(Fl);
end;
{Восстанавливаем структуру ЖД} Seek(F,l) ;
with Head do
for k := 1 to NDisk do with LDisk[k] do begin
Read(F,c);
Save(BHd,BSC) ;
RWSecIntl3(3,BHd,BSC,c.SecO) end;
if So1 ' then Close(Fl);
{Перезагружаем ДОС} ReStartDOS end; {Alarm} ^———————————;
Procedure CheckBoots;
{Проверяет структуру ЖД- Head уже содержит проверенный заголовок архивного
файла}
var
с: CheckType;
ch:"CheckType;
Buf: LType;
к: Word;
begin {CheckBootsf
{Устанавливаем в вектор $62 BIOS-адрес входа в начало обработки прерывания
Intl3, чтобы обмануть utealth-вирусы}
GetIntVec($62,01d62); {Сй&саби век-гор $62} SetIntVec($62,Head.Intl3) ;
WriteLn;
WriteLn('Для досрочного завершения работы программы нажмите ESC")? WriteLn;
WriteLn('Антивирусный контроль описателей структуры ЖД:');
WriteLn('Головка','Сектор/цилиндр':20);
{Проверяем ссылки и описатели ЛД) with Head do
for k := 1 to NDisk do with LDisk[k] do begin
Write(BHD:4,BSC:17) ;
RWSecIntl3(2,BHd,BSC,Buf) ;
Read(F,c) ;
if Equal(c.SecO,Buf,512) then
WriteLn('Норма':20) else begin
WriteInCИзменен!'l20);
Alarm {Обнаружены изменения) end end;
{Нормальное завершение проверки} SetIntVec($62,01d62) ;
IntlSAddr := MIL;
BegDat :° FilePos(F) ;
{Наполняем коллекцию архивными файлами} WriteLn;
WriteLn('Читается архивный файл ANTIVIR.DAT...') ;
while not EOF(F) do begin
New(oh) ;
Read(F,ch^) ;
FColl".Insert(ch) ;
if KeyPressed and (ReadKey°#27) then
Halt end;
HriteLn
end; {CheckBoots} ^————————————/
Procedure SetFile(FName: String);
{Помещает в архив эталон файла FRAME} vac
ch: ^CheckType;
k, nz,sz: Word;
P : Pointer;
FP : file;
begin {SetFile}
Assign(FF,FName) ;
{$!-}
Reset (FF,1) ;
{?I+t
if lOResult <> 0 then MsgC Ошибка доступа к файлу Ч-FName)
else begin
{Искать в архиве одноименный файл:}
if FColl'-.CuuntOO then begin k := 0;
repeat
ch := FColl^Atfk) ;
inc (It);
until (ch".Name°=FName) or ()<=FColl^. Count) ;
if eh".Name=FName then
Exit end;
{Подготовить очередную запись:} New(ch) ;
ch'^.Name := FName;
ch^.SizO := FileSize(FF);
sz :° 512; (Длина блока чтения} if c^.Siz0^512 then
sz := ch^-SizO; {Файл меньше 512 байт} FillCharfch^.SecO,512,0) ;
BlockReadfFFyCh^.SecO,S2,nz) ;
Close(FF) ;
if nzosz then
MsgC Ошибка чтения из файла '-(•ch^-NanIS) else if not LowMemory then begin
FColl".Insert(ch) ;
FChange := True end else
k := MessageBox('Исчерпана доступная память', NIL,0) end end; {SetFile} ^-_——__—_——-_——;
Procedure BuildArch;
{Создает архивный файл} var
k,S13,013,h,s: Word;
c: CheckType;
ch^CheckType;
Din: TDisk;
begin
Rewrite(F);
if lOResuit <> 0 then begin
WriteLn('Невозможно открыть/создать файл данных );
Halt end;
{Создаем заголовок файла) with Head do begin
Hd := 'ANTIVIR';
{Подсчитываем КС BIOS} BIOS := 0;
for k := 0 to $FFFF do
BIOS := BIOS+Mem[$FOOO:k] ;
{Определяем вход в Intl3} asm
aov ah,$13
Int $2F
push ds (Сегмент)
push dx {Смещение)
Int $2F (Восстанавливаем Intl3f pop bx {Смещение} pop ax {Сегмент} mov S13,ax mov 013,bx end;
Intl3 := Ptr(S13,013) ;
Move(Intl3",Begl3,SizeOf(Begl3)) ;
NDisk := 0; (Количество дисков} end; fwitA Head} {Сканируем структуру ЖД} GetMasterBoot(c.SecO) ;
if not Disk_Error then with Head,c,SecO.Boot do
begin {Есть хотя бы один ЖД} h := 0;
s := 1;
Seek(F,l);
GetDiskInfo(2,DIn) ;
SecTr := DIn.TrackSiz;
Heads := Din.Heads;
{Цикл по всем ЛД: h,s - адрес ссылки}
repeat
/Запоминаем адрес ссылки в заголовке} inc(NDisk);
with LDisk[NDisk] do begin
BHd :° h;
BSC :- s;
Space :•• 1 end;
{Читаем ссылку на очередной ЛД}
GetAbsSector($80,h,s,c.SecO.Boot) ;
{Сохраняем ее в архиве} Name := 11 ;
SizO := 0;
Write(F,с) ;
{Ищем непустой описатель ЛД1 k := 1;
while (Part[k].BegSC»0) and (k<4) do inc(k) ;
if Part[k].BegSCOO then with Part[k] do begin
{Запоминаем адрес описателя в Head} inc (NDisk) ;
with LDisk[NDisk] do begin
BHd :- BegHd;
BSC :° BegSC;
Space :^s Size end;
{Запоминаем ссылку на следующий ЛД} inc(k);
h := Part [It] .BegHd;
s :° Part[k].BegSC;
{Запоминаем описатель в архиве} Name :« '';
SizO := 0;
with LDisk[Ndisk] do GetAbsSector($80,BegHd,BegSC,SecO);
Write(F,с) ;
end (если непустой описатель) until S»0
end; {есть хотя бы один ЛД} {Записываем заголовок архива} BegDat ;= FilePos(F) ;
Seek(F,0) ;
Write(F,Head.CT) ;
Seek(F,BegDat);
(Защищаем COMMAND.СОМ} SetFile(GetEnv('COM3 PEC'));
end; (BuildHead} ^————————————;
Function CheckHead: Boolean;
(Проверяет заголовок архивного файла} var
s: String;
k: Word;
Sum: LongInt;
DI: TDisk;
begin
{Подсчитываем КС BIOS}
Sum := 0;
for k := 0 to $FFFF do Sum := Sum+Mem[$FOOO:k] ;
{Получаем конструктивные параметры ЖД}
GetDiskInfo(2,DI) ;
(Читаем заголовок архива}
Read(F,Head.CT) ;
(Проверяем его}
S := •ANTIVIR';
with Head do
if (Hdos) or (SumOBIOS) or
not Equal(Begl3,IntlJ^,SizeOf(Begl3)) or (SecTrODl.TrackSiz) or (HeaasODI. Heads) then begin
WriteLn('Архивный файл содержит ошибочные данные!');
if not Okay('Создать новый архив') then
Halt else
CheckHead := False end else
CheckHead :» True end; {CheckHead} ^————————————;
Function Auto: Boolean;
{Контролирует параметры обращения, открывает или создает DAT-файл. Возвращает
TRUE, если обнаружен ключ /AUTO}
var
s: String;
к,j: Byte;
AF: Boolean; Флаг ключа /АОТО}
с: CheckType absolute Head;
313,013: Word;
DI: TDisK;
labe.i.
SetF,Errria;
const
tx='Архивный файл содержит ошиоо-чные данные. Создать новый файл ;
begin {Auto} AF := False;
for k •.sc 1 to ParamCount do begin
s := ParamStr(k);
for j := 1 to Length(s) do s[jl := OpCase(s[j]);
if s = '/AUTO' then
AF := True end;
fs = полное имя DAT-файла:} s := copy(ParamStr(0),l,pos('.',ParamStr(O)))+'DAT';
fГотовим коллекцию имен файлов} FColl := New(PCollection, Init(lOt), 10)) ;
{Формируем список дисковых описателей} GetListDisk(Disks) ;
Assign(F,s) ;
^1-;
Reset(F); {Проверяем существование архива} {$!+} if (IOResult<>0) or
not CheckHead then
BuildArch (Создаем, если нет архива) else (Файл существует}
CheckBoots; (Проверяем структуру ЖД} Auto := AF end; {Auto} /————————————;
Procedure Dialog;
{Осуществляет диалог с пользователем. Возвращает STOP=TRUE, если пользователь отказался от контроля. Использует средства библиотеки Turbo Vision} begin
New(AntiV) ;
with AntiV" do begin Init;
HelpFile := copy(ParaaStr(0),X,pos('.',ParamStr(0)))+'HLP';
RegisterHelpFile;
Run;
Done end;
Dispose(AntiV) end; {Dialog} ^————————————;
Procedure Check;
{Осуществляет контроль файлов по эталонам, хранящимся в коллекции FColl} var
FF: Pile;
Function Cure(SecO,Sec: LType): Byte;
{Проверяет тип файла и расположение в нем вируса и возвращает:
О - вирус в начале ЕХЕ-/Ьайла (не удаляется)
1 - вирус в конце ЕХЕ или СОМ-файяа
2 - вирус в начале СОМ-фаЯла
3 - пользователь не разрешил удалять вирус} var
С: Byte;
Eq: Boolean;
begin
with SecO do
if W[1]=$5A4D then {Если ЕХЕ-файл, проверяем сегмент точки запуска} if W[12]>=Sec.W[12] then
С := О {В начале или середине файла} else
С := 1 {В конце файла} else
(Если СОМ-файл, проверяем вторую половину сектора:} begin
if Equal(W[128],Sec.W[128],256) then
С := 1 (Нет изменений - вирус в конце} else
С := 2 {Сектор изменен - в начале} end;
if C=0 then
WriteLn('Вирус нельзя удалить, т.к.',
' он расположен в начале ЕХЕ-файла!') else
if not Okay('Удалять вирус') then С :° 3;
Cure :=> С end; {Cure} {—————} Procedure ReWriteFile(SizO: Longint);
{Перезаписывает незараженную часть СОМ-файла на место вируса максимально возможными блоками} vac
Sour,Dest,FSize: Longint;
Size: Word;
P: Pointer;
begin
Reset (FF,1) ;
Seek(FF,0);
FSize := FileSize(FF);
Sour := FSize-SizO; {Длина вируса} Dest :•= 0; {Начало файла} repeat (Переписать незаряженную часть
в -начало файла (на место вируса)} Size := 65520;
if FSize < Size then Size := FSize;
if Size > MaxAvail then Size := MaxAvail;
GetMem(P,Size) ;
Seek(FF,Sour); (Пропускаем вирус} BlocltReadtFF^^Size); (Читаем остальное} Seek(FF,Dest) ;
BlockWrite(FF,P",Size) ;
Sour :=• Sour+Size;
Dest := Dest+Size;
FSize := ^Size-Size;
FreeMem(P,Size) until FSize=0;
Truncate(FF); (Отсекаем лишнюю часть} Close(FF) ;
Reset (FF,1) end; {ReWriteFile} {—————} vax
oh : ^CheckType;
Sec : Lrype;
k,nz,sz: Word;
label
VirDet,SetBeg,Next,Stop;
const
txl = 'Антивирусный контроль файлов (ESC - стоп):';
tx2 = 'Вирус не обнаружен.';
tx3 •= "Проверьте незащищенные файлы!';
tx4 = 'Вирус может быть резидентным,'+
' рекомендую перезагрузить систему!';
tx5 = 'Перезагрузить ДОС';
begin {Check}
if FColT'.Count^O then
Exit; {Нет файлов в коллекции} IntlSAddr :° Head.Intl3;
SetIntVec($62,Head.Intl3) ;
WriteLnC ': (80-Length(txl)) div2,txl);
Files := 0; {Счетчик проверенных файлов} for k := 0 to predtFColl".Count) do begin
oh := FCoU^Attk);
with ch" do begin Assign(FF,Name);
{$!-} Reset (FF,1) ;
l?I+} if lOResult о 0 then
WriteLnC Ошибка доступа к файлу ',Naine) else begin
{Сообщаем о контроле очередного файла} GotoXY(l,WhereY) ;
Write(' ':79); {Стираем строку} GotoXY(lO,WhereY) ;
Write(Name,' '); {Выводи» имя файла} inc(Files); {Счетчик файлов} {Читаем первый сектор файла) sz :- 512;
if FileSize(FF)<512 then
sz :° FileSize(FF); (Длина чтения} BlockRead(FP,Sec,sz,hz) ,• if szonz then begin
WriteLn( 'Ошибка чтения из файла ',Name);
Close(FF) ;
goto Next end;
{Контролируем файл:} if not Equal(Sec,Sec0,sz) then
Goto VirDet; (Изменен - вирус!} Close(FF) ;
goto Next; {Если нет отличий} VirDet: (Обнаружен вирус:}
WriteLn('заражен!'#7);
IsVirus :° True;
(Спрашиваем разрешения и лечим, если это возможно}
case Cure(SecO,Sec) of
0: goto Next; (Вирус в начале ЕХЕ-файла не удалять}
1: (Вирус в конце файла}
begin
(Восстанавливаем первый сектор} SetBeg: Seek(FF,O);
BlockWrite(FF,SecO,sz,nz) ;
{Восстанавливаем начальную длину} if sz=nz then begin
Seek(FF,SizO) ;
Truncate(FF); {Отсекаем вирус} Close(FF) end else begin
Close(FF) ;
HriteLn('Ошибка записи в файл ^сп^.Ыате) end end;
2: {Вирус в начале СОМ-файла} begin
{Перемещаем программу вверх} ReWriteFilefch^.SizO) ;
{И восстанавливаем ее начало} Goto SetBeg;
end;
3: begin (Пользователь запретил лечение} Close(FF) ;
goto Next end end {case Cure} end; {if not Disk_Error} Next: if KeyPressed and (ReadKey#27) than
Goto Stop end {with ch"} end; {for k:=0 to} Stop:
SetIntVec($62,01d62) ;
Intl3Addr := NIL;
{Сообщаем об итогах проверки} Write(#13'Проверено ',Files,' файлов. 'It-if not IsVirus then
WriteLn(tx2) else begin
WriteLn(tx3) ;
WriteLn(tx4) ;
if OKay(tx5) then
begin {Перезапускаем ДОС} Close(f); {Сохраняем архив} ReStartDOS end end;
WriteLn('(C) 1992 г. В.В.Фаронов':80) end; {Check}
{
+_-_---_____--_--—————————-—————----+
I Типы, константы и подпрограммы для \ 1 реализации диалога средствами Turbo Vision I
+---_--______--_-_-_-_-_-—___———---------—-+
;
const {Команды для диалога}
cmQui ~ 199 {Выход} cmSet = 200 {Поместить новый} cmDel ° 201 {Удалить существующий} cmRun =203 {Выполнить проверку} cmFresh=2O4 /Обновить информацию) cmAll = 205 {Выбрать все} стСО = 206 {Сменить каталог} cmCDW -= 207 {Сменить маску выбора файлов} стЕХЕ » 208 {Сменять СОМ на ЕХЕ и наоборот} type
{Основное диалоговое окно} PDWT="DWT;
DWT - object (TDialog)
Procedure HandleEvent(var Event: TEvent); Virtual;
Procedure AddFiles;
Procedure DelFiles;
Procedure FreshFiles;
end;
{Скроллер списка файлов} PFileListBox = "TFileListBox;
TFileListBox = object (TListBox)
PFL: PStringCollection; {Коллекция имен}
MarkL: Byte; {Длина маркера}
Procedure HandleEvent(var Event: TEvent); Virtual;
Procedure GetDir(WC: String);
Procedure MarkF(var s: String);
Procedure DemarkF(var s: String) ;
Procediire SetAll;
end;
{Строка ввода имени/маски файла} PInpLine » "TInpLine;
TInpLine •= object (TInputLine)
Procedure HandleEvent(var Event: TEvent); Virtual;
end;
{Окно режима добавления файлов}
PAddFileBox = "TAddFileBox;
TAddFileBox « object (TDialog)
WildC: String; {Маска} PL : PFileListBox; {Скроллер списка} PInL : PInpLine; {Строка ввода маски} PDir : PStaticText; {Имя каталога] Procedure HandleEvent(var Event: TEvent); Virtual;
Procedure SetFiles;
end;
{Окно режима удаления файлов}
PDelFileBox ""TDelFileBox;
TDelFileBox = object (TDialog
PL: PFileListBox; {Скроллер списка} Procedure HandleEvent(var Event: TEvent); Virtual;
end;
{Окно справочной служОы PMyHelpWindow =ATMyHelpWinc:ow;
TMyHelpWindow = object (THelpWindow)
procedure HandleEvent(var Event: TEvent); Virtual;
Function GetPalette: PPalette; Virtual;
end;
^———————.———————————__—._——._.___+
I Создаем строку статуса и I I основное диалоговое окно I +————______——.——_—_____-_-_____________-+;
Procedure TVir.InitStatusLine;
{Формирует строку статуса.} var
R: TRect;
begin
GetExtent(R) ;
R.A.Y := pred(R.B.Y); {R - координаты строки статуса! StatusLine :» New(PStatusLine, Init(R, NewStatusDef(0,$FFFF,
NewStatusKey('~ESC~ Выход в ДОС = Стоп',kbFlO,cmQuit, NewStatusKeyl' ~F1~ Справочная служба',
kbFl,c'mHelp, NIL», NIL) ) ) ;
end; {TVir.InitStatusLine} ;-. —————____——-;
Procedure TVir.Run;
{Создает и использует основное диалоговое окно} var
DH; PDWT;
R : TRect;
Cntrl: Word;
const
cl « 'Программа защиты исполняемых файлов';
с2 = '(С) 1992, В.В.Фаронов';
сп = -5; {Левая граница ряда кнопок} begin
Stop := True;
{Создаем окно с поясняющими надписями}
R.Assign(5,5,75,14);
DW := New(PDwt, , Init (R, " )) ;
R.Assign(1,1,69,4) ;
DW.Insert(New(PStaticText,Init(R,#13#3+cl+#13+#3+c2))) ;
{Вставляем кнопки}
R.Assign(cn+7,6,cn+18,8) ;
EW-. Insert (New (PButton, Init (R, 1 •'S~ Стоп ', cmCancel,bfNormai))) ;
R.Assign(cn+18,6,cn+31,8) ;
DW.Insert(New(PButton,Init(R,1~A~ Добавить',cmSet,bfDefault))) ;
R.Assign(cn+31,6,cn+44,8) ;
DH".Insert(New(PButton,Init(R,'~D~ Удалить ',cmDel,bfNormal)));
R.Assign(cn+44,6,cn+58, 8) ;
DW^.Insert(New(PButton,Init(R,'~F~ ОбновитьI,cmFresh,bfNormal) ) ) ;
R«. Assign(cn+58,6,cn+72,8) ;
DW.Insert(New(PButton,Init(R,'~R~ Контроль',cmRun,bfNormal))) ;
DW^.HelpCtx := 1;
Cntrl :=• Desktop^.ExecView(DW);
end; {TVir.Run} {—— ——————._———;
Function TMyHelpWindow.GetPalette;
{Готовит нужную палитру для справки} coast
Р = #16#17#18»19»20#47#21#13;
С: String [81 = Р;
begin
GetPalette := 8C end;
/——_—————_———;
Procedure TMyHelpWindow.HandleEvent;
{Обрабатывает клавишу F5 для выдачи команды cmZoom (распахнуть окно)} begin
THelpWindow.HandleEvent(Event) ;
if Event.What=evKeyboard then if Event.KeyCode=kbF5 then begin
Message(@Self,evCommand,cmZoom,@Self) ;
ClearEvent(Event);
end end;
^————————————;
Procedure TVir.DoHelp;
{Осуществляет доступ к контекстно-зависимой справочной службе} •wax
С: Word;
HF: PHelpFile;
HS: PDosStream;
HW: PMyHelpWindow;
begin
{Открываем DOS-поток:} HS := New(PDosStream,Init(HelpFile, stOpenRead)) ;
{Создаем и инициируем экземпляр объекта THelpFile:} HF := New(PHelpFile, Init(HS)};
if HS^-Status-stOk then
begin
/Создаем окно справочной службы и связываем его с потоком HS и текущим контекстом: }
HW := New(PMyHeipWindow,Init(HF, GetHelpCtx)) ;
if ValidView(HW) <> NIL then begin
С :° ExecView(HW); (Выдаем справку} Dispose(HW) {Удаляем окно} end end exse begin
Dispose(HF, Done);
if MessageBox('Нет доступа к файлу '+
HelpFile, NIL,mfError+mfOKButton)=0 then;
end end; [DoHelp} ^————————.——.——;
Procedure DWT.HandleEvent(var Event: TEvent) ;
{Обработчик событий основного окна. Реализует нестандартные команды, а также обрабатывает клавиши Left и Right для смены активности кнопок} begin {DWT.HandleEvent}
TDialog.HandleEvent(Event) ;
case Event.What of
evCommand: {Обработка нестандартных команд} begin
case Event.Command of cmHelp: AntiV".DoHelp;
cmSet: AddFiles;
cmDel: DelFiles;
cmRun: begin
Stop := False;
TDialog.Done;
Event.Command := cmCancel;
Exit end;
cmFresh: FreshFiles;
else
Exit end;
ClearEvent(Event) end;
evKeyboard: (Клавиши Left-Right! begin
case Event.KeyCode of
kbLeft: SelectNext(True);
kbRight: SelectNext(False) ;
end;
ClearEvent(Event) end;
end end; {DWT.HandleEvent}
{
+————-——————————————-—+
I Обработка команды "Добавить файл" I
+--—------------_————---———————+
/ Procedure DWT.AddFiles;
{Обеспечивает выбор файлов из списка и помещает выбранные файлы в архив} vac
R,RR : TRect; {Координаты}
PathO: String; {Начальный каталог}
РН : PAddFileBox; {Окно выбора файлов}
ASB : PScrollBar; {Полоса скроллера}
Р : PView; (Вспомогательные элементы} const
с1 = 'Используйте клавиши курсора';
с11=- ' и Insert для выбора файла';
с2 = 'ESC - отказаться и выйти';
Wildcard: String" '*.*';
begin
GetDir(0,PathO); {PathO- каталог по умолчанию!
{Создаем диалоговое окно выбора файлов)
R.Assign(О,О,80,23) ;
PW := New (PAddFileBox, Init (R, "));
PW^.WildC := Wildcard;
{Вставляем поясняющий текст}
R.Assign(l,l,79,4);
W.Insert(New(PStaticText,Init(R,»3+cl+cll+#13#3+c2)) ) ;
R.Assign(l,4,79,5);
PW".PDir := New(PStaticText,Init(R,#3+'Каталог '+path0));
PH". Insert (PW.PDir) ;
{Вставляем строку выбора имени/маски}
R.Assign(25,7,52,8) ;
PW.PInL := New(PInpLine, Init(R,40));
with PW.PInL" do
State :- State or sfCursorVis;
PWЛ.PInLЛ.DataA :- Wildcard;
PW.Insert(PW.PInL);
R.Assign(25,6,52,"?) ••
Р :» New(PLabel,Init(R,'~M~ Маска файлов:',PW^.PInL));
РН^.Insert(Р) ;
R.Assign(52,7,54,8) ;
Р :-New(PHistory, Init(R,PHЛ.PInL,l)) ,• PW.Insert(P) ;
{Вставляем скроллер списка файлов} R.Assign(2,10,77,19);
RR.Assign(77,10,78,19);
ASB :- New(PScrollBar,Init(RR)) ;
PW.Insert(ASB) ;
New(PW^.PL,Init(R,4,ASB)) ;
PW.PL".GetDir(Wildcard) ;
PH".Insert(PW^.PL) ;
PW.PL^.MarkL := 15;
R.Assign(2,9,77,10) ;
P :- New(PLabel,Init(R,'~L~ Список файлов:',PW.PL));
PH".Insert(P) ;
{Вставляем кнопки! R.Assign (1,20,11,22) ;
PW^.Insert(New(PButton, Init(R,'~S~ Стоп',cmCancel,bfNormal))) ;
R.Assign (11,20,28,22) ;
PW.Insert(New(PButton, Init(R,'~A~ Выбрать все',cmAll,bfNormal)));
R.Assign (28,20,49,22) ;
PW.Insert(New(PButton, Init(R,'~D~ Сменить каталог',cmCD,bfNormal)));
R.Assign(49,20,63,22) ;
PW^.Insert(New(PButton, Init(R,'~R~ Добавить',cmRun,bfNormal))) ;
R.Assign(64,20,77,22) ;
PW.Insert(New(PButton, Init(R,'~E~ EXE/COM',cmEXE,bfMormal)));
PW^.HelpCtx := 2;
{Выполняем диалог)
DeskTop^.ExecView(PW)i
Dispose(PW,Done) ;
ChDir(pathO) /ВосстановДиваем текущий каталог} end {AddFlles}! ^————————————/
Procedure TAddFileBox.HandleEvent;
{Обработчик событий окна выбора файлов} vac
s: String;
PCD: PChDirDialog;
c: Word;
R: TRect;
p: Pointer;
label LI,All;
begin {TAddFileBox.HandleEvent] TDialog.HandleEvent(Event) ;
case Event.What of evCommand: case Event.Command of cmHelp: AntiV^.DoHelp;
cmExe: begin
if PInl^Data"-'*.СОМ' then
PInl^-Data^ :- '*.EXE else
Pin^-Data^ :° '*.COM';
PInl^.Draw;
goco LI end;
cmCDH: begin [Изменена маска выбора файлов)
LI:
S :~ Pinl." .Data"; (Новая маска} PL^biSt :- NIL;
{Удаляем коллекции} Dispose(PLЛ.PFL, Done);
WildC :- S;
{Создаем новую коллекцию} PL^GetDirO) end;
cmCD: begin {Сменить каталог}
{Выбираем новый диск/каталог:} NewlPCD, Init(0,0));
с := DeskTop^.ExecView(PCD);
GetDir(0,s);
{s - имя нового каталога.Удаляем старое юля из окна} Dispose(PDir,Done);
R.Assign(1,4,79,5);
{Сообщить новое имя} PDir := New(PStaticText,Init(R,*3+'Каталог '+s));
Insert(PDir) ;
Goto LI;
end;
cmAll: begin {Выбрать все файлы) All: PL^SetAll;
PL".Draw end;
cmRun: SetFiles; {Добавить файлы в архив} end;
evKeyDown: case Event.KeyCode of kbLeft: SelectNext(True) ;
kbRight: SelectNext(False) ;
kbGrayPlus: Goto All;
end; {case Event.KeyCode} end; /case Event.What} ClearEvent(Event) end; {TAddFi 1 aBox. Hand-1 eEven t} ^————————————;
Procedure TAddFileBox.SetFiles ;
{Помещает в архив выбранные файлы.} var
S,ss: String;
k: Integer;
R: TRect;
p: PWindow;
PS: PString;
begin
{Сообщаем о добавлении файлов:} R.Assign(15,10,65,13) ;
P := New(PWindow,Init(R,'Добавляется файл:',0));
DeskTop".Insert(P) ;
{Выбираем из коллекции меченые файлы:} with PL^PFL" do for k := 0 to pred(count) do begin
s := GetText(k,255);
if s[Length(s)] = #251 then
begin (Выбран очередной меченый файл DemarkF(s); {Удаляем метку} System.GetDir(0,ss);
if ss[Length(ss)] <> '\' then ss :•= ss+'\';
ss := ss+s; {Добавляем маршрут поиска) {Сообщать имя} R.Assign(l,l,48,2) ;
Р".Insert(New(PStaticText,Init(R,#3+ss))) ;
SetFile(ss); {Помещаем файл в архив} PS := At(k) ;
PS^ := s end end;
Dispose(P,Done);
PL^.Draw
end; f'rAcW.i.IeBox.Setfi.IesJ I— —————-.-__——_
Procedure TInpLine.HandleEvent;
{Обработчик событий строки ввода имени или маски выбора файлов: выдает команду cmCDW, если изменен статус ввода) begin
TInputLine.HandleEvent(Event) ;
if (Event.What = evKeyDown) and (Event.KeyCode ° kbEnter) then
Message(Owner,evBroadcast,cmCDW,@Self) end; {TInpLine.HandleEvent) _————————..————;
Procedure TFileListBox.SetAll;
{Дополняет признаком выбора имена всех файлов) var
S: String;
k: Integer;
begin
with PFL" do for k := 0 to pred(Count) do begin
s :« GetText(k,255) ;
if s[Length(s)] <> #251 then
MarkF(s) else
DemarkF(s) ;
AtFree(k) ;
Insert (NewStr (s) ) end
and; {TFileListBox.SetAll} ^-———————————;
Procedure TFileListBox.GetDir(WC: String);
{Формирует коллекцию из имен файлов текущего каталога) var
SR: SearchRec;
AllExe: Boolean;
label
Rep;
begin
AllExe := HC='*.*';
if AllExe then WC := '*.com1;
PFL := New(PStringCollection, Init(10,5)) ;
Rep:
FindFirst(WC,$27,SR) ;
while DOSError a" 0 do begin
if (SR.Nameo'.') and (SR.NameO'. . ') then PFL".Insert(NewStrfSR.Name)) ;
FindNext(SR) end;
if AllExe then begin
AllExe := False;
WC := '*.EXE' ;
goto Rep end;
Self.NewList(PFL) end;
^————————————;
procedure TFileListBox.HandleEvent;
{Обработчик событий окна выбора файлов: использует клавишу Insert для пометки файла} var
S: String;
begin
TListBox.HandleEvent(Event);
if (Event.What = evKeyDown) then case Event.KeyCode of
Itblns: begin {Нажата клавиша Insert) ^ S := GetText(Focused,255); {Получаем выбор} PFL^.AtFree(Focused) ; {Удаляем файлиз коллекции} if S[Length(s)] =#251 then
DemarkF(s) {Убираем пометку} else
MarkF(s); {Добавляем пометку} PFL".Insert(NewStr(S)); {Вставляема колл} Event.KeyCode := kbDown; {Имитируем сдвиг} Draw; {указателя вниз} TListBox.HandleEvent(Event) ;
end;
koGrayPlus: {Серый "+" как "Выбрать все"]
Message(@Self,evCommand,cmAll,@Self) end
end; {TFileListBox.HandleEnent} ^____———_—————^
Procedure TFileListBox.MarkFfvar s: String);
{Помещает в строку S маркер выбора} begin
while Length(s)<MarkL do s : = s+' ';
s :" s+#251 end;
____———————.——;
Procedure TFileListBox.DeraarkF(var s: String);
{Удаляет маркер выбора из строки S} begin
while (s[Length(s)]=#251) or (s[Length(s)]=• •) do
System.Delete(s,Length(s),1) end;
{
+—_-----—-----------—----—-—----+
¦ Обработка команды "Удалить файл" \
+—————————————————————.——+
;
Procedure DelFile(ss: String);
{Удаляет файл с именем SS из архива) var
n : Integer;
ch: ^heckType;
begin
{Ищем нужный файл в архиве:}
n := 0;
repeat
ch := FColJ^.Attn) ;
inc(n)
until (ch''.Name=ss) ;
dec (n) ;
{Удаляем запись}
FCol:!^ .AtDelete (n);
FChange :v True end; {DelFile} _•————————————;
Procedure DWT.DelFiles;
{Удаляет файлы из архива} var
R: TRect;
PD: PDelFileBox;
ASB: PScrollBar;
k: Integer;
ch: '^CheckType;
const
cl = 'Используйте клавиши курсора';
ell- ' и Insert для выбора файла';
с2 = 'ESC - отказаться и выйти";
begin
(Формируем окно}
R.Assign(О,О,80,23);
PD := New(PDelFileBox, Init(R,''));
{Вставляем скроллер архивных файлов}
R.Assign(77,5,78,19);
ASB :-New(PScrollBar, Init<R»;
PD".Insert(ASB) ;
R.Assign(2,5,77,19);
PD^.PL := NewfPFileListBox, Init(R,2,ASB));
PD".Insert(PD^.PL) ;
PD^.PL^MarkL := 34;
R.Assignd, 1,79,3) ;
PD^.Insert(New(PStaticText,Init(R,#3+cl+cll+#13»3+c2))) ;
R.Assign(2,4,77,5) ;
VQ".Insert(New(PLabel, Init(R,'-L~ Список архивных файлов:',PD".PL)));
{Вставляем кнопки}
R.Assign(1,20,15,22);
PD". Insert (New (PButton, Init(R,'~S~ Стоп', cmCancel,bfNonn9l)));
R.Assign(16,20,35,22);
PD".Insert(New(PButton, Init(R,'~A~ Выбрать все',cmAll,bfHormal))) ;
R.Assign(36,20,50,22) ;
PD^.Insert(New(PButton, Init(R,'~R~ Удалить',cmRun,bfNormal)));
{Создаем коллекцию имен файлов } PD^.PL^PFL := New(PStringCollection,Ir»it(10,5) ) ;
for It := 0 to predtFColT^ Count) do with PDA.PL'^.PFLЛ do begin
ch := FColl*.At(k);
Insert(NewStr(ch*.Name))
end;
PD^.PL".NewList(PD'.PL^.PFL) ;
PD^.HelpCtx := 3;
{Выполняем}
DeskTop".ExecView(PD) ;
Dispose(PD,Done) end; {DelFilesf /——————————————;
Procedure TDelFileBox.HandleEvent;
iОбработчик событий окна удаления файла(ов)} var
R: TRect;
k: Integer;
s: String;
p: PWindow;
begin
TDialog.HandleEvent(Event) ;
case Event.What of evConmiand: case Event. Command of cmHelp: AntiV'.DoHelp;
cmAll: begin
PL^SetAll;
PL*.Draw;
ClearEvent(Event) end;
cmRun:
begin
R.Assign(15,10,65,13) ;
P :- New(PWindow,Init(R,'Удаляется файл:',0));
DeskTop^.Insert(P);
with PL'-,PFLA do for k := 0 to pred(count) do begin
s := GetText(k,255);
if s[Length(s)] - #251 then
begin (Только для помеченных файлов} {Удаляем радикал и пробелы в имен^ while (s[Length(s)]=»251) or
(s[Length(s) ]"' ') do System.Delete(s,Length(s),1) ;
(Сообщаем имя удаляемого файла} R.Assign(1,1,48,2) ;
PA.Insert(New(PStaticText,Init(R,#3+s))) ;
DelFile(s) fУдаляем из архива} end end;
Dispose(P,Done);
EndModal(cmCancel) end {cmR.un} end; {case Event.Command} evKeyDown: case Event.KeyCode of kbLeft : SelectNext(True) ;
kbRight: SelectNext(False) end {case Event.KeyCode} end; {case Event.What} ClearEvent(Event) end; {TDelf'ileBox.HandleEvent}
{
^.__—-----———--—----——————---——-+
¦ Обработка команды "Обновить информацию" I
+_-----------------—---_-__------_-------+
/ Procedure DWT.FreshFiles;
{Обновляет информацию в архиве} var
disk: Byte;
k: Integer;
R: TRect,-p: PWindow;
ch: "CheckType;
DI: Dir_Type;
FF: file;
sz,nz: Word;
label NotAcc;
begin
R.Assign(15,10,65,13)? P := New(PWindow,Init(R,'Переустанавливается файл:',0));
DeskTop^.Insert(P);
k := 0;
while k<VColl^.Count do begin
ch := FColl^.Atfk);
with ch" do begin
R.Assign(l,l,48,2) ;
(Выводим имя файла! Р".Insert(New(PStaticText,Init(R,#3+Name))) ;
Assign(FF,Name);
{$!-} Reset (FF,1);
{$!+} if IQResult <> 0 then {Ошибка доступа - удаляем файл из архива)
begin NotAcc; if MessageBoxt
'Нет доступа к файлу '+Ыаше+#13'Убрать контроль за файлом?', NXL,
mfYesButton+mfNoButton)«cmYes then begin
FColl*.AtDelete(I<) ;
FChange := True end end
else {Нормальное открытие файла! begin
sz := 512;
if sz > FileSize(FF) than sz := FileSize(FF);
FillChar(SecO,512,0);
BlockRead(FF,SecO,sz,nz);
if sz=nz then begin
SizO :- FileSize(FF);
FChange := True end else (Файл не читается)
MessageBox('Ошибка доступа к файлу 4-Name, NIL,0);
System.Close(FF)
end
end; {with chл} inc(k)
end; {while k<FColl".Count) Dispose(P,Done) end; {FreshFiles} I +-—•--------------------------+
I Основная программа AntiVir ¦ +----—----——----------------+
;
var
k: Word;
ch^CheclcType;
begin {AntiVirl
{Проверяем параметры обращения) if not Auto then
Dialog {Диалог с пользователем} else
Stop := False; {He было диалога} if not Stop then
Check; {Контролируем файлы} {Если коллекция изменялась, переписываем еев архивный файл} if FChanga then begin
Seek(F,BegDat) ;
for k := 0 to precKFCol^ .Count) do begin
ch := FColl^Attk) ;
Write(F,ch^) end;
Truncate(F) end;
Close (F) {Закрываем DAT-файл} end. {AntiVir}
П9.2. Программа восстановления структуры ЖД Set$v$.pas
Эта программа восстанавливает структуру ЖД (главный загрузчик и описатели разделов), предварительно спасенную программой AntiVir. t
Uses F Anti,F_Disk;
type
(Описатель раздела ЖД} Part_Type = record
BootF: Byte; {Флаг активности раздела}
BegHd: Byte; {Головка для начала раздела}
BegSC: Word; {сектор/цилиндр}
Sys : Byte; {Код системы}
EndHd: Byte; {Головка для конца раздела/
EndSC: Word; {сектор/цилиндр}
Sees : Longint; {Относительный номерначального сектора}
Size : Longint; {Длина раздела в секторах} end; {Part_Type}
{Структура загрузочного сектора} BootSecType = record
a: array [0..$1BD] of Byte;
Part: array [1..4] of Part_Type;
b: array [1..2] of Byte end;
Описание структуры ЖД в резервном файле} TStruc = record BHd: Byte;
BSC: Word;
Sec: BootSecType end;
const
tx: array [ 1..5] of String»(
'Эта программа предназначена для восстановления структуры жесткого диска, ',
'испорченной в результате работы программы ANTIVIR', 'и сохраненной в файле VIRDAT.$V$',
'Используйте вызов с указанием маршрута поиска файла VIRDAT.$V$, например' ,
' SET$V$ A:\') ;
var
Name: String;
F: File of TStruc;
LD: array [1..48] of TStruc;
k: Byte;
Err: Boolean;
Count: Byte;
begin
if ParamCountOl then begin
for k := 1 to 5 do WriteLn(tx[k]) ;
Halt end;
Name := ParamStr(l);
for k :•== 1 to Length (Name) do Namefk] := UpCase(Name[k]) ;
k := Pos('VIRDAT',Name);
if k<>0 then
Delete(Name,k,Length(Name)-k) ;
if Name[Length(Name)]о'\' then Name :=> Name+'\';
Name :" Name+'VIRDAT.$V$';
{$!-} Assign(F,Name) ;
Reset(F) ;
l$I+{ if IQResultOO then begin
WriteLn('Нельзя открыть файл ',Name);
Halt;
end;
Count := 0;
Err := False;
while -Ot (Err or EOF(F» do begin
inc(Count) ;
{$!-} Read(F,LD[Count]) ;
{$!+} Err := lOResultOO end;
Close(F) ;
if odd(k) or Err then
begin
WriteLn('Ошибка в данных файла '+ Name);
Halt end;
for k := 1 to Count do with LD[k] do begin
SetAbsSector($8O,BHd,BSC,Sec) ;
if Disk_Error then begin
WriteLn('Ошибка записи на жесткий диск['If-Halt end end;
{Сообщаем об окончании} Write ('Структура ЖД восстановлена. Перезагружать ДОС (Y/N, Enter'«Y) ? ');
ReadLn(Name) ;
if (NameO'n') or (NameO'N') then asm
mov ax,$FOOO {Сегмент перезапуска) push ax {Помещаем его в стек} mov ax,$FFFO {Смещение} push ax {Помещаем в стек} retf {Перезапуск ДОС} end end.
