home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / decode.pas < prev    next >
Pascal/Delphi Source File  |  1994-04-20  |  2KB  |  80 lines
  1.  
  2. {$i-,v-}
  3.  
  4. program decode;
  5. { Convert binairy file to text for mail-xfer, by Bas van Gaalen, Holland, PD }
  6. uses
  7.   dos;
  8.  
  9. type
  10.   buftype = array[0..1023] of byte;
  11.   str2 = string[2];
  12.   str80 = string[80];
  13.  
  14. var
  15.   uufile : file;
  16.   txtfile : text;
  17.   buffer : buftype;
  18.   uufilename,txtfilename,tmpstr : str80;
  19.   d : dirstr; n : namestr; e : extstr;
  20.   bufpos : word;
  21.   rd : integer;
  22.   i,v : byte;
  23.  
  24. {----------}
  25.  
  26. procedure error(errstr : str80); begin
  27.   writeln(errstr); halt; end;
  28.  
  29. {----------}
  30.  
  31. function upstr(srcstr : str80) : str80;
  32. var i : byte;
  33. begin
  34.   for i := 0 to length(srcstr) do
  35.     if srcstr[i] in ['a'..'z'] then dec(srcstr[i],32);
  36.   upstr := srcstr;
  37. end;
  38.  
  39. {----------}
  40.  
  41. function hex(value : byte) : str2;
  42. const hexchars : array[0..15] of char = '0123456789abcdef';
  43. begin
  44.   hex := hexchars[value shr 4]+hexchars[value and 15];
  45. end;
  46.  
  47. {----------}
  48.  
  49. begin
  50.   write(' Enter input filename: '); readln(uufilename);
  51.   assign(uufile,uufilename);
  52.   reset(uufile,1);
  53.   if ioresult <> 0 then error('Error opening file '+upstr(uufilename));
  54.  
  55.   write('Enter output filename: '); readln(txtfilename);
  56.   assign(txtfile,txtfilename);
  57.   rewrite(txtfile);
  58.   if ioresult <> 0 then error('Error creating file '+upstr(txtfilename));
  59.  
  60.   fsplit(uufilename,d,n,e);
  61.   writeln(txtfile,upstr(n+e));
  62.   tmpstr := '';
  63.  
  64.   repeat
  65.     blockread(uufile,buffer,sizeof(buffer),rd);
  66.     for bufpos := 0 to rd-1 do begin
  67.       if i mod 36 = 35 then begin
  68.         writeln(txtfile,tmpstr);
  69.         tmpstr := '';
  70.         i := 0;
  71.       end;
  72.       tmpstr := tmpstr+hex(buffer[bufpos]);
  73.       inc(i);
  74.     end;
  75.   until rd < 1024;
  76.   writeln(txtfile,tmpstr);
  77.   close(uufile); close(txtfile);
  78.   writeln('ready...');
  79. end.
  80.