home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0000 - 0009 / ibm0000-0009 / ibm0003.tar / ibm0003 / TPOWER53.ZIP / TPSRC2.ARC / TPSTRDEV.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-07-10  |  2.7 KB  |  122 lines
  1. {$S-,R-,V-,I-,B-,F-}
  2.  
  3. {$IFNDEF Ver40}
  4.   {$I OMINUS.INC}
  5. {$ENDIF}
  6.  
  7. {*********************************************************}
  8. {*                  TPSTRDEV.PAS 5.07                    *}
  9. {*        Copyright (c) TurboPower Software 1987.        *}
  10. {* Portions copyright (c) Sunny Hill Software 1985, 1986 *}
  11. {*     and used under license to TurboPower Software     *}
  12. {*                 All rights reserved.                  *}
  13. {*********************************************************}
  14.  
  15. unit TPStrDev;
  16.   {-Routines for reading and writing strings}
  17.  
  18. interface
  19.  
  20. var
  21.   TPStr : Text;
  22.  
  23. procedure ReadStr(var S : string);
  24.   {-'Read' a string into S from our string buffer}
  25.  
  26. function ReturnStr : string;
  27.   {-Return the contents of our string buffer}
  28.  
  29.   {==========================================================================}
  30.  
  31. implementation
  32.  
  33. type
  34.   {text buffer}
  35.   TextBuffer = array[0..65520] of Byte;
  36.  
  37.   {structure of a Turbo File Interface Block}
  38.   FIB =
  39.     record
  40.       Handle : Word;
  41.       Mode : Word;
  42.       BufSize : Word;
  43.       Private : Word;
  44.       BufPos : Word;
  45.       BufEnd : Word;
  46.       BufPtr : ^TextBuffer;
  47.       OpenProc : Pointer;
  48.       InOutProc : Pointer;
  49.       FlushProc : Pointer;
  50.       CloseProc : Pointer;
  51.       UserData : array[1..16] of Byte;
  52.       Name : array[0..79] of Char;
  53.       Buffer : array[0..127] of Char;
  54.     end;
  55. const
  56.   FMClosed = $D7B0;
  57. var
  58.   StrBuf : string;
  59.   StrLen : Byte absolute StrBuf;
  60.  
  61.   procedure ReadStr(var S : string);
  62.     {-'Read' a string into S from our string buffer}
  63.   begin
  64.     S := StrBuf;
  65.     StrLen := 0;
  66.     with FIB(TPStr) do
  67.       BufPos := 0;
  68.   end;
  69.  
  70.   function ReturnStr : string;
  71.     {-Return the contents of our string buffer}
  72.   begin
  73.     ReturnStr := StrBuf;
  74.     StrLen := 0;
  75.     with FIB(TPStr) do
  76.       BufPos := 0;
  77.   end;
  78.  
  79.   {$F+}
  80.   function StrOut(var F : FIB) : Word;
  81.     {-Update the length byte of StrBuf}
  82.   begin
  83.     {update the length byte}
  84.     with F do
  85.       StrLen := BufPos;
  86.  
  87.     {return success flag}
  88.     StrOut := 0;
  89.   end;
  90.  
  91.   function StrZero(var F : FIB) : Word;
  92.     {-Return success flag, but do nothing}
  93.   begin
  94.     StrZero := 0;
  95.   end;
  96.   {$F-}
  97.  
  98.   procedure AssignStr(var F : Text);
  99.     {-Initialize the File Interface Block}
  100.   begin
  101.     with FIB(F) do begin
  102.       Mode := FMClosed;
  103.       OpenProc := @StrZero;
  104.       FlushProc := @StrOut;
  105.       CloseProc := @StrZero;
  106.       InOutProc := @StrOut;
  107.       BufEnd := 0;
  108.       BufPos := 0;
  109.       BufPtr := @StrBuf[1];
  110.       BufSize := 255;
  111.       Name[0] := #0;
  112.     end;
  113.  
  114.     {start with an empty string buffer}
  115.     StrLen := 0;
  116.   end;
  117.  
  118. begin
  119.   AssignStr(TPStr);
  120.   Rewrite(TPStr);
  121. end.
  122.