home *** CD-ROM | disk | FTP | other *** search
-
- { Copyright (c) 1985, 87 by Borland International, Inc. }
-
- { Demonstrations-Unit AuxInOut aus Kapitel 25 }
- unit AuxInOut;
-
- interface
- uses Dos;
- procedure AssignAux(var F: Text; Port,Params: Word);
-
- implementation
- {$S-,R-}
-
- type
- TextBuf = array[0..127] of Char;
- TextRec = record
- Handle: Word;
- Mode: Word;
- BufSize: Word;
- Private: Word;
- BufPos: Word;
- BufEnd: Word;
- BufPtr: ^TextBuf;
- OpenProc: Pointer;
- InOutProc: Pointer;
- FlushProc: Pointer;
- CloseProc: Pointer;
- AuxPort, AuxParam: Word; { zwei neue Felder }
- UserFill: array[1..12] of Byte; { um 4 Bytes kleiner }
- Name: array[0..79] of Char;
- Buffer: TextBuf;
- end;
-
- const
- fmClosed = $D7B0;
- fmInput = $D7B1;
- fmOutput = $D7B2;
- fmInOut = $D7B3;
-
- procedure AuxInit(Port,Params: Word);
- inline(
- $58/ { POP AX ; Parameter Params -> AX }
- $5A/ { POP DX ; Portnummer -> DX }
- $B4/$00/ { MOV AH,0 ; Funktionscode: Initialisierung }
- $CD/$14); { INT 14H ; BIOS-Aufruf }
-
- function AuxInchar(Port: Word): Char;
- inline(
- $5A/ { POP DX ; Portnummer -> DX }
- $B4/$02/ { MOV AH,2 ; Funktionscode: Input }
- $CD/$14); { INT 14H ; BIOS-Aufruf }
-
- procedure AuxOutchar(Port: Word; Ch: Char);
- inline(
- $58/ { POP AX ; auszugebendes Zeichen -> AX (AL) }
- $5A/ { POP DX ; Portnummer -> DX }
- $B4/$01/ { MOV AH,1 ; Funktionscode: Output }
- $CD/$14); { INT 14H ; BIOS-Aufruf }
-
- function AuxInReady(Port: Word) : Boolean;
- inline(
- $5A/ { POP DX ; Portnummer -> DX }
- $B4/$03/ { MOV AH,3 ; Funktionscode: Status }
- $CD/$14/ { INT 14H ; BIOS-Aufruf }
- $88/$E0/ { MOV AL,AH ; Status -> AL }
- $24/$01); { AND AL,1 ; Daten bereit? }
-
- {$F+}
-
- function AuxInput(var F : TextRec) : Integer;
- var
- P : Integer;
- begin
- with F do
- begin
- P := 0;
- while AuxInReady(AuxPort) and (P<BufSize) do
- begin
- BufPtr^[P] := AuxInChar(AuxPort); Inc(P);
- end;
- BufPos := 0; BufEnd := P;
- end;
- AuxInput := 0;
- end;
-
- function AuxOutput(var F: TextRec): Integer;
- var
- P : Integer;
- begin
- with F do
- begin
- for P := 0 to BufPos-1 do AuxOutChar(AuxPort,BufPtr^[P]);
- BufPos := 0;
- end;
- AuxOutput := 0;
- end;
-
- function AuxIgnore(var F : TextRec) : Integer;
- begin
- AuxIgnore := 0;
- end;
-
- function AuxOpen(var F : TextRec) : Integer;
- begin
- with F do
- begin
- AuxInit(AuxPort,AuxParam);
- if Mode = fmInput then
- begin
- InOutProc := @AuxInput;
- FlushProc := @AuxIgnore;
- end else
- begin
- Mode := fmOutput;
- InOutProc:= @AuxOutput;
- FlushProc:= @AuxOutput;
- end;
- CloseProc := @AuxIgnore;
- end;
- AuxOpen := 0;
- end;
-
- {$F-}
-
- procedure AssignAux;
- begin
- with TextRec(F) do
- begin
- Handle := $FFFF;
- Mode := fmClosed;
- BufSize := SizeOf(Buffer);
- BufPtr := @Buffer;
- OpenProc := @AuxOpen;
- AuxPort := Port;
- AuxParam := Params;
- Name[0] := #0;
- end;
- end;
-
- end.
-
-
-
-
-
-