home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1995 October / Simtel-MSDOS-Oct1995-CD2.iso / starter / uudecode.tp5 < prev    next >
Pascal/Delphi Source File  |  1990-05-08  |  6KB  |  230 lines

  1. PROGRAM uudecode;
  2.  
  3. {v1.1 Toad Hall Tweak, 9 May 90
  4.  - Reformatted in case, style, indentation, etc. to my preferences.
  5.  - Tweaked for Turbo Pascal v5.0
  6.  David Kirschbaum
  7.  Toad Hall
  8. }
  9.  
  10. Uses  Dos,Crt;
  11.  
  12. CONST
  13.   DefaultSuffix = '.uue';
  14.   OFFSET = 32;
  15.  
  16. TYPE
  17.   Str80 = STRING[80];
  18.  
  19. VAR
  20.   Infile: TEXT;
  21.   Fi    : FILE OF Byte;
  22.   Outfile: FILE OF Byte;
  23.   linenum: INTEGER;
  24.   Line: Str80;
  25.   size,remaining : longint;  {v1.1 REAL;}
  26.  
  27.  
  28. PROCEDURE Abort(Msg: Str80);
  29.   BEGIN
  30.     WRITELN;
  31.     IF linenum > 0 THEN WRITE('Line ', linenum, ': ');
  32.     WRITELN(Msg);
  33.     HALT
  34.   END; {of Abort}
  35.  
  36.  
  37. PROCEDURE NextLine(VAR S: Str80);
  38.   BEGIN
  39.     Inc(linenum);
  40.     {write('.');}
  41.     READLN(Infile, S);
  42.     Dec(remaining,LENGTH(S)-2);  {-2 is for CR/LF}
  43.     WRITE('bytes remaining: ',remaining:7,' (',
  44.           remaining/size*100.0:3:0,'%)',CHR(13));
  45.   END; {of NextLine}
  46.  
  47.  
  48. PROCEDURE Init;
  49.  
  50.   PROCEDURE GetInFile;
  51.     VAR Infilename: Str80;
  52.     BEGIN
  53.       IF ParamCount = 0 THEN Abort ('Usage: uudecode <filename>');
  54.  
  55.       Infilename := ParamStr(1);
  56.       IF POS('.', Infilename) = 0
  57.       THEN Infilename := CONCAT(Infilename, DefaultSuffix);
  58.       ASSIGN(Infile, Infilename);
  59.       {$I-}
  60.       RESET(Infile);
  61.       {$i+}
  62.       IF IOResult > 0 THEN Abort (CONCAT('Can''t open ', Infilename));
  63.  
  64.       WRITELN ('Decoding ', Infilename);
  65.       ASSIGN(Fi,Infilename); RESET(Fi);
  66.       size := FileSize(Fi);
  67.       CLOSE(Fi);
  68. {      IF size < 0 THEN size:=size+65536.0; }
  69.       remaining := size;
  70.     END;  {of GetInFile}
  71.  
  72.   PROCEDURE GetOutFile;
  73.     VAR
  74.       Header, Mode, Outfilename: Str80;
  75.       Ch: CHAR;
  76.  
  77.     PROCEDURE ParseHeader;
  78.       VAR index: INTEGER;
  79.  
  80.       PROCEDURE NextWord(VAR Word:Str80; VAR index: INTEGER);
  81.         BEGIN
  82.           Word := '';
  83.           WHILE Header[index] = ' ' DO BEGIN
  84.             Inc(index);
  85.             IF index > LENGTH(Header) THEN Abort ('Incomplete header')
  86.           END;
  87.           WHILE Header[index] <> ' ' DO BEGIN
  88.             Word := CONCAT(Word, Header[index]);
  89.             Inc(index);
  90.           END
  91.         END; {of NextWord}
  92.  
  93.       BEGIN {ParseHeader}
  94.         Header := CONCAT(Header, ' ');
  95.         index := 7;
  96.         NextWord(Mode, index);
  97.         NextWord(Outfilename, index)
  98.       END; {of ParseHeader}
  99.  
  100.     BEGIN {GetOutFile}
  101.       IF EOF(Infile) THEN Abort('Nothing to decode.');
  102.       NextLine (Header);
  103.       WHILE NOT ((COPY(Header, 1, 6) = 'begin ') OR EOF(Infile)) DO
  104.         NextLine(Header);
  105.       WRITELN;
  106.       IF EOF(Infile) THEN Abort('Nothing to decode.');
  107.  
  108.       ParseHeader;
  109.       ASSIGN(Outfile, Outfilename);
  110.       WRITELN ('Destination is ', Outfilename);
  111.       {$I-}
  112.       RESET(Outfile);
  113.       {$I+}
  114.       IF IOResult = 0 THEN BEGIN
  115.         WRITE ('Overwrite current ', Outfilename, '? [Y/N] ');
  116.         REPEAT
  117.           Ch := Upcase(ReadKey);  {v1.1}
  118.         UNTIL Ch IN ['Y', 'N'];
  119.         WRITELN(Ch);
  120.         IF Ch = 'N' THEN Abort ('Overwrite cancelled.')
  121.       END;
  122.       REWRITE (Outfile);
  123.     END; {of GetOutFile}
  124.  
  125.   BEGIN {Init}
  126.     linenum := 0;
  127.     GetInFile;
  128.     GetOutFile;
  129.   END; { init}
  130.  
  131. FUNCTION Check_Line: BOOLEAN;
  132.   BEGIN
  133.     IF Line = '' THEN Abort ('Blank line in file');
  134.     Check_Line := NOT (Line[1] IN [' ', '`'])
  135.   END; {of Check_Line}
  136.  
  137.  
  138. PROCEDURE DecodeLine;
  139.   VAR
  140.     lineIndex, byteNum, count, i: INTEGER;
  141.     chars: ARRAY [0..3] OF Byte;
  142.     hunk: ARRAY [0..2] OF Byte;
  143.  
  144. {    procedure debug;
  145.       var i: integer;
  146.  
  147.       procedure writebin(x: byte);
  148.         var i: integer;
  149.         begin
  150.           for i := 1 to 8 do begin
  151.               write ((x and $80) shr 7);
  152.               x := x shl 1
  153.             end;
  154.           write (' ')
  155.         end;
  156.  
  157.       begin
  158.         writeln;
  159.         for i := 0 to 3 do writebin(chars[i]);
  160.         writeln;
  161.         for i := 0 to 2 do writebin(hunk[i]);
  162.         writeln
  163.       end;      }
  164.  
  165.  
  166.   FUNCTION Next_Ch: CHAR;
  167.     BEGIN
  168.       Inc(lineIndex);
  169.       IF lineIndex > LENGTH(Line) THEN Abort('Line too short.');
  170.  
  171.       IF NOT (Line[lineindex] IN [' '..'`'])
  172.       THEN Abort('Illegal character in line.');
  173. {     write(line[lineindex]:2);}
  174.       IF Line[lineindex] = '`' THEN Next_Ch := ' '
  175.                                ELSE Next_Ch := Line[lineIndex]
  176.     END; {of Next_Ch}
  177.  
  178.  
  179.   PROCEDURE DecodeByte;
  180.  
  181.     PROCEDURE GetNextHunk;
  182.       VAR i: INTEGER;
  183.       BEGIN
  184.         FOR i := 0 TO 3 DO chars[i] := ORD(Next_Ch) - OFFSET;
  185.         hunk[0] := (chars[0] ShL 2) + (chars[1] ShR 4);
  186.         hunk[1] := (chars[1] ShL 4) + (chars[2] ShR 2);
  187.         hunk[2] := (chars[2] ShL 6) + chars[3];
  188.         byteNum := 0  {;
  189.         debug          }
  190.       END; {of GetNextHunk}
  191.  
  192.     BEGIN {DecodeByte}
  193.       IF byteNum = 3 THEN GetNextHunk;
  194.       WRITE (Outfile, hunk[byteNum]);
  195.       {writeln(bytenum, ' ', hunk[byteNum]);}
  196.       Inc(byteNum)
  197.     END; {of DecodeByte}
  198.  
  199.   BEGIN {DecodeLine}
  200.     lineIndex := 0;
  201.     byteNum := 3;
  202.     count := (ORD(Next_Ch) - OFFSET);
  203.     FOR i := 1 TO count DO DecodeByte
  204.   END; {of DecodeLine}
  205.  
  206.  
  207. PROCEDURE Terminate;
  208.   VAR Trailer: Str80;
  209.   BEGIN
  210.     IF EOF(Infile) THEN Abort ('Abnormal end.');
  211.  
  212.     NextLine (trailer);
  213.     IF LENGTH (trailer) < 3 THEN Abort ('Abnormal end.');
  214.  
  215.     IF COPY (trailer, 1, 3) <> 'end' THEN Abort ('Abnormal end.');
  216.  
  217.     CLOSE (Infile);
  218.     CLOSE (Outfile)
  219.   END;  {of Terminate}
  220.  
  221. BEGIN {uudecode}
  222.   Init;
  223.   NextLine(Line);
  224.   WHILE Check_Line DO BEGIN
  225.     DecodeLine;
  226.     NextLine(Line)
  227.   END;
  228.   Terminate
  229. END.
  230.