{$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 fr 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.
| Detected encoding: UTF-8 | 0
|