home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TP_ADV.ZIP / LIST0602.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-07-31  |  2.8 KB  |  92 lines
  1. Unit TFDD;
  2. { This is the first sample Text File Device Driver.  Its task  }
  3. { is to send output from a Write or a Writeln statement into a }
  4. { string variable somewhere in memory.  It will also introduce }
  5. { you to the structure of a Text File Device Driver, and what  }
  6. { is necessary to implement one.                               }
  7. Interface
  8.  
  9. Uses
  10.   Dos;
  11.  
  12. Type
  13.   BufferType = String;
  14.  
  15. Var
  16.   theBuffer : BufferType;
  17.   BufferPtr : Pointer;
  18.  
  19. Procedure AssignDev( Var F : Text );
  20. { This procedure will set up the file variable F to point to  }
  21. { each of the necessary support routines.  It also will       }
  22. { initialize each of the separate data fields within the text }
  23. { file variable that was passed to this routine.              }
  24.  
  25. Implementation
  26.  
  27. {$F+}                   { Far Calls REQUIRED in a TFDD       }
  28.  
  29. Function NulRoutine( Var F : TextRec ) : Integer;
  30. { This routine will be assigned to any of the functions       }
  31. { within the file routines that are not necessary.  If will   }
  32. { return a result of 0, which is reported for IOResult.  This }
  33. { way any function that calls this is guaranteed to return    }
  34. { with no errors.                                             }
  35. Begin
  36.   NulRoutine := 0;      { Set function result to 0 = No Error }
  37. End;
  38.  
  39. Function InOutRoutine( Var F : TextRec ) : Integer;
  40. { This is the routine that will handle the outputting of the  }
  41. { information to the memory location used for the buffer.  It }
  42. { is called anytime the program calls a Write or a Writeln    }
  43. { statement.                                                  }
  44. Var
  45.   I : Integer;          { Loop counter used to write buffer   }
  46.  
  47. Begin
  48.   With F Do
  49.   Begin
  50.     If Mode = fmOutput Then
  51.     Begin
  52.       If BufPos > BufEnd Then
  53.       Begin
  54.         For I := BufEnd To ( BufPos - 1 ) Do
  55.           If( ( BufferType( BufferPtr^ )[0] ) < #255 )Then
  56.             BufferType( BufferPtr^ ) :=
  57.                   BufferType( BufferPtr^ ) + BufPtr^[I];
  58.       End;
  59.       BufPos := BufEnd;
  60.       InOutRoutine := 0;
  61.     End
  62.     Else
  63.       InOutRoutine := 105;
  64.   End;
  65. End;
  66.  
  67. Procedure AssignDev( Var F : Text );
  68. { This procedure will set up the file variable F to point to  }
  69. { each of the necessary support routines.  It also will       }
  70. { initialize each of the separate data fields within the text }
  71. { file variable that was passed to this routine.              }
  72. Begin
  73.   With TextRec( F ) Do
  74.   Begin
  75.     Handle := $FFFF;
  76.     Mode := fmClosed;
  77.     BufSize := SizeOf( Buffer );
  78.     BufPtr := @Buffer;
  79.     OpenFunc := @NulRoutine;
  80.     FlushFunc := @NulRoutine;
  81.     CloseFunc := @NulRoutine;
  82.     InOutFunc := @InOutRoutine;
  83.     Name[0] := #0;
  84.   End;
  85. End;
  86.  
  87. Begin
  88.   BufferPtr := @theBuffer;
  89.   FillChar( BufferPtr^, SizeOf( BufferPtr^ ), #0 );
  90. End.
  91.  
  92.