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