program UD3_patcher;

uses
  Forms, Dialogs, Classes, SysUtils,
  UBaze in 'UBaze.pas';

const
   ErrMsg: array[1..5] of string = (
   {1}     'Syntax:'#10+
           '  UD3_Patcher { /F<Filename> [/S] [/O<Offset>] <Source> }'#10+
           '  UD3_Patcher [/S] <Filename> [/O<Offset>] <Source>'#10#10+
           '  - <Filename>:  File in which to performe the replacement'#10+
           '  - <Offset>:  <DecNr> | $<HexNr> | 0<OctNr>'#10+
           '  - <Source>:  <String> | $<HexString> | @<Filename>',
   {2}     'Wrong source specified!',
   {3}     'Wrong file specified!',
   {4}     'Couldn''t write to file!',
   {5}     'Offset bigger then file size!');

var
   sfn, dfn: string;
   buf: PChar;
   bufsize: longint;
   ofs: longword;
   err_code: byte;
   err_msg : string;
   silent: boolean;
   i, j: integer;

{$R *.res}

function ralloc(var p: PChar; n: integer=0): PChar;
begin
  if (n=0)and(p<>nil) then begin FreeMem(p); p := nil; end else
  if p <> nil then ReAllocMem(p, n+1)
              else p := PChar(AllocMem(n+1));
  result := p;
end;

function getfilebuf(fn: string; ofs: integer=0): PChar;
var iFileHandle, iFileLength: integer;
begin
    ralloc(buf);
    Result := nil;
    if(not FileExists(fn)) then exit;
    try
      iFileHandle := FileOpen(fn, fmOpenRead);
      iFileLength := FileSeek(iFileHandle,ofs,2);
      FileSeek(iFileHandle,ofs,0);
      ralloc(buf, iFileLength);
      bufsize := FileRead(iFileHandle, buf^, iFileLength);
      Result := buf;
    finally
      FileClose(iFileHandle);
    end;
end;

function repfilebuf(fn: string;var ofs: longword; b: PChar; l: integer): byte;
var iFH, iFL: integer;
begin
    Result := 2;
    if b = nil then exit;
    err_msg := fn;
    Result := 3;
    if(not FileExists(fn)) then exit;
    Result := 4;
    try
      iFH := FileOpen(fn, fmOpenWrite or fmShareDenyNone);
      iFL := FileSeek(iFH,0,2);
      err_msg := IntToStr(ofs);

      if ofs > iFL then begin Result:=5; exit; end;
      FileSeek(iFH,ofs,0);
      iFL := FileWrite(iFH, b^, l);
      if (iFL = -1) then exit;
      inc(ofs, iFL);
    finally
      Result := 0;
      err_msg := '';
      FileClose(iFH);
    end;
end;

function fillbuf(src: string): integer;
begin
 Result := 0;
 if src = '' then exit;
 case src[1] of
   '@':begin
         src := copy(src, 2, length(src)-1);
         if(getfilebuf(src)=nil) then exit;
       end;
   '$':begin
         bufsize := length(src);
         src := copy(src, 2, bufsize-1);
         bufsize := bufsize div 2;
         ralloc(buf, bufsize);
         bufsize := HexToBin(PChar(LowerCase(src)), buf, bufsize);
       end;
   else begin
         bufsize := length(src);
         ralloc(buf, bufsize);
         StrCopy(buf, PChar(src));
        end;
   end;
   Result := bufsize;
end;

function Error_Msg(ec: byte; add: string=''): string;
begin
  if ec = 0 then exit;
  result := ErrMsg[ec];
  if not silent then ShowMessage(result + #10 + add);
  err_code := ec;
end;

procedure halt_(c: integer);
begin
  if (err_code>1)or(buf=nil) then Error_Msg(1);
  ralloc(buf);
  halt(c);
end;

function getnr(s: string): longword;
begin
  result := 0;
  case s[1] of
    '$': result := valoare(copy(s, 2, length(s)), 16);
    '0': result := valoare(copy(s, 2, length(s)), 8);
    else result := valoare(s, 10);
  end;
end;

function do_rep(d, s: string;var o: longword): byte;
begin
   err_msg := s;
   if fillbuf(s) = 0    then result := 2 else
   result := repfilebuf(d, o, buf, bufsize);
   if result <> 0 then Error_Msg(result, err_msg);
end;

function options(pn: integer): integer;
var c: char;
    s: string;
begin
  result := pn;
  if pn > ParamCount then exit;
  s := ParamStr(pn);
  if s[1] ='/' then begin
    inc(result);
    c := upcase(s[2]);
    s := copy(s, 3, length(s)-2);
    case c of
      'S': silent := (s='+')or(s='');
      'F': dfn := s;
      'O': ofs := getnr(s);
      else
    end;
  end;
end;

BEGIN
 silent := false;
 buf := nil;
 ofs := 0;
 dfn := '';
 err_msg := '';
 err_code := 0;

 i := 1;
 If ParamCount>0 then while i <= ParamCount do
 begin
   j := i;
   i := options(i);
   if j <> i then continue;
   if dfn = '' then dfn := ParamStr(i) else
   begin
     sfn := ParamStr(i);
     do_rep(dfn, sfn, ofs);
   end;
   inc(i);
 end else ;
 halt_(0);

  {Application.Initialize;  Application.Run;}
END.