Category : Files from Magazines
Archive   : PCTV1N4.ZIP
Filename : UTRANSFE.PAS

 
Output of file : UTRANSFE.PAS contained in archive : PCTV1N4.ZIP
(*
** File: utransfer.pas
** Purpose: Transfer TSR procedures for Turbo Pascal
** Author: (c) 1990 by Tom Swan
*)

unit utransfer;

interface

uses crt, dos;

var

transferError : Byte; { Non-zero = error }

function GetBlock( destination : pointer; maxSize : word ) : word;
function PutBlock( source : pointer; size : word; typeCode : byte ) : word;
procedure ClearBlock;
procedure Status( var bufSize : word; var typeCode, errorCode : byte );

implementation

const
TSRINT = $64; { The transfer TSR's interrupt number }
FN_GETBLOCK = 1; { Transfer function #1 (get block) }
FN_PUTBLOCK = 2; { Transfer function #2 (put block) }
FN_CLRBLOCK = 3; { Transfer function #3 (clear block) }
FN_STATUS = 4; { Transfer function #4 (status check) }
CF = $01; { Position of CF flag in registers.flags }
ZF = $40; { Position of ZF flag in registers.flags }

{- Private procedure to set or reset global error code }
procedure checkForError( flags : word );
var
bufSize : word;
typeCode : byte;
begin
if ((flags AND CF)<>0)
then Status( bufSize, typeCode, transferError )
else transferError := 0
end; { checkForError }

{- Retrieve data from TSR. Return no. of bytes transferred }
function GetBlock( destination : pointer; maxSize : word ) : word;
var
reg : registers;
begin
with reg do
begin
ah := FN_GETBLOCK; { Transfer TSR function number }
cx := maxSize; { Maximum transfer size }
es := Seg( destination^ ); { es = data segment address }
di := Ofs( destination^ ); { di = data offset address }
repeat
intr( TSRINT, reg ) { Call transfer function }
until ((flags AND ZF)=0); { i.e. until not busy }
GetBlock := cx; { Pass transfer size back }
checkForError( flags )
end { with }
end; { GetBlock }

{- Transfer block to TSR. Return no. of bytes transferred. }
function PutBlock( source : pointer; size : word; typeCode : byte ) : word;
var
reg : registers;
begin
with reg do
begin
ah := FN_PUTBLOCK; { Transfer TSR function number }
cx := size; { Transfer size }
dl := typeCode; { Optional data-type code }
ds := Seg( source^ ); { es = data segment address }
si := Ofs( source^ ); { di = data offset address }
repeat
intr( TSRINT, reg ) { Call transfer function }
until ((flags AND ZF)=0); { i.e. until not busy }
PutBlock := cx; { Pass transfer size back }
checkForError( flags )
end { with }
end; { PutBlock }

{- Erase any data stored in TSR }
procedure ClearBlock;
var
reg : registers;
begin
with reg do
begin
ah := FN_CLRBLOCK; { Transfer TSR function number }
repeat
intr( TSRINT, reg ) { Call transfer function }
until ((flags AND ZF)=0); { i.e. until not busy }
checkForError( flags )
end { with }
end; { ClearBlock }

{- Get status information from TSR. }
procedure Status( var bufSize : word; var typeCode, errorCode : byte );
var
reg : registers;
begin
with reg do
begin
ah := FN_STATUS; { Transfer TSR function number }
intr( TSRINT, reg ); { Call transfer function }
bufSize := cx; { Pass buffer size back }
typeCode := dl; { Pass data-type code back }
errorCode := dh { Pass error code back }
end { with }
end; { Status }

end. { utransfer }


  3 Responses to “Category : Files from Magazines
Archive   : PCTV1N4.ZIP
Filename : UTRANSFE.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/