home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TOOL_INC.ZIP / DOSIO.INC < prev    next >
Encoding:
Text File  |  1988-01-29  |  5.5 KB  |  234 lines
  1.  
  2.  
  3. (*
  4.  * dosio - library for interface to dos v2 file access functions
  5.  *
  6.  * usage:
  7.  *
  8.  *  fd := dos_create('name',attributes)
  9.  *  if dos_unlink('name') = dos_error then ...
  10.  *  fd := dos_open('name',open_(read write update))
  11.  *  if dos_close(fd) = dos_error then ...
  12.  *  count := dos_read(fd,buffer,sizeof(buffer))
  13.  *  count := dos_write(fd,buffer,sizeof(buffer))
  14.  *  integer_pos := dos_seek(fd,seek_(start cur end),integer_offset)
  15.  *  real_pos := dos_lseek(fd,seek_*,real_offset)
  16.  *  dos_file_times(fd,time_(set get),time,date);
  17.  *
  18.  *)
  19.  
  20.  
  21. type
  22.  
  23.    dos_filename = string[64];
  24.    dos_handle   = integer;
  25.  
  26.    dos_seek_methods = (seek_start,
  27.                        seek_cur,
  28.                        seek_end);
  29.  
  30.    dos_time_functions = (time_get,
  31.                          time_set);
  32.  
  33.  
  34. const
  35.    dos_error = -1;
  36.    stdin = 0;
  37.    stdout = 1;
  38.    stderr = 2;
  39.  
  40.    open_read    = $40;   {deny_nothing, allow_read}
  41.    open_write   = $41;   {deny_nothing, allow_write}
  42.    open_update  = $42;   {deny_nothing, allow_read+write}
  43.  
  44.  
  45. var
  46.    dos_regs:     registers;
  47.    dos_name:     dos_filename;
  48.    dos_message:  string[90];
  49.  
  50.  
  51. procedure dos_call(var regs:  registers);
  52. begin
  53.    msdos(regs);
  54.  
  55.    if (regs.flags and 1) = 1 then
  56.    begin
  57.       case regs.ax of
  58.          1:   dos_message := 'invalid subfunction code';
  59.          2:   dos_message := 'file not found';
  60.          3:   dos_message := 'directory not found';
  61.          4:   dos_message := 'too many open files';
  62.          5:   dos_message := 'access denied';
  63.          6:   dos_message := 'invalid file handle';
  64.          else dos_message := 'unknown DOS error';
  65.       end;
  66.  
  67.       writeln('ERROR: ',dos_message,'  ( ',dos_name,')');
  68.       regs.ax := dos_error;
  69.    end;
  70. end;
  71.  
  72.  
  73. function dos_create(name:    dos_filename;
  74.                     attrib:  integer):  dos_handle;
  75. begin
  76.    dos_regs.ax := $3c00;
  77.    dos_regs.ds := seg(dos_name);
  78.    dos_regs.dx := ofs(dos_name)+1;
  79.    dos_regs.cx := attrib;
  80.    dos_name := name + #0;
  81.    dos_call(dos_regs);
  82.    dos_create := dos_regs.ax;
  83. end;
  84.  
  85.  
  86. function dos_unlink(name:    dos_filename):  dos_handle;
  87. begin
  88.    dos_regs.ax := $4100;
  89.    dos_regs.ds := seg(dos_name);
  90.    dos_regs.dx := ofs(dos_name)+1;
  91.    dos_name := name + #0;
  92.    dos_call(dos_regs);
  93.    dos_unlink := dos_regs.ax;
  94. end;
  95.  
  96.  
  97. (* dos_open(name,mode) -> handle or dos_error *)
  98.  
  99. function dos_open(name:    dos_filename;
  100.                   mode:    integer):  dos_handle;
  101. var
  102.    try: integer;
  103.  
  104. const
  105.    retry_count = 3;
  106.  
  107. begin
  108.    dos_name := name + #0;
  109.  
  110.    for try := 1 to retry_count do
  111.    begin
  112.       dos_regs.ax := $3d00 + mode;
  113.       dos_regs.ds := seg(dos_name);
  114.       dos_regs.dx := ofs(dos_name)+1;
  115.       msdos(dos_regs);
  116.       dos_open := dos_regs.ax;
  117.       if (dos_regs.flags and 1) = 0 then
  118.          exit;
  119.    end;
  120.  
  121.    dos_open := dos_error;
  122. end;
  123.  
  124.  
  125. function dos_close(handle:  dos_handle):  dos_handle;
  126. begin
  127.    dos_regs.ax := $3e00;
  128.    dos_regs.bx := handle;
  129.    dos_call(dos_regs);
  130.    dos_close := dos_regs.ax;
  131. end;
  132.  
  133.  
  134. (* read(fd,buffer,bytecount) -> bytesread or dos_error *)
  135.  
  136. function dos_read(handle:  dos_handle;
  137.                   var buffer;
  138.                   bytes:   integer):   dos_handle;
  139. begin
  140.    dos_regs.ax := $3f00;
  141.    dos_regs.bx := handle;
  142.    dos_regs.cx := bytes;
  143.    dos_regs.ds := seg(buffer);
  144.    dos_regs.dx := ofs(buffer);
  145.    dos_call(dos_regs);
  146.    dos_read := dos_regs.ax;
  147. end;
  148.  
  149.  
  150. (* write(fd,buffer,bytecount) -> byteswritten or dos_error *)
  151.  
  152. function dos_write(handle:  dos_handle;
  153.                    var buffer;
  154.                    bytes:   integer):   dos_handle;
  155. begin
  156.    dos_regs.ax := $4000;
  157.    dos_regs.bx := handle;
  158.    dos_regs.cx := bytes;
  159.    dos_regs.ds := seg(buffer);
  160.    dos_regs.dx := ofs(buffer);
  161.    dos_call(dos_regs);
  162.    dos_write := dos_regs.ax;
  163.    if dos_regs.ax <> bytes then
  164.       writeln('ERROR: write failed (disk full?)');
  165. end;
  166.  
  167.  
  168. (* seek(fd,method,offset) -> new file position *)
  169.  
  170. function dos_seek(handle:  dos_handle;
  171.                   method:  dos_seek_methods;
  172.                   offset:  integer):  dos_handle;
  173. begin
  174.    dos_regs.ax := $4200 + ord(method);
  175.    dos_regs.bx := handle;
  176.    dos_regs.dx := offset;
  177.    dos_regs.cx := 0;
  178.    dos_call(dos_regs);
  179.    dos_seek := dos_regs.ax;
  180. end;
  181.  
  182.  
  183. (* lseek(fd,method,roffset) -> new file position *)
  184.  
  185. function dos_lseek(handle:  dos_handle;
  186.                    method:  dos_seek_methods;
  187.                    offset:  real):  real;
  188. var
  189.    dxv:  real;
  190.  
  191. begin
  192.    dos_regs.ax := $4200 + ord(method);
  193.    dos_regs.bx := handle;
  194.    dos_regs.cx := itrunc(offset / 65536.0);
  195.  
  196.    dxv := offset - 65536.0*int(dos_regs.cx);
  197.    if dxv > int($7fff) then
  198.       dxv := dxv - 65536.0;
  199.  
  200.    if dxv = $8000 then
  201.       dos_regs.dx := $8000
  202.    else
  203.       dos_regs.dx := itrunc(dxv);
  204.  
  205.    dos_call(dos_regs);
  206.  
  207.    if dos_regs.ax = dos_error then
  208.       dos_lseek := dos_error
  209.    else
  210.       dos_lseek := int(dos_regs.dx) * 65536.0 +
  211.                    int(dos_regs.ax shr 1) * 2.0 +
  212.                    int(dos_regs.ax and 1);
  213. end;
  214.  
  215.  
  216. (* dos_file_times(fd,time_(set get),time,date); *)
  217.  
  218. procedure dos_file_times(fd:       dos_handle;
  219.                          func:     dos_time_functions;
  220.                          var time: integer;
  221.                          var date: integer);
  222. begin
  223.    dos_regs.ax := $5700 + ord(func);
  224.    dos_regs.bx := fd;
  225.    dos_regs.cx := time;
  226.    dos_regs.dx := date;
  227.    dos_call(dos_regs);
  228.    time := dos_regs.cx;
  229.    date := dos_regs.dx;
  230. end;
  231.  
  232.  
  233.  
  234.