home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / SYSPC22.ZIP / MDOSIO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-12-01  |  7.8 KB  |  323 lines
  1.  
  2. (*
  3.  * mdosio - Mini library for interface to DOS v3 file access functions
  4.  *
  5.  * (C) 1987 Samuel H. Smith,  16-Jan-88 (rev. 12-01-88)
  6.  *
  7.  *)
  8.  
  9. {$i prodef.inc}
  10.  
  11. unit MDosIO;
  12.  
  13. interface
  14.  
  15.    uses Dos;
  16.  
  17.    type
  18.       dos_filename = string[64];
  19.       dos_handle   = word;
  20.  
  21.       long_integer = record
  22.          lsw: word;
  23.          msw: word;
  24.       end;
  25.  
  26.       seek_modes = (seek_start {0},
  27.                     seek_cur   {1},
  28.                     seek_end   {2});
  29.  
  30.       open_modes = (open_read  {h40},     {deny_nothing, allow_read}
  31.                     open_write {h41},     {deny_nothing, allow_write}
  32.                     open_update{h42});    {deny_nothing, allow_read+write}
  33.  
  34.       dos_time_functions = (time_get,
  35.                             time_set);
  36.  
  37.    const
  38.       dos_error    = $FFFF; {file handle after an error}
  39.  
  40.    var
  41.       dos_regs:     registers;
  42.       dos_name:     dos_filename;
  43.  
  44.  
  45.    procedure dos_call;
  46.  
  47.    function dos_open(name:      dos_filename;
  48.                      mode:      open_modes):  dos_handle;
  49.  
  50.    function dos_create(name:    dos_filename): dos_handle;
  51.  
  52.    function dos_read( handle:   dos_handle;
  53.                       var       buffer;
  54.                       bytes:    word): word;
  55.  
  56.    procedure dos_write(handle:  dos_handle;
  57.                        var      buffer;
  58.                        bytes:   word);
  59.  
  60.    function dos_write_failed:   boolean;
  61.  
  62.    procedure dos_lseek(handle:  dos_handle;
  63.                        offset:  longint;
  64.                        method:  seek_modes);
  65.  
  66.    procedure dos_rseek(handle:  dos_handle;
  67.                        recnum:  word;
  68.                        recsiz:  word;
  69.                        method:  seek_modes);
  70.  
  71.    function dos_tell: longint;
  72.  
  73.    procedure dos_find_eof(fd:   dos_handle);
  74.  
  75.    procedure dos_close(handle:  dos_handle);
  76.  
  77.    procedure dos_unlink(name:   dos_filename);
  78.  
  79.    procedure dos_file_times(fd:       dos_handle;
  80.                             func:     dos_time_functions;
  81.                             var time: word;
  82.                             var date: word);
  83.  
  84.    function dos_jdate(time,date: word): longint;
  85.  
  86. implementation
  87.  
  88.  
  89.  
  90. (* -------------------------------------------------------- *)
  91. procedure dos_call;
  92. var
  93.    msg:  string;
  94. begin
  95.    msdos(dos_regs);
  96.  
  97.    if (dos_regs.flags and Fcarry) <> 0 then
  98.    begin
  99.       case dos_regs.ax of
  100.          2:   msg := 'file not found';
  101.          3:   msg := 'dir not found';
  102.          4:   msg := 'too many open files';
  103.          5:   msg := 'access denied';
  104.          else str(dos_regs.ax,msg);
  105.       end;
  106. {$I-}
  107.       writeln('DOS error [',msg,'] on ',dos_name);
  108. {$i+}
  109.       dos_regs.ax := dos_error;
  110.    end;
  111. end;
  112.  
  113.  
  114. (* -------------------------------------------------------- *)
  115. function dos_open(name:    dos_filename;
  116.                   mode:    open_modes):  dos_handle;
  117. var
  118.    try: integer;
  119. const
  120.    retry_count = 3;
  121. begin
  122.    dos_name := name + #0;
  123.  
  124.    for try := 1 to retry_count do
  125.    begin
  126.       dos_regs.ax := $3d40 + ord(mode);
  127.       dos_regs.ds := seg(dos_name);
  128.       dos_regs.dx := ofs(dos_name)+1;
  129.       msdos(dos_regs);
  130.  
  131.       if (dos_regs.flags and Fcarry) = 0 then
  132.       begin
  133.          dos_open := dos_regs.ax;
  134.          exit;
  135.       end;
  136.    end;
  137.  
  138.    dos_open := dos_error;
  139. end;
  140.  
  141.  
  142. (* -------------------------------------------------------- *)
  143. function dos_create(name:    dos_filename): dos_handle;
  144. begin
  145.    dos_regs.ax := $3c00;
  146.    dos_name := name + #0;
  147.    dos_regs.ds := seg(dos_name);
  148.    dos_regs.dx := ofs(dos_name)+1;
  149.    dos_regs.cx := 0;   {attrib}
  150.    dos_call;
  151.    dos_create := dos_regs.ax;
  152. end;
  153.  
  154.  
  155. (* -------------------------------------------------------- *)
  156. function dos_read( handle:  dos_handle;
  157.                    var      buffer;
  158.                    bytes:   word): word;
  159. begin
  160.    dos_regs.ax := $3f00;
  161.    dos_regs.bx := handle;
  162.    dos_regs.cx := bytes;
  163.    dos_regs.ds := seg(buffer);
  164.    dos_regs.dx := ofs(buffer);
  165.    dos_call;
  166.    dos_read := dos_regs.ax;
  167. end;
  168.  
  169.  
  170. (* -------------------------------------------------------- *)
  171. procedure dos_write(handle:  dos_handle;
  172.                     var      buffer;
  173.                     bytes:   word);
  174. begin
  175.    dos_regs.ax := $4000;
  176.    dos_regs.bx := handle;
  177.    dos_regs.cx := bytes;
  178.    dos_regs.ds := seg(buffer);
  179.    dos_regs.dx := ofs(buffer);
  180.    dos_call;
  181.    dos_regs.cx := bytes;
  182. end;
  183.  
  184. function dos_write_failed: boolean;
  185. begin
  186.    dos_write_failed := dos_regs.ax <> dos_regs.cx;
  187. end;
  188.  
  189.  
  190. (* -------------------------------------------------------- *)
  191. procedure dos_lseek(handle:  dos_handle;
  192.                     offset:  longint;
  193.                     method:  seek_modes);
  194. var
  195.    pos:  long_integer absolute offset;
  196.  
  197. begin
  198.    dos_regs.ax := $4200 + ord(method);
  199.    dos_regs.bx := handle;
  200.    dos_regs.cx := pos.msw;
  201.    dos_regs.dx := pos.lsw;
  202.    dos_call;
  203. end;
  204.  
  205.  
  206. (* -------------------------------------------------------- *)
  207. procedure dos_rseek(handle:  dos_handle;
  208.                     recnum:  word;
  209.                     recsiz:  word;
  210.                     method:  seek_modes);
  211. var
  212.    offset: longint;
  213.    pos:    long_integer absolute offset;
  214.  
  215. begin
  216.    offset := longint(recnum) * longint(recsiz);
  217.    dos_regs.ax := $4200 + ord(method);
  218.    dos_regs.bx := handle;
  219.    dos_regs.cx := pos.msw;
  220.    dos_regs.dx := pos.lsw;
  221.    dos_call;
  222. end;
  223.  
  224.  
  225. (* -------------------------------------------------------- *)
  226. function dos_tell: longint;
  227.   {call immediately after dos_lseek or dos_rseek}
  228. var
  229.    pos:  long_integer;
  230.    li:   longint absolute pos;
  231. begin
  232.    pos.lsw := dos_regs.ax;
  233.    pos.msw := dos_regs.dx;
  234.    dos_tell := li;
  235. end;
  236.  
  237.  
  238. (* -------------------------------------------------------- *)
  239. procedure dos_find_eof(fd: dos_handle);
  240.    {find end of file, skip backward over ^Z eof markers}
  241. var
  242.    b: char;
  243.    n: word;
  244.    p: longint;
  245.  
  246. begin
  247.    dos_lseek(fd,0,seek_end);
  248.    p := dos_tell-1;
  249.    if p < 0 then
  250.       exit;
  251.  
  252.    p := p and $FFFF80;   {round to last 'sector'}
  253.    {search forward for the eof marker}
  254.    dos_lseek(fd,p,seek_start);
  255.    repeat
  256.       n := dos_read(fd,b,1);
  257.       inc(p);
  258.    until (n = 0) or (b = ^Z);
  259.  
  260.    {backup to overwrite the eof marker}
  261.    if b = ^Z then
  262.       dos_lseek(fd,-1,seek_cur);
  263. end;
  264.  
  265.  
  266. (* -------------------------------------------------------- *)
  267. procedure dos_close(handle:  dos_handle);
  268. begin
  269.    dos_regs.ax := $3e00;
  270.    dos_regs.bx := handle;
  271.    msdos(dos_regs);  {dos_call;}
  272. end;
  273.  
  274.  
  275. (* -------------------------------------------------------- *)
  276. procedure dos_unlink(name:    dos_filename);
  277.    {delete a file, no error message if file doesn't exist}
  278. begin
  279.    dos_regs.ax := $4100;
  280.    dos_name := name + #0;
  281.    dos_regs.ds := seg(dos_name);
  282.    dos_regs.dx := ofs(dos_name)+1;
  283.    msdos(dos_regs);
  284. {dos_call;}
  285. end;
  286.  
  287.  
  288. (* -------------------------------------------------------- *)
  289. procedure dos_file_times(fd:       dos_handle;
  290.                          func:     dos_time_functions;
  291.                          var time: word;
  292.                          var date: word);
  293. begin
  294.    dos_regs.ax := $5700 + ord(func);
  295.    dos_regs.bx := fd;
  296.    dos_regs.cx := time;
  297.    dos_regs.dx := date;
  298.    dos_call;
  299.    time := dos_regs.cx;
  300.    date := dos_regs.dx;
  301. end;
  302.  
  303.  
  304. (* -------------------------------------------------------- *)
  305. function dos_jdate(time,date: word): longint;
  306. begin
  307.  
  308. (***
  309.      write(' d=',date:5,' t=',time:5,' ');
  310.      write('8',   (date shr 9) and 127:1); {year}
  311.      write('/',   (date shr 5) and  15:2); {month}
  312.      write('/',   (date      ) and  31:2); {day}
  313.      write(' ',   (time shr 11) and 31:2); {hour}
  314.      write(':',   (time shr  5) and 63:2); {minute}
  315.      write(':',   (time shl  1) and 63:2); {second}
  316.      writeln(' j=', (longint(date) shl 16) + longint(time));
  317.  ***)
  318.  
  319.    dos_jdate := (longint(date) shl 16) + longint(time);
  320. end;
  321.  
  322. end.
  323.