Mega Code Archive
Tom, akbil seri no okuma
<![CDATA[
{
Seri Porttan TOM (TouchMemory - Akbil) Seri numarasını
okuyabileceğiniz unit.
Kullanılacak seri port initialization kısmında belirtilecek.
Cavit Keskin
cavit@binbir.net
}
unit tom;
interface
Var
Tom_port: Word;
initport : boolean;
CRC : Byte;
Function ReadTom:String;
implementation
function GPort(Addr:Word) : Byte; assembler; register;
asm
MOV DX,AX
IN AL,DX
end;
procedure WPort(Addr:Word; Value:Byte); assembler; register;
asm
XCHG AX,DX
OUT DX,AL
end;
Function TouchReset: Boolean;
var
x: Byte;
f: Boolean;
//t: Byte;
m: byte;
Begin
m:=0;
result:=true;
if initport then begin
WPort(Tom_Port + 3, $83) ; { Set the DLAB }
WPort(Tom_Port, 1); { Bit rate is }
WPort(Tom_Port + 1, 0);{ 115200 bps }
WPort(Tom_Port + 3, 3);{ 8 dta, 1 stp, no par }
WPort(Tom_Port + 1, 0);{ No interrupts }
WPort(Tom_Port + 4, 3);{ RTS and DTR on }
initport:=false;
end;
Repeat until GPort(Tom_Port + 5) and $60 = $60; { Await TBE & TSRE }
While Odd(GPort(Tom_Port + 5)) do X := GPort(Tom_Port); { Flush input }
WPort(Tom_Port + 3, $82); { Set the DLAB }
WPort(Tom_Port, 18); { Bit rate is 6400 bps }
WPort(Tom_Port + 3, 2); { 7 dta, 1 stp, no par }
WPort(Tom_Port, $F8); { Send reset signal }
Repeat until GPort(Tom_Port + 5) and $60 = $60; { Await TBE & TSRE }
Repeat
f := Odd(GPort(Tom_Port + 5));
inc(m);
until f or (m>250);
result := F and (GPort(Tom_Port) <> $78); { Return presence }
WPort(Tom_Port + 3, $83); { Set the DLAB }
WPort(Tom_Port, 1); { Bit rate is 115200 bps }
WPort(Tom_Port + 3, 3); { 8 dta, 1 stp, no par }
End;
Function TouchByte(X: Byte): Byte;
var
i, j : Byte;
m: Integer;
Begin
m:=0;
If Tom_Port = 0 then result := X else Begin
{M := T + 1;} { Initialize the time limit }
Repeat until GPort(Tom_Port + 5) and $60 = $60; { Await TBE & TSRE }
While Odd(GPort(Tom_Port + 5)) do X := GPort(Tom_Port); { Flush input }
I := 0; J := 0; { Initialize output & input bit counters }
Repeat
inc(m);
If Odd(GPort(Tom_Port + 5)) then
Begin
Inc(J);
If Odd(GPort(Tom_Port)) then X := X or $80;
End
else
If (I<=J) and (GPort(Tom_Port+5) and $20 = $20) then
Begin
If Odd(X) then WPort(Tom_Port,$FF) else WPort(Tom_Port,0);
X := X shr 1; Inc(I);
End;
Until (J = 8) or (M>2500);
While (J < 8) do Begin
X := X shr 1 or $80;
Inc(J)
End;
Result := X;
End;
end;
Procedure Do_CRC(X: Byte);
Const
Table : Array[0..255] of Byte = (
0, 94,188,226, 97, 63,221,131,194,156,126, 32,163,253, 31, 65,
157,195, 33,127,252,162, 64, 30, 95, 1,227,189, 62, 96,130,220,
35,125,159,193, 66, 28,254,160,225,191, 93, 3,128,222, 60, 98,
190,224, 2, 92,223,129, 99, 61,124, 34,192,158, 29, 67,161,255,
70, 24,250,164, 39,121,155,197,132,218, 56,102,229,187, 89, 7,
219,133,103, 57,186,228, 6, 88, 25, 71,165,251,120, 38,196,154,
101, 59,217,135, 4, 90,184,230,167,249, 27, 69,198,152,122, 36,
248,166, 68, 26,153,199, 37,123, 58,100,134,216, 91, 5,231,185,
140,210, 48,110,237,179, 81, 15, 78, 16,242,172, 47,113,147,205,
17, 79,173,243,112, 46,204,146,211,141,111, 49,178,236, 14, 80,
175,241, 19, 77,206,144,114, 44,109, 51,209,143, 12, 82,176,238,
50,108,142,208, 83, 13,239,177,240,174, 76, 18,145,207, 45,115,
202,148,118, 40,171,245, 23, 73, 8, 86,180,234,105, 55,213,139,
87, 9,235,181, 54,104,138,212,149,203, 41,119,244,170, 72, 22,
233,183, 85, 11,136,214, 52,106, 43,117,151,201, 74, 20,246,168,
116, 42,200,150, 21, 75,169,247,182,232, 10, 84,215,137,107, 53);
Begin
CRC := Table[CRC xor X];
End;
Function Hex(X: Byte): String;
Var
S : String[2];
I, J : Byte;
Begin
S := '';
For I := 1 to 2 do Begin
J := X and $F;
X := X shr 4;
If J > 9 then Inc(J, 7);
S := Char(J + $30) + S
End;
result := S;
End;
Function ReadTom:String;
var
A : Array[1..9] of Byte;
I, X : Byte;
Begin
result:='';
If TouchReset then
Begin
A[9]:=TouchByte($33);
CRC := 0;
For I := 1 to 8 do Begin
X := TouchByte($FF);
Do_CRC(X);
A[I] := X;
End;
if crc=0 then
For I := 1 to 8 do result:=result+Hex(A[I])+' ';
//Repeat until not TouchReset;
End;
end;
initialization
Tom_port := $2F8;
initport := true;
end.
]]>