Quelltext /~heha/hs/dos/dosmisc.zip/SRC/CONVERT.PAS

{$G-,M $800,0,0}
uses dos;
{Dieses Programm wandelt ASCII-Zeichen}
{mittels einer *.set-Datei}
const MaxParams=4;

type tbuffer=array[0..255] of byte;

var i,j,k: integer;
    w: word;
    f1,f2:file;			{untypisiert}
    buffer1,buffer2: tbuffer;
    {buffer1=DMA-Puffer, buffer2=Übersetzungspuffer}

Procedure Usage;
 begin
  writeln('Convert'#9#9'(haftmann#software ++FREEWARE++)');
  writeln('Substitute chars using any charset file'#13#10);
  writeln('Usage:');
  writeln('  Convert <charset> <inputfile> <outputfile> (must be different files!)');
  writeln('  Convert <charset> <inputfile>   write to stdout');
  writeln('  Convert <charset>  pipe stdin to stdout.'#13#10);
  writeLn('Options:');
  writeln(' /?  this help screen');
  writeln(#9'<charset> dont need extension .SET and no path when in DOS PATH');
  halt(0);
 end;

Procedure NotFound(name:PathStr);
 begin writeln(name,' not found - aborting'); halt(255); end;

Procedure WriteError(name:PathStr);
 begin writeln(name,': write error'); halt(1); end;

function IsHelp(s:PathStr):Boolean;
 var i: integer;
 begin
  IsHelp:=false;
  if (s[0]>=#2) and ((s[1]='/') or (s[1]='-'))
   then {yes, it is!}
    IsHelp:=((s[2]='?') or (UpCase(s[2])='H'));
 end; {IsHelp}

Procedure LoadSet(name:PathStr);	{Laden des Sets zu buffer2}
 var f: file;
     s: pathstr;
     e: ExtStr;
     i: integer;
 begin
  FSplit(name,s,s,e);
  If e='' then name:= name+'.SET';
  Assign(f,name);
  {$I-} Reset(f,1); {$I+}
  if IOResult<>0 then begin
     S := FSearch(name,GetEnv('PATH'));
     If S='' then NotFound(Name)
      else begin
       Assign(f,S);
       {$I-} Reset(f,1); {$I+}
       If IOResult<>0 then
	begin Writeln('Cannot open ',S); halt(254); end;
      end;
     end;
  BlockRead(f,buffer2,256,w);
  Close(f);
  w:= 256-w;
  If w<>0 then begin
   For i:= 255 downto w do buffer2[i]:= buffer2[i-w];
   For i:= w-1 downto 0 do buffer2[i]:=i;
  end
 end;

begin
 If ParamCount=0 then usage;
 If IsHelp(ParamStr(1)) then usage;
 FileMode:= 0;			{Nur lesen für Netzwerktauglichkeit}
 LoadSet(ParamStr(1));
 Assign(f1,ParamStr(2));
 Assign(f2,ParamStr(3));
 {$I-}
 Reset(f1,1);
 If IOResult<>0 then NotFound(ParamStr(2));
 ReWrite(f2,1);
 If IOResult<>0 then WriteError(ParamStr(3));
 W:= 256;
 While W=256 do begin
  blockread(f1,buffer1,256,w);
  For i:= 0 to w-1 do buffer1[i]:=buffer2[buffer1[i]];
  blockwrite(f2,buffer1,w,i);
 If w<>i then WriteError(ParamStr(3));
 end;
 Close(f1);
 Close(f2);
end.