home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / misc.swg / 0048_UUDCODE.PAS.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-21  |  3.6 KB  |  148 lines
  1. {
  2. From: BOB SWART
  3. Subj: UUDECODE.PAS
  4. Here is my version of UUDECODE.PAS (also fully compatible):
  5. }
  6.  
  7. {$IFDEF VER70}
  8. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S+,T-,V-,X-}
  9. {$ELSE}
  10. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S+,V-,X-}
  11. {$ENDIF}
  12. {$M 8192,0,0}
  13. {
  14.   UUDeCode 3.0
  15.   Borland Pascal (Objects) 7.0.
  16.   Copr. (c) 9-29-1993 DwarFools & Consultancy drs. Robert E. Swart
  17.                       P.O. box 799
  18.                       5702 NP  Helmond
  19.                       The Netherlands
  20.   Code size: 4832 bytes
  21.   Data size: 1330 bytes
  22.   .EXE size: 3337 bytes
  23.   ----------------------------------------------------------------
  24.   This program uudecodes files.
  25. }
  26.  
  27. Const
  28.   SP = Byte(' ');
  29.  
  30.   Type
  31.   TTriplet = Array[0..2] of Byte;
  32.   TKwartet = Array[0..3] of Byte;
  33.  
  34. var f: Text;
  35.     g: File of Byte;
  36.     FileName: String[12];
  37.     Buffer: String;
  38.     Kwartets: record
  39.                 lengte: Byte;
  40.                 aantal: Byte;
  41.                 kwart: Array[1..64] of TKwartet;
  42.               end absolute Buffer;
  43.     Trip: TTriplet;
  44.     i: Integer;
  45.  
  46.     FUNCTION UpperStr(S : STRING) : STRING;
  47.     VAR sLen : BYTE ABSOLUTE S;
  48.         I    : BYTE;
  49.     BEGIN
  50.     FOR I := 1 TO sLEN DO S := UpCase(S[i]);
  51.     UpperStr := S;
  52.     END;
  53.  
  54.     procedure Kwartet2Triplet(Kwartet: TKwartet; var Triplet: TTriplet);
  55.     begin
  56.       Triplet[0] :=  ((Kwartet[0] - SP) SHL 2) +
  57.                     (((Kwartet[1] - SP) AND $30) SHR 4);
  58.       Triplet[1] := (((Kwartet[1] - SP) AND $0F) SHL 4) +
  59.                     (((Kwartet[2] - SP) AND $3C) SHR 2);
  60.       Triplet[2] := (((Kwartet[2] - SP) AND $03) SHL 6) +
  61.                      ((Kwartet[3] - SP) AND $3F)
  62.     end {Kwartet2Triplet};
  63.  
  64.  
  65. begin
  66.   writeln('UUDeCode 3.1 (c) 1993 DwarFools & Consultancy' +
  67.                               ', by drs. Robert E. Swart'#13#10);
  68.   if ParamCount = 0 then
  69.   begin
  70.     writeln('Usage: UUDeCode infile [outfile]');
  71.     Halt
  72.   end;
  73.  
  74.   if UpperStr(ParamStr(1)) = UpperStr(ParamStr(2)) then
  75.   begin
  76.     writeln('Error: infile = outfile');
  77.     Halt(1)
  78.   end;
  79.  
  80.   Assign(f,ParamStr(1));
  81.   FileMode := $40;
  82.   reset(f);
  83.   if IOResult <> 0 then
  84.   begin
  85.     writeln('Error: could not open file ',ParamStr(1));
  86.     Halt(2)
  87.   end;
  88.   repeat
  89.     readln(f,Buffer) { skip }
  90.   until eof(f) or (Copy(Buffer,1,5) = 'begin');
  91.   if Buffer[11] = #32 then FileName := Copy(Buffer,12,12)
  92.   else
  93.     if Buffer[10] = #32 then FileName := Copy(Buffer,11,12)
  94.                         else FileName := ParamStr(2);
  95.   {$IFDEF DEBUG}
  96.   writeln(FileName);
  97.   {$ENDIF}
  98.  
  99.   if UpperStr(ParamStr(1)) = UpperStr(FileName) then
  100.   begin
  101.     writeln('Error: input file = output file');
  102.     Halt(1)
  103.   end;
  104.  
  105.   Assign(g,FileName);
  106.   if ParamCount > 1 then
  107.   begin
  108.     FileMode := $02;
  109.     reset(g);
  110.     if IOResult = 0 then
  111.     begin
  112.       writeln('Error: file ',FileName,' already exists.');
  113.       Halt(3)
  114.     end
  115.   end;
  116.   rewrite(g);
  117.   if IOResult <> 0 then
  118.   begin
  119.     writeln('Error: could not create file ',FileName);
  120.     Halt(4)
  121.   end;
  122.  
  123.   while (not eof(f)) and (Buffer <> 'end') do
  124.   begin
  125.     FillChar(Buffer,SizeOf(Buffer),#32);
  126.     readln(f,Buffer);
  127.     if Buffer <> 'end' then
  128.     begin
  129.       for i:=1 to (Kwartets.aantal-32) div 3 do
  130.       begin
  131.         Kwartet2Triplet(Kwartets.kwart[i],Trip);
  132.         write(g,Trip[0],Trip[1],Trip[2])
  133.       end;
  134.       if ((Kwartets.aantal-32) mod 3) > 0 then
  135.       begin
  136.         Kwartet2Triplet(Kwartets.kwart[i+1],Trip);
  137.         for i:=1 to ((Kwartets.aantal-32) mod 3) do write(g,Trip[i-1])
  138.       end
  139.     end
  140.   end;
  141.   close(f);
  142.   close(g);
  143.  
  144.   if ParamCount > 1 then
  145.     writeln('UUDeCoded file ',FileName,' created.');
  146.   writeln
  147. end.
  148.