program DEMIME ;
{ www.merlyn.demon.co.uk, V0.88, compiled BP7.01.
  For decoding MIME : text/plain ? - or whatever it's called.
  Did NOT handle uncoded = in header lines!  charset=iso-8859-1.
  Output linelength limit removed 2002-01-22.
  Last parameter * now attempted; it copies a header first.
  Moderately tested.  This can be a TP7/BP7 Tool ;  Quid : 'œ'.
  Input/output filing from TOOL.PAS, after Mark Horridge. }
{$IFNDEF MSDOS} Fail! {$ENDIF}

  uses Dos {, Crt} ;

var Con : text ;

procedure HELP ;
begin
  Writeln(Con) ;
  Writeln(Con, ' [InFile [OutFile]] [*]') ;
  Writeln(Con, ' * indicates copy-to-blank-line (for headers)') ;
  Writeln(Con, ' ParamCount :  0: filter ; 1: editor ; 2: copier') ;
  Writeln(Con, ' Remove ''=''^M^J, decode ''=<hex><hex>'' to #$<hex><hex>') ;
  Writeln(Con, ' See also DEMIME.PAS source including comment.') ;
  HALT end {HELP} ;

procedure FAIL ; forward ;

function DeHex(C : char) : byte ;
var B : byte ;
begin
  B := Pos(C+'', '0123456789ABCDEF') ;
  if B=0 then FAIL ;
  DeHex := Pred(B) end {DeHex} ;

function Value(const S : string ; var By : byte) : char ;
begin
  if (By=$FF) or (By+1>=Length(S)) then FAIL ;
  if S[By+1]='"' then begin Value := '"' ; Inc(By) end else begin
    Value := char( ( DeHex(S[By+1]) shl 4 ) + DeHex(S[By+2]) ) ;
    Inc(By, 2) end ;
  end {Value} ;


var InFile, OutFile : text ;
PC : word ; Head : boolean ; J : byte ; InStr : string ;


procedure FAIL ;
begin Writeln(Con, ^G' Error in following line :'^M^J, InStr, ^M^J, '^':J,
    ^M^J' DEMIME Quit.'^G) ;
  if PC>0 then Erase(OutFile) ;
  HALT(1) end {FAIL} ;


procedure ProcessFiles ;
var OuStr : string ; NEq : boolean ; Ch : char ;
begin
  if Head then while not EoF(InFile) do begin
    Readln(InFile, InStr) ; Writeln(OutFile, InStr) ;
    if Instr='' then BREAK ;
    end { Copy header up to first blank line } ;

  OuStr := '' ; NEq := true ;

  while not EoF(InFile) do begin
    Readln(InFile, InStr) ; J := 0 ;

    while J<Length(InStr) do begin
      Inc(J) ; Ch := InStr[J] ; NEq := Ch <> '=' ;

      case NEq of
        true  : OuStr := OuStr + Ch ;
        false : case J = Length(InStr) of
          true  : begin Readln(InFile, InStr) ; J := 0 end ;
          false : begin NEq := true ;
            OuStr := OuStr + Value(InStr, J) end ;
          end {case J =} ;
        end {case NEq} ;

      if Length(OuStr)>250 then begin
        Write(OutFile, OuStr) ; Oustr := '' end ;

      end {<} ;

    if NEq then begin Writeln(OutFile, OuStr) ; OuStr := '' end ;
    end {not EoF} ;

  if OuStr<>'' then Writeln(OutFile, OuStr) ;
  end {ProcessFiles} ;


const
Sp = #32 ;
InFileName : PathStr = '' ;
OutFileName : PathStr = '' ;

procedure BackUp(const BFN : PathStr) ;
var BakFile : text ;
begin
  Assign(BakFile, BFN) ; {$I-} Reset(BakFile) {$I+} ;
  if IOresult=0 then begin Close(BakFile) ; Erase(BakFile) ;
    Writeln(Con, Sp, BFN, ' deleted') end ;
  Rename(InFile, BFN) ;
  Writeln(Con, Sp, InFileName, ' renamed to ', BFN) ;
  Rename(OutFile, InFileName) ;
  Writeln(Con, Sp, OutFileName, ' renamed to ', InFileName) ;
  end {BackUp} ;


var
InBuf, OutBuf : array [0..$3FFF] of byte ;
BakFileName : PathStr ; DS : DirStr ; NS : NameStr ; ES : ExtStr ;


BEGIN ;
Assign(Con, 'CON') ; Rewrite(Con) ;
Write(Con, 'DEMIME (www.merlyn.demon.co.uk >= 2002-01-24 ') ;
if ParamStr(1)='/?' then HELP ;
Writeln(Con, ParamStr(1), Sp, ParamStr(2), Sp, ParamStr(3)) ;

PC := ParamCount ;

Head := ParamStr(PC) = '*' ;
if Head then Dec(PC) ;

if PC>0 then begin
  InFileName := ParamStr(1) ;
  if PC=1 then begin
    FSplit(InFileName, DS, NS, ES) ;
    OutFileName := DS+NS+'.$$$' ;
    BakFileName := DS+NS+'.BAK' ;
    end {=1} else OutFileName := ParamStr(2) ;
  end {>0} ;

Assign(InFile, InFileName) ; Assign(OutFile, OutFileName) ;
SetTextBuf(InFile, InBuf) ; SetTextBuf(OutFile, OutBuf) ;
Write(Con, ' Reading "', InFileName, '" ') ;
Reset(InFile) ;
Write(Con, 'to make "', OutFileName, '" ') ;
Rewrite(OutFile) ;
Writeln(Con, '- files opened OK.') ;

ProcessFiles ;

Close(InFile) ; Close(OutFile) ;

if PC=1 then BackUp(BakFileName) ;

Writeln(Con, ' DEMIME ended OK.') ;
END.