home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TOOL_USE.ZIP / OPENSHAR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-03-01  |  3.7 KB  |  149 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. (*
  14.  * OpenShare - TPAS 5.0 unit for shared text files (3-1-89)
  15.  *
  16.  * Use AssignText instead of Assign to create a text file
  17.  * with full DOS 3.x file sharing (as implemented for binary
  18.  * files by MDosIO)
  19.  *
  20.  *)
  21.  
  22. {$i prodef.inc}
  23. {$L+,D+}
  24.  
  25. unit OpenShare;
  26.  
  27. interface
  28.  
  29.    Uses Dos,MdosIO;
  30.  
  31.    Procedure AssignText(var F:  Text; FileName:  dos_filename);
  32.       (* use instead of Assign() for shared text files *)
  33.  
  34.  
  35. implementation
  36.  
  37. {$F+}
  38.  
  39. (* -------------------------------------------------------- *)
  40. function text_read(var F:  TextRec):  word;
  41. begin
  42.   {dos_name := F.Name;}
  43.    F.BufEnd := dos_read(F.Handle,F.BufPtr^,F.BufSize);
  44.    F.BufPos := 0;
  45.    text_read := 0;
  46. end;
  47.  
  48.  
  49. (* -------------------------------------------------------- *)
  50. function text_write(var F:  TextRec):  word;
  51. begin
  52.   {dos_name := F.Name;}
  53.    dos_write(F.Handle,F.BufPtr^,F.BufPos);
  54.    F.BufPos := 0;
  55.    F.BufEnd := 0;
  56.    text_write := 0;
  57. end;
  58.  
  59.  
  60. (* -------------------------------------------------------- *)
  61. function text_close(var F:  TextRec):  word;
  62. begin
  63.   {dos_name := F.Name;}
  64.    dos_close(F.Handle);
  65.    F.BufPos := 0;
  66.    F.BufEnd := 0;
  67.    text_close := 0;
  68. end;
  69.  
  70.  
  71. (* -------------------------------------------------------- *)
  72. function do_nothing(var F:  TextRec):  word;
  73. begin
  74.    do_nothing := 0;
  75. end;
  76.  
  77.  
  78. (* -------------------------------------------------------- *)
  79. function text_open(var F:  TextRec):  word;
  80. var
  81.    fname: dos_filename;
  82.  
  83. begin
  84.    F.CloseFunc := @text_close;       {Set close function}
  85.    F.FlushFunc := @do_nothing;       {Set Flush function}
  86.    fname := F.Name;
  87.    fname[0] := chr(pos(#0,fname)-1);
  88.  
  89.    if F.Mode = fmInput then
  90.    begin
  91.       F.Handle := dos_open(fname,open_read);    {reset}
  92.       F.InOutFunc := @text_read;     {Set Input function}
  93.    end
  94.    else 
  95.    
  96.    if F.Mode = fmOutput then
  97.    begin
  98.       F.Handle := dos_create(fname);           {rewrite}
  99.       F.InOutFunc := @text_write;    {Set Output function}
  100.    end
  101.    else
  102.  
  103.    begin
  104.       F.Handle := dos_open(fname,open_update);  {append}
  105.       if F.Handle = dos_error then
  106.          F.Handle := dos_create(fname)          {automatic rewrite}
  107.       else
  108.          dos_find_eof(F.Handle);
  109.  
  110.       F.Mode := fmOutput;            {Set Output Only mode}
  111.       F.InOutFunc := @text_write;    {Set Output function}
  112.    end;
  113.  
  114.    F.BufPos := 0;                   {Reset buffer ptr to 1st char.}
  115.    F.BufEnd := 0;                   {Buffer is now empty}
  116.  
  117.    if F.Handle = dos_error then
  118.       text_open := dos_regs.AX
  119.    else
  120.       text_open := 0;
  121. end;
  122.  
  123.  
  124. (* -------------------------------------------------------- *)
  125. procedure AssignText(var F:  text; FileName:  dos_filename);
  126.    (* use instead of Assign() for shared text files *)
  127. var
  128.    I:  integer;
  129.    P:  TextRec absolute F;
  130.  
  131. begin
  132.    P.Handle   := $FFFF;
  133.    P.Mode     := fmClosed;               {Indicate the file is not yet open}
  134.    P.BufSize  := SizeOf(P.Buffer);       {Set size of default buffer (128)}
  135.    P.BufPtr   := @P.Buffer;              {Set up pointer to default buffer}
  136.    P.OpenFunc := @text_open;             {Set up pointer to OPEN function}
  137.  
  138.    dos_name := FileName;
  139.    for I := 1 to length(dos_name) do     {Set up asciiz filename}
  140.       P.Name[I-1] := dos_name[I];
  141.  
  142.    for I := length(dos_name) to sizeof(P.Name)-1 do
  143.       P.Name[I] := Chr(0);
  144. end;
  145.  
  146.  
  147. end.
  148.  
  149.