home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / UTILITY / FILE / FIXUUE11.ZIP / FIXUUE.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-09-03  |  2.5 KB  |  104 lines
  1. {$V-}
  2.   program FixUUE;
  3.   {
  4.     Simple program for fixing translation problems of UUEencoded files
  5.     Copyright (c) Mario A. Guerra 1991.
  6.  
  7.     This program is for the public domain. It can't be used for
  8.     commercial purposes without my written permission.
  9.  
  10.     This program is nothing more than a modified version of the
  11.     Blockwrite example in Turbo Pascal online help!!
  12.  
  13.     Bitnet address: MGUERRA@UCRVM2
  14.  
  15.     26/08/91 - Version 1.1 - You specify the input file and the number of
  16.                              files to be fixed (optional).
  17.   }
  18.  
  19.   uses
  20.     DOS;
  21.  
  22.   var
  23.     FromF, ToF: file;
  24.     FileName: string;
  25.     NumRead, NumWritten: word;
  26.     Buf: array[1..2048] of char;
  27.     Nfiles : integer;
  28.     Seq : word;
  29.     Dir : DirStr;
  30.     Fname : PathStr;
  31.     Ext : ExtStr;
  32.     SeqStr : string;
  33.     Processed : byte;
  34.     NfilesStr : string;
  35.     i, j : word;
  36.     k : integer;
  37.  
  38.   begin
  39.  
  40.     if (ParamCount < 1) or (ParamCount > 2) then
  41.       begin
  42.         Writeln ('Usage: FIXUUE <input file> [<number of files>]');
  43.         Halt;
  44.       end
  45.     else if ParamCount = 1 then
  46.       Nfiles := 1
  47.     else
  48.       begin
  49.         NfilesStr := ParamStr (2);
  50.         Val (NfilesStr, Nfiles, k);
  51.       end;
  52.     Processed := 0;
  53.  
  54.  
  55.     FileName := ParamStr (1);
  56.     FSplit (Filename, Dir, Fname, Ext);
  57.     Val (Copy (Fname, Length(FName), 1), Seq, k);
  58.  
  59.     repeat
  60.       Assign(FromF, Filename);
  61. {$I-}
  62.       Reset(FromF, 1);
  63. {$I+}
  64.       if Ioresult <> 0 then
  65.         begin
  66.           Writeln (FileName, ' could not be open. Halting FIXUUE');
  67.           Halt;
  68.         end;
  69.  
  70.       Assign(ToF, 'FIXUUE.$$$');
  71.  
  72. {$I-}
  73.       Rewrite(ToF, 1);
  74. {$I+}
  75.  
  76.       if Ioresult <> 0 then
  77.         begin
  78.           Writeln ('FIXUUE.$$$ could not be open. Halting FIXUUE');
  79.           Halt;
  80.         end;
  81.       WriteLn('Fixing ', FileSize(FromF), ' bytes in file ', Filename);
  82.  
  83.       repeat
  84.         BlockRead(FromF,Buf,
  85.                   SizeOf(Buf),NumRead);
  86.         for i := 1 to 2048 do
  87.           if Buf [i] = '╒' then Buf [i] := '['
  88.             else if Buf [i] = 'σ' then Buf [i] := ']';
  89.         BlockWrite(ToF,Buf,NumRead,NumWritten);
  90.       until (NumRead = 0) or (NumWritten <> NumRead);
  91.  
  92.       Close(FromF);
  93.       Close(ToF);
  94.       Erase(FromF);
  95.       Rename(ToF, Filename);
  96.  
  97.       Inc (Seq); Inc (Processed);
  98.  
  99.       Str (Seq, SeqStr);
  100.       Fname := Copy (Fname, 1, Length(Fname) - Length(SeqStr)) + SeqStr;
  101.       Filename := Dir + Fname + Ext;
  102.    until (Processed >= Nfiles);
  103.  
  104.   end.