unit cComDigital;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls;
type
cCom =
class
public
availablePorts : TStringList;
procedure cComInitialize;
function GethCom(): Thandle;
procedure SethCom(hCom2 : THandle);
procedure ReadAvailableComPorts();
function ConnectToComPort(Connect : Boolean; Port:
String):Boolean;
function DisconnectComPort(Port:
String) : Boolean;
function WriteDataToCOMPort(cByte: Integer):Boolean;
private
hCom: THandle;
DCB: TDCB;
TimeOut: TCommTimeouts;
ChosenPort :
String;
function SetDCBproperties() : Boolean;
function SetcComTimeOut() : Boolean;
end;
implementation
// Klassenimplementierung cCom
procedure cCom.cComInitialize;
begin
SethCom(0);
end;
procedure cCom.ReadAvailableComPorts;
var
TestHandle : THandle;
i : integer;
begin
availablePorts := TStringList.Create;
for i := 1
to 10
do
begin
TestHandle := CreateFile(PChar(
{'\\.\COM'}'
COM'+IntToStr(i)),GENERIC_READ
or GENERIC_WRITE,0,
nil,OPEN_EXISTING,FILE_FLAG_OVERLAPPED,LongInt(0));
if (TestHandle > 0)
then
begin
availablePorts.Add('
COM'+ IntToStr(i));
CloseHandle(TestHandle);
end;
end;
end;
function cCom.SetDCBproperties;
begin
if hCom > 0
then
begin
GetCommState(GethCom(),DCB);
DCB.DCBlength := SizeOf(DCB);
DCB.ByteSize := 8;
DCB.Parity := NoParity;
DCB.StopBits := TWOSTOPBITS;
DCB.BaudRate := 2400;
DCB.Flags := 5123;
{ Wenn 2 Pins belegt sind } //4113
DCB.EofChar := #0;
DCB.ErrorChar := #0;
DCB.EvtChar := #0;
DCB.XoffChar := #0;
DCB.XoffLim := 0;
DCB.XonChar := #0;
DCB.XonLim := 0;
SetCommState(GethCom(),DCB);
end;
end;
function cCom.SetcComTimeOut;
begin
if hCom > 0
then
begin
GetCommTimeOuts(GethCom(), TimeOut);
TimeOut.ReadIntervalTimeOut := 100;
TimeOut.ReadTotalTimeoutMultiplier := 0;
TimeOut.ReadTotalTimeoutConstant := 250;
TimeOut.WriteTotalTimeoutMultiplier := 0;
TimeOut.WriteTotalTimeoutConstant := 200;
SetCommTimeouts(hCom, TimeOut);
end;
end;
function cCom.GethCom;
begin
GethCom := hCom;
end;
function cCom.ConnectToComPort(Connect: Boolean; Port :
String) : Boolean;
Var i : Integer;
begin
// Mit ComPort (hCom) verbinden
if Connect = True
then
begin
i := 0;
while (GethCom <= 0)
and (i < 10)
do begin
SethCom((CreateFile(pChar(Port), GENERIC_READ
or GENERIC_WRITE,
0,
nil, OPEN_EXISTING, 0, 0)));
inc(i);
end;
if GethCom() = INVALID_HANDLE_VALUE
then begin
ShowMessage('
Fehler '+IntToStr(GetLastError())+'
: Schnittstelle konnte nicht geöffnet werden!' + #13#10 + '
Bite die richtige Schnittstelle einstellen!');
ConnectToComPort := false;
end
else begin
// Set DCB, Timeouts etc.
if SetDCBproperties()
then
begin
if SetcComTimeOut()
then
ConnectToComPort := true
else begin
ShowMessage('
Fehler '+IntToStr(GetLastError())+'
: Timeouts konnten nicht gesetzt werden!');
ConnectToComPort := false;
end;
end
else begin
ShowMessage('
Fehler '+IntToStr(GetLastError())+'
: Schnittstellen-Eigenschaften konnten nicht gesetzt werden!');
ConnectToComPort := false;
end;
end;
end
else
begin
FileClose(GethCom());
SethCom(0);
end;
end;
function cCom.DisconnectComPort(Port:
String):Boolean;
begin
ConnectToComPort(false,Port);
end;
function cCom.WriteDataToCOMPort(cByte: Integer) : Boolean;
var i : integer;
j : char;
begin
// Byte an Com Port schicken
if GethCom > 0
then
begin
j := chr(cByte);
i := FileWrite(GethCom(), j, 1);
if i > 0
then WriteDataToCOMPort := True
else WriteDataToCOMPort := False;
end;
end;
procedure cCom.SethCom(hCom2: THandle);
begin
hCom := hCom2;
end;
end.