Unit RSFunc;

INTERFACE

Const
 TimeOut = $0FFFF;
 SpeedDivider: Word = $0C;

Var
 PortBase, RSError: Word;

Function LStatReg: Byte;
Function IsRecive( Var Status: Byte ): Boolean;
Function CheckRcv: Boolean;
Function RsIn: Word;
Procedure RsOut( Value: Byte );
Function SetPort( Number: Byte ): Boolean;
...

IMPLEMENTATION

Uses Crt, Dos;

Function LStatReg: Byte; assembler;
asm
           mov      dx, PortBase
           add      dx, 5
           in      al, dx
           xor      ah, ah
end; {LStatReg}

Function IsRecive( Var Status: Byte ): Boolean;
Var
 Temp: Byte;
 Temp1: Boolean;
begin
 asm
           mov      dx, PortBase
           add      dx, 5
           in      al, dx
           mov      Temp, al
           and      ax, 1
           mov      Temp1, al
 end;
 IsRecive := Temp1;
 Status := Temp;
end; {IsRecive}

Function CheckRcv: Boolean; assembler;
asm
           mov      dx, PortBase
           add      dx, 5
           in      al, dx
           and      ax, 1
end; {CheckRcv}

Function RsIn: Word;
Var
 Temp: Word;
 Temp1: Byte;
 Temp2: Boolean;
begin
 RsIn := 0;
 Repeat
   asm
           mov      dx, PortBase
           add      dx, 5
           in      al, dx
           mov      Temp1, al
           and      ax, 1
           mov      Temp2, al
   end;
   If Temp2 then
   begin
     asm
           mov      dx, PortBase
           in      al, dx
           mov      ah, Temp1
           mov      Temp, ax
     end;
     RsIn := Temp;
     Break;
   end else Inc( Temp );
 Until (Temp > $13EC);
end; {RsIn}

Procedure RsOut( Value: Byte );
Var
 Stat: Boolean;
 Temp: Word;
 Temp1: Byte;
begin
 For Temp := 0 to $7530 do
 begin
   Temp1 := LStatReg;
   asm
           mov      Stat, 0
           mov      al, Temp1
           test      al, 1Ch
           je      @@1
           jmp      @@2
     @@1:
           test      al, 20h
           je      @@2
           mov      Stat, 1
     @@2:
   end;
   If Stat then
   begin
     asm
           mov      dx, PortBase
           mov      al, Value
           out      dx, al
     end;
     Break;
   end;
 end;
end; {RsOut}

Function SetPort( Number: Byte ): Boolean;
Var
 Temp: Word;
 Temp1: Byte;
 SD_Lo, SD_Hi: Byte;
begin
 RsError := 0;
 PortBase := 0;
 SetPort := False;
 Case Number of
   1: PortBase := $3F8;
   2: PortBase := $2F8;
   else begin
     RsError := $2A;
     Exit;
   end;
 end;
 If PortBase <> 0 then
 begin
   SD_Hi := Hi(SpeedDivider);
   SD_Lo := Lo(SpeedDivider);
   asm
           mov      dx, PortBase
           add      dx, 3
           mov      al, 80h
           out      dx, al
           mov      dx, PortBase
           add      dx, 1
           mov      al, SD_Hi
           out      dx, al
           mov      dx, PortBase
           mov      al, SD_Lo
           out      dx, al
           mov      dx, PortBase
           add      dx, 3
           mov      al, 3
           out      dx, al
           mov      dx, PortBase
           add      dx,  1
           xor      ax, ax
           out      dx, al
   end;
   For Temp := 0 to $9C40 do
   begin
     Temp1 := LStatReg;
     asm
           mov      al, Temp1
           and      ax, 80h
           mov      Temp1, al
     end;
     If Temp1 = 0 then
     begin
       SetPort := True;
       Break;
     end;
   end;
 end else RsError := $2A;
end; {SetPort}
...
end.

...
 If not SetPort(ComPort) then
 begin
   Writeln( 'Ошибка инициализации порта СОМ', ComPort );
   Halt( 255 );
 end;
...

Function Command( P1, P2, P3, P4: Byte ): Boolean;

Var
 ...
 Wait: Word;
 Check: Byte;
 ...
begin
 ...
 Command := False;
 RsError := 0;
 ...

 ...
 RsOut( P1 );
 RsOut( P2 );
 RsOut( P3 );
 RsOut( P4 );
 RsOut( $0F );
 RsOut( $0F );
 RsOut( Check );
 ...

 ...
 Wait := 0;
 While not CheckRcv and (Wait <> TimeOut) do Inc(Wait);
 If Wait = TimeOut then
 begin
   RsError := 1;
   Exit;
 end;
 If Lo(RsIn) = Check then
 begin
   RsError := 0;
   Command := True;
   Exit;
 end;
 ...
end; {Command}