| Код | unit ComPort;
////////////////////////////////////////////////////////////////////////////////
// Class: TComPort //
// Description: Asynchronous (overlapped) COM port //
// Version: 1.0 //
// Date: 10-Jun-2003 //
// Author: Igor Pavlov, [email protected] //
// Copyright: (c) 2003, Igor Pavlov //
////////////////////////////////////////////////////////////////////////////////
interface
uses Messages, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ExtCtrls,
SysUtils, Windows, Variants, Classes;
type
EComPortError = class(Exception);
TBaudRate = (br110 = CBR_110,
br300 = CBR_300,
br600 = CBR_600,
br1200 = CBR_1200,
br2400 = CBR_2400,
br4800 = CBR_4800,
br9600 = CBR_9600,
br14400 = CBR_14400,
br19200 = CBR_19200,
br38400 = CBR_38400,
br56000 = CBR_56000,
br57600 = CBR_57600,
br115200 = CBR_115200,
br128000 = CBR_128000,
br256000 = CBR_256000);
TComPort = class;
{Reading thread}
TReadThread = class(TThread)
private
FBuf: array[0..$FF] of Byte;
FComPort: TComPort;
FOverRead: TOverlapped;
FRead: DWORD;
procedure DoRead;
protected
procedure Execute; override;
public
constructor Create(ComPort: TComPort);
destructor Destroy; override;
end;
{Reading event}
TReadEvent = procedure(Sender: TObject; ReadBytes: array of Byte) of object;
{Com port class}
TComPort = class
private
FOverWrite: TOverlapped;
FPort: THandle;
FPortName: String;
FReadEvent: TReadEvent;
FReadThread: TReadThread;
public
constructor Create(PortNumber: Cardinal; BaudRate: TBaudRate);
destructor Destroy; override;
procedure Write(WriteBytes: array of Byte);
published
property OnRead: TReadEvent read FReadEvent write FReadEvent;
property PortName: String read FPortName;
end;
implementation
constructor TReadThread.Create(ComPort: TComPort);
begin
FComPort := ComPort;
ZeroMemory(@FOverRead, SizeOf(FOverRead));
{Event}
FOverRead.hEvent := CreateEvent(nil, True, False, nil);
if FOverRead.hEvent = Null then
raise EComPortError.Create('Error creating read event');
inherited Create(False);
end;
destructor TReadThread.Destroy;
begin
CloseHandle(FOverRead.hEvent);
inherited Destroy;
end;
procedure TReadThread.Execute;
var ComStat: TComStat;
dwMask, dwError: DWORD;
begin
FreeOnTerminate := True;
while not Terminated do
begin
if not WaitCommEvent(FComPort.FPort, dwMask, @FOverRead) then
begin
if GetLastError = ERROR_IO_PENDING then
WaitForSingleObject(FOverRead.hEvent, INFINITE)
else
raise EComPortError.Create('Error waiting port ' + FComPort.PortName + ' event');
end;
if not ClearCommError(FComPort.FPort, dwError, @ComStat) then
raise EComPortError.Create('Error clearing port ' + FComPort.PortName);
FRead := ComStat.cbInQue;
if FRead > 0 then
begin
if not ReadFile(FComPort.FPort, FBuf, FRead, FRead, @FOverRead) then
raise EComPortError.Create('Error reading port ' + FComPort.PortName);
Synchronize(DoRead);
end;
end; {while}
end;
procedure TReadThread.DoRead;
var
arrBytes: array of Byte;
i: Integer;
begin
if Assigned(FComPort.FReadEvent) then
begin
SetLength(arrBytes, FRead);
for i := Low(FBuf) to FRead - 1 do
arrBytes[i] := FBuf[i];
FComPort.FReadEvent(Self, arrBytes);
arrBytes := nil;
end;
end;
constructor TComPort.Create(PortNumber: Cardinal; BaudRate: TBaudRate);
var
Dcb: TDcb;
begin
inherited Create;
ZeroMemory(@FOverWrite, SizeOf(FOverWrite));
FPortName := 'COM' + IntToStr(PortNumber);
{Open port}
FPort := CreateFile(PChar(PortName),
GENERIC_READ or GENERIC_WRITE, 0, nil,
OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
if FPort = INVALID_HANDLE_VALUE then
raise EComPortError.Create('Error opening port ' + PortName);
try
{Set port state}
if not GetCommState(FPort, Dcb) then
raise EComPortError.Create('Error setting port ' + PortName + ' state');
Dcb.BaudRate := DWORD(BaudRate);
Dcb.Parity := NOPARITY;
Dcb.ByteSize := 8;
Dcb.StopBits := ONESTOPBIT;
if not SetCommState(FPort, Dcb) then
raise EComPortError.Create('Error setting port ' + PortName + ' state');
{Purge port}
if not PurgeComm(FPort, PURGE_TXCLEAR or PURGE_RXCLEAR) then
raise EComPortError.Create('Error purging port ' + PortName);
{Set mask}
if not SetCommMask(FPort, EV_RXCHAR) then
raise EComPortError.Create('Error setting port ' + PortName + ' mask');
FOverWrite.hEvent := CreateEvent(nil, True, False, nil);
if FOverWrite.hEvent = Null then
raise EComPortError.Create('Error creating write event');
{Reading thread}
FReadThread := TReadThread.Create(Self);
except
CloseHandle(FOverWrite.hEvent);
CloseHandle(FPort);
raise;
end;
end;
destructor TComPort.Destroy;
begin
if Assigned(FReadThread) then
FReadThread.Terminate;
CloseHandle(FOverWrite.hEvent);
CloseHandle(FPort);
inherited Destroy;
end;
procedure TComPort.Write(WriteBytes: array of Byte);
var dwWrite: DWORD;
begin
if (not WriteFile(FPort, WriteBytes, SizeOf(WriteBytes), dwWrite, @FOverWrite))
and (GetLastError <> ERROR_IO_PENDING) then
raise EComPortError.Create('Error writing port ' + PortName);
end;
end. |
|