_|_| _|_|         _|  _|    _|_|_|
_|     _|  _|     _|_|_|_|_|  _|  _|
_| ODE _|_|         _|  _|      _|  
_|     _| IMPS    _|_|_|_|_|  _|    
    _|_| _|           _|  _|    _|_|_|  

{$I-} {все I/O ошибки будем обрабатывать сами}
program patcher;
uses ifaces,ptchtype,crt,dos;

const SelectStr='          ';{}
      Ver='0.5';{}

var PBaseInfo:^TBaseInfo;{мы будем использовать динамическое распределение памяти}
    PPatchList:^TList; {поэтому будем использовать указатели}
    sz,sel_pos,top_pos:integer;
    Rec:TRecord;

procedure UpCaseStr(var instr:string); {процедура переводит строку в ВЕРХНИЙ регистр}
var i:integer;
begin
for i:=1 to length(instr) do instr[i]:=UpCase(instr[i]); {по большому счету string = array[1..length] of char}
end;

procedure CopyFile(FileName,NewFileName:string); {процедура копирует файл}
var bin1,bin2:file of byte;
    b:byte;
begin
assign(bin1,FileName);
reset(bin1);
assign(bin2,NewFileName);
rewrite(bin2);
while not eof(bin1) do
begin
read(bin1,b);
write(bin2,b);
end;
close(bin1);
close(bin2);
end;

procedure EnterPath(var target_f:string); {процедура ввода пути к изменяемому файлу}
var ch:char;
    dignum:byte;
