home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / uudecode.pas < prev    next >
Pascal/Delphi Source File  |  1994-04-21  |  2KB  |  99 lines
  1.  
  2. {$i-,v-}
  3.  
  4. program uudecode;
  5. { not-real 'uudecode', use debug to create file, by Bas van Gaalen, Holland, PD }
  6. type
  7.   buftype = array[0..1023] of byte;
  8.   str4 = string[4];
  9.   str80 = string[80];
  10.  
  11. var
  12.   uufile : file;
  13.   txtfile : text;
  14.   buffer : buftype;
  15.   uufilename,txtfilename,tmpstr : str80;
  16.   mempos,bufpos : word;
  17.   rd : integer;
  18.   i,v : byte;
  19.  
  20. {----------}
  21.  
  22. procedure error(errstr : str80); begin
  23.   writeln(errstr); halt; end;
  24.  
  25. {----------}
  26.  
  27. function upstr(srcstr : str80) : str80;
  28. var i : byte;
  29. begin
  30.   for i := 0 to length(srcstr) do
  31.     if srcstr[i] in ['a'..'z'] then dec(srcstr[i],32);
  32.   upstr := srcstr;
  33. end;
  34.  
  35. {----------}
  36.  
  37. function hex(value : word) : str4;
  38. var num : str4; i : integer;
  39. begin
  40.   if value < 256 then begin
  41.     num[0] := #2;
  42.     num[1] := chr((lo(value) div 16)+48);
  43.     num[2] := chr((lo(value) mod 16)+48);
  44.   end
  45.   else begin
  46.     num[0] := #4;
  47.     num[1] := chr((hi(value) div 16)+48);
  48.     num[2] := chr((hi(value) mod 16)+48);
  49.     num[3] := chr((lo(value) div 16)+48);
  50.     num[4] := chr((lo(value) mod 16)+48);
  51.   end;
  52.   for i := 1 to length(num) do if (ord(num[i])) > 57 then
  53.     num[i] := chr(ord(num[I])+7);
  54.   hex := num;
  55. end;
  56.  
  57. {----------}
  58.  
  59. begin
  60.   write(' enter input filename: '); readln(uufilename);
  61.   assign(uufile,uufilename);
  62.   reset(uufile,1);
  63.   if ioresult <> 0 then error('error opening file '+uufilename);
  64.  
  65.   write('enter output filename: '); readln(txtfilename);
  66.   assign(txtfile,txtfilename);
  67.   rewrite(txtfile);
  68.   if ioresult <> 0 then error('error creating file '+txtfilename);
  69.  
  70.   mempos := $0100; tmpstr := ' E '+hex(mempos); i := 0;
  71.   writeln(txtfile,' N '+upstr(uufilename));
  72.  
  73.   repeat
  74.     blockread(uufile,buffer,sizeof(buffer),rd);
  75.     for bufpos := 0 to rd-1 do begin
  76.       if i mod 21 = 20 then begin
  77.         writeln(txtfile,tmpstr);
  78.         tmpstr := '';
  79.         inc(mempos,i);
  80.         i := 0;
  81.         tmpstr := ' E '+hex(mempos);
  82.       end;
  83.       tmpstr := tmpstr+' '+hex(buffer[bufpos]);
  84.       inc(i);
  85.     end;
  86.   until rd < 1024;
  87.   writeln(txtfile,tmpstr);
  88.   inc(mempos,i);
  89.  
  90.   writeln(txtfile,' Rcx');
  91.   writeln(txtfile,' '+hex(mempos-$0100));
  92.   writeln(txtfile,' W');
  93.   writeln(txtfile,' Q');
  94.  
  95.   close(uufile); close(txtfile);
  96.  
  97.   writeln('ready...');
  98. end.
  99.