1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:

unit uSchnittstellenunit;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

procedure TIMEOUTS (TOut: Integer); stdcall;
function OPENCOM (OpenString: pchar): Integer; stdcall;
procedure CLOSECOM(); stdcall;
procedure TXD(State:integer); stdcall;
procedure DTR(State:integer); stdcall;
procedure RTS(State:integer); stdcall;
procedure Schnittstelleeinschalten;
procedure Schnittstelleausschalten;
procedure TXDein;
procedure TXDaus;
procedure DTRein;
procedure DTRaus;
procedure RTSein;
procedure RTSaus;
function DSR():Integer; stdcall;
function CTS():Integer; stdcall;
function DCD():Integer; stdcall;
function RI():Integer;stdcall;
function DSRlesen():integer;
function CTSlesen():integer;
function DCDlesen():integer;
function RIlesen():integer;


implementation
var
  SaveExit: Pointer;
     PortHandle: THandle;
     StartTime: Int64;
     TimeUnit: Real = 0.000838;


procedure TIMEOUTS (TOut: Integer); stdcall;
var TimeOut:TCOMMTIMEOUTS;
begin
   TimeOut.ReadIntervalTimeout:=1;
   TimeOut.ReadTotalTimeoutMultiplier:=1;
   TimeOut.ReadTotalTimeoutConstant:=TOut;
   TimeOut.WriteTotalTimeoutMultiplier:=10;
   TimeOut.WriteTotalTimeoutConstant:=TOut;
   SetCommTimeouts(PortHandle,TimeOut);
end;

function OPENCOM (OpenString: pchar): Integer; stdcall;
var PortStr, Parameter :String;
    DCB: TDCB;
begin
   Result := 0;
   if PortHandle > 0 then CloseHandle(PortHandle);
   Parameter := OpenString;
   PortStr := copy (Parameter,1,4);
   PortHandle:=CreateFile(PChar(PortStr),GENERIC_READ or GENERIC_WRITE,0,NIL,OPEN_EXISTING,0,0);
   GetCommState(PortHandle,DCB);
   BuildCommDCB(PChar(Parameter),dcb);
   DCB.Flags := 1;
   if SetCommState(PortHandle,DCB)then Result := 1;
   TimeOuts (10);
end;

procedure CLOSECOM(); stdcall;
begin
    CloseHandle(PortHandle);
    PortHandle:= 0;
end;

procedure TXD(State:integer); stdcall;
begin
 if (State=0) then EscapeCommFunction(PortHandle,CLRBREAK)
 else EscapeCommFunction(PortHandle,SETBREAK);
end;

procedure DTR(State:integer); stdcall;
begin
 if (State=0) then EscapeCommFunction(PortHandle,CLRDTR)
 else EscapeCommFunction(PortHandle,SETDTR);
end;

procedure RTS(State:integer); stdcall;
begin
 if (State=0) then EscapeCommFunction(PortHandle,CLRRTS)
 else EscapeCommFunction(PortHandle,SETRTS);
end;

function DSR():Integer; stdcall;
Var mask:Dword;
begin
     GetCommModemStatus(PortHandle,mask);
     if (mask and MS_DSR_ON)=0 then result:=0 else result:=1;
end;

function CTS():Integer; stdcall;
Var mask:Dword;
begin
     GetCommModemStatus(PortHandle,mask);
     if (mask and MS_CTS_ON)=0 then result:=0 else result:=1;
end;

function DCD():Integer; stdcall;
Var mask:Dword;
begin
     GetCommModemStatus(PortHandle,mask);
     if (mask and MS_RLSD_ON)=0 then result:=0 else result:=1;
end;

function RI():Integer; stdcall;
Var mask:Dword;
begin
     GetCommModemStatus(PortHandle,mask);
     if (mask and MS_RING_ON)=0 then result:=0 else result:=1;
end;

procedure Schnittstelleeinschalten;
begin
  Opencom('COM1');
end;

procedure Schnittstelleausschalten;
begin
  Closecom();
end;

procedure TXDein;
begin
  TXD(1);
end;

procedure TXDaus;
begin
  TXD(0);
end;

procedure DTRein;
begin
  DTR(1);
end;

procedure DTRaus;
begin
  DTR(0);
end;

procedure RTSein;
begin
  RTS(1);
end;

procedure RTSaus;
begin
  RTS(0);
end;

function DSRlesen():integer;
begin
  result:=DSR();
end;

function CTSlesen():integer;
begin
  result:=CTS();
end;

function DCDlesen():integer;
begin
  result:=DCD();
end;

function RIlesen():integer;
begin
  result:=RI();
end;

end.