home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / sampler / 04 / diverse / usrfile.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-10-18  |  3.5 KB  |  133 lines
  1. {$R-,I+,N-}
  2. PROGRAM UsrFile;
  3.   USES Crt, DOS;
  4. CONST
  5.   UsrSiz       = 255;
  6.   IO_NotOutput = 105;
  7.   IO_FileFull  = 101;
  8.   IO_Invalid   = 6;
  9. TYPE
  10.   String255 = STRING[255];
  11.   CharBuf = ARRAY[0..127] OF Char;
  12.   FakeFile = ARRAY[0..UsrSiz] OF Char;
  13.   TextRec = RECORD
  14.               Handle    : Word;
  15.               Mode      : Word;
  16.               BufSize   : Word;
  17.               Private   : Word;
  18.               BufPos    : Word;
  19.               BufEnd    : Word;
  20.               BufPtr    : ^CharBuf;
  21.               OpenFunc  : pointer;
  22.               InOutFunc : pointer;
  23.               FlushFunc : pointer;
  24.               CloseFunc : pointer;
  25.               UFilePos  : Word;
  26.               UFileSiz  : Word;
  27.               Data      : ^FakeFile;
  28.               UserData  : ARRAY[1..8] OF Byte;
  29.               Name      : ARRAY[0..79] OF Char;
  30.               Buffer    : CharBuf;
  31.             END;
  32. VAR
  33.   UFile : Text;
  34.   CH      : Char;
  35.   N, D    : Integer;
  36.  
  37. {$F+}{Start making all routines FAR}
  38.  
  39.   FUNCTION UsrOpen(VAR F : TextRec) : Integer;
  40.   BEGIN
  41.     UsrOpen := 0;
  42.     WITH F DO
  43.       IF Mode = fmOutput THEN
  44.         BEGIN
  45.           UFileSiz := 0;
  46.           UFilePos := 0;
  47.         END
  48.       ELSE UsrOpen := IO_Invalid;
  49.   END;
  50.  
  51.   FUNCTION UsrClose(VAR F : TextRec) : Integer;
  52.   BEGIN
  53.     UsrClose := 0;
  54.   END;
  55.  
  56.   FUNCTION UsrOutput(VAR F : TextRec) : Integer;
  57.   BEGIN
  58.     UsrOutput := 0;
  59.     WITH F DO
  60.       IF Mode = fmOutput THEN
  61.         BEGIN
  62.           IF UFilePos+BufPos >= UsrSiz THEN UsrOutput := IO_FileFull
  63.           ELSE
  64.             BEGIN
  65.               Move(BufPtr^, Data^[UFilePos], BufPos);
  66.               UFilePos := UFilePos+BufPos;
  67.               IF UFilePos > UFileSiz THEN UFileSiz := UFilePos;
  68.               BufPos := 0;
  69.             END;
  70.         END
  71.       ELSE
  72.         IF Mode = fmClosed THEN UsrOutput := IO_NotOutput
  73.         ELSE UsrOutput := IO_Invalid;
  74.   END;
  75.  
  76. {$F-}{Stop making all routines FAR}
  77.  
  78.   FUNCTION ReadUsr(VAR F : Text) : String255;
  79.   VAR Temp : String255;
  80.   BEGIN
  81.     WITH TextRec(F) DO
  82.       BEGIN
  83.         Move(Data^, Temp[1], UFileSiz);
  84.         Temp[0]  := Chr(UFileSiz);
  85.         UFileSiz := 0;
  86.         UFilePos := 0;
  87.       END;
  88.     ReadUsr := Temp;
  89.   END;
  90.  
  91.   PROCEDURE AssignUsr(VAR F : Text);
  92.   BEGIN
  93.     WITH TextRec(F) DO
  94.       BEGIN
  95.         Mode      := fmClosed;
  96.         BufSize   := 127;
  97.         BufPtr    := @buffer;
  98.         OpenFunc  := @UsrOpen;
  99.         CloseFunc := @UsrClose;
  100.         InOutFunc := @UsrOutput;
  101.         FlushFunc := @UsrOutput;
  102.         Name[0]   := #0;
  103.         UFileSiz  := 0;
  104.         UFilePos  := 0;
  105.         New(Data);
  106.       END;
  107.   END;
  108.  
  109. BEGIN
  110.   ClrScr;
  111.   Write('Now writing several variables to "UFile" -- ');
  112.   WriteLn('they will become a single STRING.');
  113.   AssignUsr(UFile);
  114.   Rewrite(UFile);
  115.   Write(UFile, 'PI/4 = ', Pi/4:1:11);
  116.   Write(UFile, '  The biggest Long Integer is ', MaxLongInt);
  117.   WriteLn('Press a key to see the result.');
  118.   CH := ReadKey;
  119.   WriteLn; WriteLn('"', ReadUsr(UFile), '"'); WriteLn;
  120.   WriteLn('Now the UFile is clear, ready to accept input again');
  121.   N := 355; D := 113;
  122.   Write(UFile, N, '/', D, ' ', Chr(247), ' PI.');
  123.   Write(UFile, ' PI=', Pi:1:11, ' and ', N, '/', D, '=', N/D:1:11);
  124.   WriteLn('Press a key to see the result.');
  125.   CH := ReadKey;
  126.   WriteLn; WriteLn('"', ReadUsr(UFile), '"'); WriteLn;
  127.   WriteLn('NOW to overload the UFile -- we will get a special I/O error');
  128.   WriteLn('Press a key to see the result.');
  129.   CH := ReadKey;
  130.   FOR N := 1 TO 9 DO
  131.     Write(UFile, 'THIS string has 32 characters. ');
  132. END.
  133.