begin
{устанавливаем цвета}
TextColor(White);
TextBackground(Black);
{рисуем симпатичное окошечко}
GotoXY(2,10); {все последующее было сделане в псевдографике - Винда не держит такое добро :((( }
write('_______________________________________ ________________________________________');
GotoXY(1,11);
write('+-Enter the patch of directory with a program---------------------------------+_');
GotoXY(1,12);
write('¦ Enter path:                                                                 ¦_');
GotoXY(1,13);
write('+-------------------------------------Press <ENTER>---------------------------+');

dignum:=1; {номер вводимой буквы}
target_f:='';


ch:=' ';

{собственно сам цикл ввода имени файла - до нажатия Enter}
while ch<>#13 do
begin
ch:=readkey;
if (ch<>#8) and (ch<>#27) and (ch<>#13) then
begin
{ограничение на путь: 60 символов}
 if dignum<=59 then target_f:=target_f+ch;
 dignum:=dignum+1;
 if dignum>60 then dignum:=60;
 GotoXY(15,12);
 write(target_f);
end;

{если ввели неправильную букву, то при нажатии
Backspace убираем последнюю букву}
if ch=#8 then
 begin
 if dignum>1 then dignum:=dignum-1;
 target_f:=copy(target_f,1,length(target_f)-1);
 GotoXY(15,12);
 write('                                                                ');
 GotoXY(15,12);
 write(target_f);
 end;
end;
end;

procedure WriteItems(var list:TList; top_el,sel_el:integer); {выводим инфу а-ля Нортон Коммандер}
var i,j:integer;
begin
TextColor(LightCyan);
TextBackground(Blue);
GotoXY(2,3);
Write('  ');
GotoXY(56,23);
Write('  ');
TextColor(Yellow);
TextBackground(Blue);
if top_el>2 then
 begin
 GotoXY(2,3);
 Write('<<'); {показываем, что до этого тоже что-то есть...}
 end;
if top_el<sz-83 then
 begin
 GotoXY(56,23);
 Write('>>'); {...и после - тоже}
 end;
{вся байда с выделенным элементом}
TextColor(LightCyan);
TextBackground(Blue);
for j:=1 to 4  do
for i:=1 to 21 do
begin
GotoXY((j-1)*10+4*j,i+2);
write(list[top_el+(j-1)*21+i-1] + copy(SelectStr,1,10-length(list[top_el+(j-1)*21+i-1])));
end;
TextColor(Blue);
TextBackGround(LightCyan);
i:=((sel_el-top_el)  mod 21);
j:=((sel_el-top_el)  div 21);
GotoXY(j*14+4,i+3);
write(list[sel_el] + copy(SelectStr,1,10-length(list[sel_el])));
TextColor(LightCyan);
TextBackground(Blue);
end;


procedure writeinfo(var xBaseInfo:TBaseInfo; var xCurrentRec:TPatchRec); {инфа о выделенном патче}
var Pos0:integer;
begin
TextColor(LightCyan);
GotoXY(65,1);
Pos0:=Pos(#0,xBaseInfo.BaseName);
write(copy(xBaseInfo.BaseName,1,Pos0-1));
GotoXY(61,2);
Write(      xBaseInfo.BaseDate.Day,
      '.',  xBaseInfo.BaseDate.Month,
      '.',  xBaseInfo.BaseDate.Year,
      ' ',  xBaseInfo.BaseDate.Hour,
      ':',  xBaseInfo.BaseDate.Min);
GotoXY(61,3);
Write('Patches: ',xBaseInfo.PatchCount);
GotoXY(59,4);
Write('¦--------------------¦');

GotoXY(61,6);
Write('Patch to:');
GotoXY(60,7);
Write('                    ');
GotoXY(60,7);
Write(xCurrentRec.AppName);

GotoXY(61,8);
Write('Soft author:');
GotoXY(60,9);
Write('                    ');
GotoXY(60,9);
Write(xCurrentRec.AppAuthor);

GotoXY(61,10);
Write('File to patch:');
GotoXY(60,11);
Write('                    ');
GotoXY(60,11);
Write(xCurrentRec.FileName);

GotoXY(61,12);
Write('Patch Type:');
GotoXY(60,13);
Write('                    ');
GotoXY(60,13);
Write(xCurrentRec.PatchType);

GotoXY(61,14);
Write('Patch Author:');
GotoXY(60,15);
Write('                    ');
GotoXY(60,15);
Write(xCurrentRec.PatchAuthor);

GotoXY(60,18);
Write('                    ');
GotoXY(60,18);
Write('KeyFileLen=',xCurrentRec.KeyFileLen);
GotoXY(59,19);
Write('¦--------------------¦');
GotoXY(61,20);
Write('Base Author:');
GotoXY(60,21);
Write(xBaseInfo.BaseAuthor);
GotoXY(61,22);
Write('Comments:');
GotoXY(60,23);
Write(xBaseInfo.BaseComment);
end;

{собственно, процедурка патчинья}
procedure PatchNow(var sel_rec:TPatchRec);
var TargetFile,FName,DFName:string;
    FileToPatch,DestFile:file of byte;
    i,ErrCode,PatchNum:integer;
    ch:char;
    b:byte;
    AreWereErrors:boolean;
    Pos0:integer;
begin
AreWereErrors:=false;
PatchNum:=1;
EnterPath(TargetFile);

if copy(TargetFile,length(TargetFile),1)<>'\' then TargetFile:=TargetFile+'\';

FName:=Rec.BasePatch.FileName;
UpCaseStr(FName);

Pos0:=pos(#0,FName);
FName:=copy(FName,1,Pos0-1);
TargetFile:=TargetFile+FName;
assign(FileToPatch,TargetFile);

UpCaseStr(TargetFile);

{это одно из выводимых сообщений}
Msg(msg_patching);
{для разных типов патча - подход разный}
if COPY(Rec.BasePatch.PatchType,1,7)='KeyFile' then
begin
{/KeyFile/}
rewrite(FileToPatch);
if IOResult<>0 then AreWereErrors:=true;
for i:=1 to Rec.BasePatch.KeyFileLen do write(FileToPatch,Rec.BasePatch.PatchBytes[i].Dstn_byte);
close(FileToPatch);
if AreWereErrors then Msg(msg_unsucc_patch) else Msg(msg_succ_patch);
ch:=readkey;
{/end KeyFile/}
end else
begin
{/another type of patch/}
CopyFile(TargetFile,copy(TargetFile,1,length(TargetFile)-3)+'old');
reset(FileToPatch);
for i:=1 to 2048 do
 begin
 if Rec.BasePatch.PatchBytes[i].addr<>0 then
         begin
         seek(FileToPatch,Rec.BasePatch.PatchBytes[i].addr);
         read(FileToPatch,b);
         if b<>Rec.BasePatch.PatchBytes[i].Src_byte then begin
                                                         Msg(msg_unexp_byte);
                                                         ch:=readkey;
                                                         AreWereErrors:=true;
                                                         end;
         seek(FileToPatch,Rec.BasePatch.PatchBytes[i].addr);
         write(FileToPatch,Rec.BasePatch.PatchBytes[i].Dstn_byte);
         end;
 end;
close(FileToPatch);
if AreWereErrors then Msg(msg_unsucc_patch) else Msg(msg_succ_patch);
ch:=readkey;
{/end another type of patch/}
end;

{перерисовываем экран}
DrawScreen('Patcher v.'+Ver);
writeitems(PPatchList^,top_pos,sel_pos);
writeinfo(PBaseInfo^,Rec.BasePatch);

end;

{стартовая процедура}
procedure monitor;
var Base:file of TRecord;
    i:integer;
    ch:char;
    num:string;
begin
for i:=1 to 500 do PPatchList^[i]:=SelectStr;
{откроем базу}
assign(Base,'base.p01');
reset(Base);
if IOResult=2 then
begin
GotoXY(2,2);
Writeln(' ERROR: file base.p01 not found');
halt;
end;


sz:=filesize(Base);
read(Base,Rec);
PBaseInfo^:=Rec.BaseInfo;
DrawScreen('Patcher v.'+Ver);

for i:=2 to sz do
begin
read(Base,Rec);
if Rec.RecType=p_base_patch then PPatchList^[i]:=Rec.BasePatch.AppName;
end;
seek(Base,1);
Read(Base,Rec);
DrawScreen('Patcher v.'+Ver);
WriteInfo(PBaseInfo^,Rec.BasePatch);

ch:=' ';
sel_pos:=2;
top_pos:=2;

{пытаемся узнать желание пользователя по нажатой клавише}
while ch<>#27 do
begin
WriteItems(PPatchList^,top_pos,sel_pos);
WriteInfo(PBaseInfo^,Rec.BasePatch);
ch:=readkey;
case ch of
#75{L}: sel_pos:=sel_pos-21;
#77{R}: sel_pos:=sel_pos+21;
#80{D}: sel_pos:=sel_pos+1;
#72{U}: sel_pos:=sel_pos-1;
#13{E}: begin
        Seek(Base,sel_pos-1);
        read(Base,Rec);
        PatchNow(Rec.BasePatch);
        end;
end;
if sel_pos>top_pos+83 then top_pos:=top_pos+84;
if sel_pos<top_pos    then top_pos:=top_pos-84;
if sel_pos<2          then sel_pos:=2;
if sel_pos>sz         then sel_pos:=sz;
if top_pos<2          then top_pos:=2;
if sz>83 then if top_pos>sz-83 then top_pos:=sz-83;

Seek(Base,sel_pos-1);
read(Base,Rec);
end;
close(Base);
end;

begin
{нам нужны кое-какие переменные в памяти}
new(PBaseInfo);
new(PPatchList);
clrscr;
monitor;
{а теперь - нет}
dispose(PBaseInfo);
dispose(PPatchList);
end.
{$I+}

unit ifaces;
interface
uses crt;
type TList=array [1..5000] of string[10];

const msg_patching=1;
      msg_succ_patch=2;
      msg_unsucc_patch=3;
      msg_unexp_byte=4;
      msg_cant_rename=5;
      msg_anoth_file=6;
      msg_io_error=7;
      SelectStr='          ';

procedure Msg(num:integer);
procedure DrawScreen(ver:string);


implementation
procedure Msg(num:integer);
begin
case num of
1: begin
   TextColor(White);
   TextBackground(Blue);
   GotoXY(25,9);
   Write('+-----------------------------------+');
   GotoXY(25,10);
   Write('¦ Patching. Please wait...          ¦');
   GotoXY(25,11);
   Write('+-----------------------------------+')
   end;
2: begin
   TextColor(White);
   TextBackground(Green);
   GotoXY(25,9);
   Write('+-----------------------------------+');
   GotoXY(25,10);
   Write('¦ File was successfully patched     ¦');
   GotoXY(25,11);
   Write('+----------------------Press any key+');
   end;
3: begin
   TextColor(Yellow);
   TextBackground(Red);
   GotoXY(25,9);
   Write('+-----------------------------------+');
   GotoXY(25,10);
   Write('¦ File was unsuccessfully patched   ¦');
   GotoXY(25,11);
   Write('+----------------------Press any key+');
   end;
4: begin
   TextColor(Yellow);
   TextBackground(Red);
   GotoXY(25,12);
   Write('+-----------------------------------+');
   GotoXY(25,13);
   Write('¦ Error! Unexpected source byte     ¦');
   GotoXY(25,14);
   Write('+-----------------------------------+');
   end;
5: begin
   TextColor(Yellow);
   TextBackground(Red);
   GotoXY(25,12);
   Write('+-----------------------------------+');
   GotoXY(25,13);
   Write('¦ Error! Can''t rename files         ¦');
   GotoXY(25,14);
   Write('+----------------------Press any key+');
   end;
6: begin
   TextColor(Yellow);
   TextBackground(Red);
   GotoXY(25,9);
   Write('+-----------------------------------+');
   GotoXY(25,10);
   Write('¦ Error! You typed another filename ¦');
   GotoXY(25,11);
   Write('+----------------------Press any key+');
   end;
7: begin
   TextColor(Yellow);
   TextBackground(Red);
   GotoXY(25,9);
   Write('+-----------------------------------+');
   GotoXY(25,10);
   Write('¦ Error! I/O error                  ¦');
   GotoXY(25,11);
   Write('+----------------------Press any key+');
   end;
end;
end;

procedure DrawScreen(ver:string);
var i:integer;
begin
textcolor(LightCyan);
textbackground(Blue);
clrscr;
GotoXY(1,1);
write('+----------------------------------------- -------------------------------------+');
GotoXY(3,1);
write(ver);
GotoXY(1,2);
for i:=1 to 22 do
write('¦                                                         ¦                    ¦');
write('+-(c) Egyptian Vulture 2002-2003----------- ------------------------------------+');
end;

begin
end.

unit ptchtype;

interface
uses dos;

{первая запись базы - заголовок, остальные - патчи}
const p_base_header = 1;
      p_base_patch  = 2;

type TBaseInfo  = record
     BaseName   :array [1..20] of char;
     BaseDate   :datetime;
     PatchCount :integer;
     BaseAuthor :array [1..20] of char;
     BaseComment:array [1..20] of char;
end;

type TPatchByte = record
      Addr     :longint;
      Src_byte :byte;
      Dstn_byte:byte;
end;

type TPatchRec = record
      AppName    :array [1..20] of char;
      FileName   :array [1..20] of char;
      AppAuthor  :array [1..20] of char;
      PatchType  :array [1..20] of char;
      KeyFileLen :word;
      PatchAuthor:array [1..20] of char;
      PatchBytes :array [1..2048] of TPatchByte;
end;

type TRecord  = record
      case RecType:word of
       p_base_header:(BaseInfo:TBaseInfo);
       p_base_patch :(BasePatch:TPatchRec);
end;


type TList=array [1..5000] of string[10];


type TPatch = object
      PatchRecord:TRecord;
      function GetRecordType:word;
      function GetBaseHeader(var BaseInfo:TBaseInfo):boolean;
      function GetBaseItem(var PatchRec:TPatchRec):boolean;
      procedure LoadBaseEntry(BaseEntry:TRecord);
end;

implementation

function TPatch.GetRecordType:word;
       begin
       GetRecordType:=PatchRecord.RecType;
       end;
function TPatch.GetBaseHeader(var BaseInfo:TBaseInfo):boolean;
       begin
       GetBaseHeader:=false;
       if PatchRecord.RecType=p_base_header then
        begin
        BaseInfo:=PatchRecord.BaseInfo;
        GetBaseHeader:=true;
        end;
       end;
function TPatch.GetBaseItem(var PatchRec:TPatchRec):boolean;
       begin
       GetBaseItem:=false;
       if PatchRecord.RecType=p_base_patch then
        begin
        PatchRec:=PatchRecord.BasePatch;
        end;
       end;
procedure TPatch.LoadBaseEntry(BaseEntry:TRecord);
       begin
       PatchRecord:=BaseEntry;
       end;


begin
end.