home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol134 / hextobin.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  2.8 KB  |  124 lines
  1. {$E+,T-}
  2.  
  3. program hextobin
  4. ;
  5. const
  6.      TheHEADER = 'CP/M Hex Ascii File to Binary File Program';
  7.      TheVERSION= 'Version -- October 10, 1982.';
  8.      TheTRAILER= 'Hex to Binary File conversion done.';
  9.  
  10. type 
  11.      BYTE      = 0..255;
  12.      sector    = packed array [1..128] of byte;
  13.      filestring= string 14;
  14.      bufaction = (buf_hold, buf_write);
  15.  
  16. var 
  17.      ofilename ,
  18.      ifilename : filestring;
  19.  
  20.      hexfile   ,
  21.      binfile   : file of sector;
  22.      
  23.      sectorct  : integer;
  24.  
  25.      hexbuf    ,
  26.      binbuf    : sector;
  27.  
  28.      buflag    : bufaction;
  29.  
  30.      i         ,
  31.      j         ,
  32.      k         : integer;
  33.  
  34.  
  35.  
  36. function OpenInp: boolean
  37. ;
  38. begin  {* OpenInp *}
  39.      OpenInp := true;
  40.      write('INPUT FILE? ');
  41.      read(ifilename);
  42.      reset(ifilename,hexfile);
  43.      if EOF(hexfile) then begin
  44.           writeln(' ... file is empty...');
  45.           OpenInp := false;
  46.      end; 
  47. end;  {* OpenInp *}
  48.  
  49.  
  50.  
  51. function OpenOut:boolean
  52. ;
  53. begin  {* OpenOut *}
  54.      OpenOut := true;
  55.      write('OUTPUT FILE? ');
  56.      read(ofilename);
  57.      rewrite(ofilename,binfile);
  58. end;  {* OpenOut *}
  59.  
  60.  
  61.  
  62. function hexdigit(ndx:integer):integer
  63. ;
  64. begin  {* hexdigit *}
  65.      if (hexbuf[ndx] >= ord('0')) and (hexbuf[ndx] <= ord('9')) then begin
  66.           hexdigit := ord(hexbuf[ndx]) - ord('0');
  67.      end
  68.      else if (hexbuf[ndx] >= ord('A')) and (hexbuf[ndx] <= ord('F')) then begin
  69.           hexdigit := 10 + ord(hexbuf[ndx]) - ord('A');
  70.      end
  71.      else begin      { not one of the characters that should be in the file }
  72.           hexdigit := 0;
  73.           writeln('*** found bad character. (',hexbuf[ndx],')');
  74.      end;
  75. end;  {* hexdigit *}
  76.  
  77.  
  78.  
  79.  
  80. begin  {* HextoBin *}
  81.      writeln(TheHEADER);
  82.      writeln(TheVERSION);
  83.  
  84.      repeat
  85.      until OpenInp;
  86.      writeln('------> File opened.');
  87.  
  88.      repeat
  89.      until OpenOut;
  90.      writeln('------> File opened.');
  91.  
  92.      sectorct := 0;
  93.      buflag := buf_hold;
  94.      i := 0;
  95.      while  not EOF(hexfile) do begin
  96.           read(hexfile,hexbuf);
  97.           for j := 1 to 64 do begin
  98.                binbuf[i+j] := hexdigit(j+j-1)*16+hexdigit(j+j);
  99.           end;
  100.           sectorct := succ(sectorct);
  101.           case buflag of 
  102.           buf_hold:  
  103.                begin
  104.                     buflag := buf_write;
  105.                     i := 64;
  106.                end;
  107.           buf_write: 
  108.                begin
  109.                     write(binfile,binbuf);
  110.                     buflag := buf_hold;
  111.                     i := 0;
  112.                     write('.');      { show progress }
  113.                     if sectorct mod 40 = 0 then begin
  114.                          writeln;
  115.                     end;
  116.                end;
  117.           end;    { case what to do with buffer }
  118.      end;
  119.      if buflag = buf_hold then begin
  120.           write(binfile,binbuf);
  121.      end;
  122.      writeln(TheTRAILER);
  123. end.  {* HextoBin *}
  124.