home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / PCTV1N4.ZIP / UTRANSFE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-07-28  |  3.6 KB  |  114 lines
  1. (*
  2. **    File:    utransfer.pas
  3. **    Purpose: Transfer TSR procedures for Turbo Pascal
  4. **    Author:  (c) 1990 by Tom Swan
  5. *)
  6.  
  7. unit utransfer;
  8.  
  9. interface
  10.  
  11. uses crt, dos;
  12.  
  13. var
  14.  
  15.    transferError : Byte;      { Non-zero = error }
  16.  
  17. function GetBlock( destination : pointer; maxSize : word ) : word;
  18. function PutBlock( source : pointer; size : word; typeCode : byte ) : word;
  19. procedure ClearBlock;
  20. procedure Status( var bufSize : word; var typeCode, errorCode : byte );
  21.  
  22. implementation
  23.  
  24. const
  25.    TSRINT = $64;     { The transfer TSR's interrupt number }
  26.    FN_GETBLOCK = 1;  { Transfer function #1 (get block) }
  27.    FN_PUTBLOCK = 2;  { Transfer function #2 (put block) }
  28.    FN_CLRBLOCK = 3;  { Transfer function #3 (clear block) }
  29.    FN_STATUS = 4;    { Transfer function #4 (status check) }
  30.    CF = $01;         { Position of CF flag in registers.flags }
  31.    ZF = $40;         { Position of ZF flag in registers.flags }
  32.  
  33. {- Private procedure to set or reset global error code }
  34. procedure checkForError( flags : word );
  35. var
  36.    bufSize : word;
  37.    typeCode : byte;
  38. begin
  39.    if ((flags AND CF)<>0)
  40.       then Status( bufSize, typeCode, transferError )
  41.       else transferError := 0
  42. end; { checkForError }
  43.  
  44. {- Retrieve data from TSR. Return no. of bytes transferred }
  45. function GetBlock( destination : pointer; maxSize : word ) : word;
  46. var
  47.    reg : registers;
  48. begin
  49.    with reg do
  50.    begin
  51.       ah := FN_GETBLOCK;         { Transfer TSR function number }
  52.       cx := maxSize;             { Maximum transfer size }
  53.       es := Seg( destination^ ); { es = data segment address }
  54.       di := Ofs( destination^ ); { di = data offset address }
  55.       repeat
  56.          intr( TSRINT, reg )     { Call transfer function }
  57.       until ((flags AND ZF)=0);  { i.e. until not busy }
  58.       GetBlock := cx;            { Pass transfer size back }
  59.       checkForError( flags )
  60.    end { with }
  61. end; { GetBlock }
  62.  
  63. {- Transfer block to TSR. Return no. of bytes transferred. }
  64. function PutBlock( source : pointer; size : word; typeCode : byte ) : word;
  65. var
  66.    reg : registers;
  67. begin
  68.    with reg do
  69.    begin
  70.       ah := FN_PUTBLOCK;         { Transfer TSR function number }
  71.       cx := size;                { Transfer size }
  72.       dl := typeCode;            { Optional data-type code }
  73.       ds := Seg( source^ );      { es = data segment address }
  74.       si := Ofs( source^ );      { di = data offset address }
  75.       repeat
  76.          intr( TSRINT, reg )     { Call transfer function }
  77.       until ((flags AND ZF)=0);  { i.e. until not busy }
  78.       PutBlock := cx;            { Pass transfer size back }
  79.       checkForError( flags )
  80.    end { with }
  81. end; { PutBlock }
  82.  
  83. {- Erase any data stored in TSR }
  84. procedure ClearBlock;
  85. var
  86.    reg : registers;
  87. begin
  88.    with reg do
  89.    begin
  90.       ah := FN_CLRBLOCK;         { Transfer TSR function number }
  91.       repeat
  92.          intr( TSRINT, reg )     { Call transfer function }
  93.       until ((flags AND ZF)=0);  { i.e. until not busy }
  94.       checkForError( flags )
  95.    end { with }
  96. end; { ClearBlock }
  97.  
  98. {- Get status information from TSR. }
  99. procedure Status( var bufSize : word; var typeCode, errorCode : byte );
  100. var
  101.    reg : registers;
  102. begin
  103.    with reg do
  104.    begin
  105.       ah := FN_STATUS;           { Transfer TSR function number }
  106.       intr( TSRINT, reg );       { Call transfer function }
  107.       bufSize := cx;             { Pass buffer size back }
  108.       typeCode := dl;            { Pass data-type code back }
  109.       errorCode := dh            { Pass error code back }
  110.    end { with }
  111. end; { Status }
  112.  
  113. end. { utransfer }
  114.