home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / DARC31.ZIP / DEARCIO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-01-04  |  5.0 KB  |  262 lines
  1. (**
  2.  *
  3.  *  Module:       dearcio.pas
  4.  *  Description:  DEARC input/output routines
  5.  *
  6.  *  Revision History:
  7.  *     7-26-88 : unitized for turbo 4.0
  8.  *
  9. **)
  10.  
  11. unit dearcio;
  12.  
  13. interface
  14. uses
  15.   dos,
  16.   dearcglb,
  17.   dearcabt;
  18.  
  19.   procedure open_arc;
  20.   procedure open_ext;
  21.   procedure close_arc;
  22.   procedure close_ext(var hdr : heads);
  23.   procedure fseek(offset : longint; base : integer);
  24.   procedure put_ext(c : byte);
  25.   function get_arc : byte;
  26.   procedure fread(var buf; reclen : integer);
  27.  
  28. implementation
  29.  
  30.  
  31. (**
  32.  *
  33.  *  Name:         procedure Read_Block
  34.  *  Description:  read a block from the archive file
  35.  *  Parameters:   none
  36.  *
  37. **)
  38. procedure Read_Block;
  39. var
  40.   res : word;
  41. begin
  42.   if EOF(arcfile) then
  43.     endfile := TRUE
  44.   else
  45.     BlockRead(arcfile, arcbuf, BLOCKSIZE, res);
  46.  
  47.   arcptr := 1
  48. end; (* proc read_block *)
  49.  
  50.  
  51. (**
  52.  *
  53.  *  Name:         procedure Write_Block
  54.  *  Description:  write a block to the extracted file
  55.  *  Parameters:   none
  56.  *
  57. **)
  58. procedure Write_Block;
  59. begin
  60.   BlockWrite(extfile, extbuf, extptr);
  61.   extptr := 1
  62. end; (* proc write_block *)
  63.  
  64.  
  65. (**
  66.  *
  67.  *  Name:         function get_arc : byte
  68.  *  Description:  read 1 character from the archive file
  69.  *  Parameters:   none
  70.  *  Returns:      character read
  71.  *
  72. **)
  73. function get_arc : byte;
  74. begin
  75.   if endfile then
  76.     get_arc := 0
  77.   else
  78.     begin
  79.       get_arc := arcbuf[arcptr];
  80.       if arcptr = BLOCKSIZE then
  81.         Read_Block
  82.       else
  83.         arcptr := arcptr + 1
  84.     end
  85. end; (* func get_arc *)
  86.  
  87.  
  88. (**
  89.  *
  90.  *  Name:         procedure put_ext
  91.  *  Description:  write 1 character to the extracted file
  92.  *  Parameters:   value -
  93.  *                  c : byte - character to write
  94.  *
  95. **)
  96. procedure put_ext(c : byte);
  97. begin
  98.   extbuf[extptr] := c;
  99.   if extptr = BLOCKSIZE then
  100.     Write_Block
  101.   else
  102.     extptr := extptr + 1
  103. end; (* proc put_ext *)
  104.  
  105.  
  106. (**
  107.  *
  108.  *  Name:         procedure open_arc
  109.  *  Description:  open the archive file for input processing
  110.  *  Parameters:   none
  111.  *
  112. **)
  113. procedure open_arc;
  114. begin
  115.   {$I-}
  116.     assign(arcfile, arcname);
  117.   {$I+}
  118.   if (ioresult <> 0) then
  119.     abort('Cannot open archive file.');
  120.  
  121.   {$I-}
  122.     reset(arcfile, 1);
  123.   {$I+}
  124.   if (ioresult <> 0) then
  125.     abort('Cannot open archive file.');
  126.  
  127.   endfile := FALSE;
  128.   Read_Block
  129. end; (* proc open_arc *)
  130.  
  131.  
  132. (**
  133.  *
  134.  *  Name:         procedure open_ext
  135.  *  Description:  open the extracted file for writing
  136.  *  Parameters:   none
  137.  *
  138. **)
  139. procedure open_ext;
  140. begin
  141.   {$I-}
  142.     assign(extfile, extname);
  143.   {$I+}
  144.   if (ioresult <> 0) then
  145.     abort('Cannot open extract file.');
  146.  
  147.   {$I-}
  148.     rewrite(extfile, 1);
  149.   {$I+}
  150.   if (ioresult <> 0) then
  151.     abort('Cannot open extract file.');
  152.  
  153.   extptr := 1;
  154. end; (* proc open_ext *)
  155.  
  156.  
  157. (**
  158.  *
  159.  *  Name:         procedure close_arc
  160.  *  Description:  close the archive file
  161.  *  Parameters:   none
  162.  *
  163. **)
  164. procedure close_arc;
  165. begin
  166.   close(arcfile)
  167. end; (* proc close_arc *)
  168.  
  169.  
  170. (**
  171.  *
  172.  *  Name:         procedure close_ext
  173.  *  Description:  close the extracted file
  174.  *  Parameters:   none
  175.  *
  176. **)
  177. procedure close_ext(var hdr : heads);
  178. var
  179.   dt     : longint;
  180.   regs   : registers;
  181.   handle : word;
  182. begin
  183.   extptr := extptr - 1;
  184.  
  185.   if (extptr <> 0) then
  186.     Write_Block;
  187.  
  188.   close(extfile);
  189.  
  190.  
  191.   (*
  192.    *  pbr  - 7-26-88 : added date stamping
  193.    *)
  194.   regs.ax := $3D00;                   (* open file *)
  195.   regs.ds := seg(hdr);
  196.   regs.dx := ofs(hdr.name);
  197.   MsDos(regs);
  198.  
  199.   handle := regs.ax;
  200.  
  201.   regs.ax := $5701;                   (* set date/time *)
  202.   regs.bx := handle;
  203.   regs.cx := hdr.time;
  204.   regs.dx := hdr.date;
  205.   MsDos(regs);
  206.  
  207.   regs.ah := $3E;                     (* close file *)
  208.   regs.bx := handle;
  209.   MsDos(regs);
  210. end; (* proc close_ext *)
  211.  
  212.  
  213. (**
  214.  *
  215.  *  Name:         procedure fseek
  216.  *  Description:  re-position the current pointer in the archive file
  217.  *  Parameters:   value -
  218.  *                  offset : longint - offset to position to
  219.  *                  base   : integer - position from:
  220.  *                             0 : beginning of file
  221.  *                             1 : current position
  222.  *                             2 : end-of-file
  223.  *
  224. **)
  225. procedure fseek(offset : longint; base : integer);
  226. var
  227.   b           : longint;
  228. begin
  229.   case base of
  230.     0 : b := offset;
  231.     1 : b := offset + FilePos(arcfile) - BLOCKSIZE + arcptr - 1;
  232.     2 : b := offset + FileSize(arcfile);
  233.     else
  234.       abort('Invalid parameters to fseek')
  235.   end;
  236.  
  237.   seek(arcfile, b);
  238.   Read_Block;
  239. end; (* proc fseek *)
  240.  
  241.  
  242. (**
  243.  *
  244.  *  Name:         procedure fread
  245.  *  Description:  read a record from the archive file
  246.  *  Parameters:   var -
  247.  *                  buf - buffer for read-in data
  248.  *                value -
  249.  *                  reclen : integer - items to read
  250.  *
  251. **)
  252. procedure fread(var buf; reclen : integer);
  253. var i : integer;
  254.     b : array [1..MaxInt] of byte absolute buf;
  255. begin
  256.   for i := 1 to reclen do
  257.     b[i] := get_arc
  258. end; (* proc fread *)
  259.  
  260. end.
  261.  
  262.