old/PAS/RHA/rha2.pas

var
 INP,OUT          : file of byte;
 cur, min,plus    : byte;
 mask             : byte;
 fout             : string;
 fin              : string;
 i,h              : byte;
begin
 if (ParamCount<1) then
  begin
   WriteLn('Usage: rha.exe <file>');
   Halt(2);
  end;
 Fin:=ParamStr(1);
 Assign(INP,fin);
 {$I-}
 Reset(INP);
 {$I+}
 if (IOResult<>0) then
  begin
   WriteLn('File ',Fin,' don''t exist!');
  end;
 if pos('.rha',Fin)>0 then
  begin
   Read(inp,cur);
   fout:='';
   while (cur <> 0) do
    begin
     fout:=fout+chr(cur);
     Read(inp,cur)
    end;
  end
 else fout := Copy(Fin,1,pos('.',Fin)) + 'rha';
 Assign(OUT,fOut);
 ReWrite(OUT);
 if pos('.rha',Fin) = 0 then
  begin
   for i:=1 to length(FIN) do begin h:= ORD(FIN[i]); write(OUT,h);end;
   h:=0;
   write(OUT,h);
  end;
 min:=0;plus:=0;
 if pos('.rha',fin) = 0 then begin
 while not eof(INP) do
  begin
    read(INP,cur);
    mask:=128;
    while (mask <> 0) do
     begin
      if (cur and mask) = mask then
       begin
         if (plus=15) then
          begin
           Write(OUT,plus);
           plus:=0;
           min :=0;
          end;
        inc(plus);
       end
      else
       begin
        if (plus<>0) then
         begin
           plus := min shl 4 + plus;
           Write(OUT,plus);
           plus:=0;
           min :=0;
         end
        else
         if (min=15) then
          begin
           plus := min shl 4;
           Write(OUT,plus);
           plus:=0;
           min :=0;
          end;
        inc(min);
       end;
      mask:=mask shr 1;
     end;
  end;
  plus := min shl 4+plus;
  Write(OUT,plus);
  end
  else
   begin
    min:=0;plus:=0;h:=0;
    while not eof(INP) do
     begin
       read(inp,cur);
       min:=cur shr 4;
       plus:=cur and 15;
       while (plus or min) <> 0 do
        begin
         while i<>8 do
          begin
          if (plus or min) = 0 then break;
          if min>0 then begin dec(min);h:=h shl 1;end
          else
           if plus>0 then begin dec(plus);h:=(h shl 1)+1;end;
          inc(i);
          end;
         if (i=8) then
          begin
           Write(OUT,h);
           i:=0;
           h:=0;
          end;
        end;
     end;
    end;
  close(INP);
  close(OUT);
end.