Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!sdd.hp.com!zaphod.mps.ohio-state.edu!sol.ctr.columbia.edu!ira.uka.de!smurf!subnet.sub.net!mcshh!tilmann
From: tilmann@mcshh.hanse.de (Tilmann Reh)
Newsgroups: comp.os.cpm
Subject: Re: uudecode for a K10...
Summary: here it is...
Keywords: how?
Message-ID: <8618@mcshh.hanse.de>
Date: 9 Feb 91 20:56:14 GMT
References: <88068@unix.cis.pitt.edu>
Lines: 70



Hello,
here is a Turbo Pascal UUDECODE program - hoping you'll excuse me to not
translate texts into english. I wrote it in a few minutes, so it's not
my usual programming style - but works (first line of the UU file must
be the 'begin' line).				Greetings, Tilmann
-----------------------------------
program uudecode;

(* TR 160190 *)
(* quick'n dirty - kein Syntaxcheck der Datenzeilen! *)

const signon = 'UU-Decode V0.1 TR 160190';

var inf,out : text;
    name    : string[20];
    i       : integer;
    s       : string[255];
    x       : array[0..255] of byte absolute s;
    ch      : char;

begin
  writeln(^m^j,signon,^m^j);
  if paramcount=0 then begin
    write('Dateiname : '); readln(name) end
  else name:=paramstr(1);
  if name='' then halt;
  assign(inf,name);
  {$I-} reset(inf); {$I+}
  if ioresult<>0 then begin
    writeln('Datei nicht gefunden!');
    halt;
    end;

  i:=0;
  while not (eof(inf) or (i=1)) do begin
    readln(inf,s);
    i:=pos('begin ',s);
    end;
  delete(s,1,6);
  i:=pos(' ',s);
  name:=copy(s,succ(i),20);
  writeln('Mode: ',copy(s,1,pred(i)));
  writeln('Datei ',name,' wird bearbeitet.');
  assign(out,name);
  {$I-} reset(out); {$I+}
  if ioresult=0 then begin
    write('Datei existiert. Loeschen (J/N) ? ');
    repeat read(kbd,ch); ch:=upcase(ch) until (ch='J') or (ch='N');
    writeln(ch);
    if ch='N' then halt;
    end;

  rewrite(out);
  repeat
    readln(inf,s);
    if s<>'end' then begin
      delete(s,1,1);
      for i:=1 to length(s) do x[i]:=(x[i]-$20) and $3F;
      while length(s)>0 do begin
        write(out,chr((x[2] shr 4) + (x[1] shl 2)),
                  chr((x[3] shr 2) + (x[2] shl 4)),
                  chr((x[4]      ) + (x[3] shl 6)));
        delete(s,1,4);
        end;
      end;
  until s='end';
  close(out);
  end.