unit ComPort;
interface
uses Windows, SysUtils;
Const
COM_BLOCK=1024; //1024缓冲区
type
TBaudRate = (brCustom, br110, br300, br600, br1200, br2400, br4800, br9600, br14400,
br19200, br38400, br56000, br57600, br115200, br128000, br256000);
TDataBits = (dbFive, dbSix, dbSeven, dbEight);
TStopBits= (sb1,sb15,sb2);
TBits =( None, Odd, Even, Mark, Space );
TDTRFlowControl = (dtrDisable, dtrEnable, dtrHandshake);
TRTSFlowControl = (rtsDisable, rtsEnable, rtsHandshake, rtsToggle);
const
CStopBits: array[TStopBits] of Integer =
(ONESTOPBIT, ONE5STOPBITS, TWOSTOPBITS);
CDataBits: array[TDataBits] of Integer = (5, 6, 7, 8);
CControlRTS: array[TRTSFlowControl] of Integer =
(RTS_CONTROL_DISABLE shl 12,
RTS_CONTROL_ENABLE shl 12,
RTS_CONTROL_HANDSHAKE shl 12,
RTS_CONTROL_TOGGLE shl 12);
CControlDTR: array[TDTRFlowControl] of Integer =
(DTR_CONTROL_DISABLE shl 4,
DTR_CONTROL_ENABLE shl 4,
DTR_CONTROL_HANDSHAKE shl 4);
CParityBits: array[TBits] of Integer =
(NOPARITY, ODDPARITY, EVENPARITY, MARKPARITY, SPACEPARITY);
CBaudRate: array[TBaudRate] of Integer =
(0, CBR_110, CBR_300, CBR_600, CBR_1200, CBR_2400, CBR_4800, CBR_9600,
CBR_14400, CBR_19200, CBR_38400, CBR_56000, CBR_57600, CBR_115200,
CBR_128000, CBR_256000);
Type
TParity=record
Checked:Boolean;
Bits:TBits;
end;
type
TComRecEvent=procedure(var Len:Integer; var Buf:Array of Char ) of Object;
type
TComport=Class
private
fOpened : Boolean;
fPortName:String;
hComFile: THandle;
ControlDTR:TDTRFlowControl;
ControlRTS:TRTSFlowControl;
FOutx_CtsFlow:Boolean;
FOutx_DsrFlow:Boolean;
FDsrSensitivity:Boolean;
FTxContinueOnXoff:Boolean;
fXonXoffOut:Boolean;
fXonXoffIn :Boolean;
FReplaceWhenParityError :Boolean;
FDisCardNull :Boolean;
fOverlapped: TOverlapped;
fComRecEvent:TComRecEvent;
fDataBits: TDataBits;
fStopBits: TStopBits;
fParityBits: TParity;
fBaudRate: TBaudRate;
Function SetCommPortTimeout:Boolean;
Function SetComPortParas:Boolean; //设置参数
protected
public
constructor Create;
destructor Destroy; override;
function WriteData(const Data; const Len: Integer):Integer;
function RecComPortData(var Len:Integer;TimeOuts:Cardinal; var Buf:Array of char ):Boolean;
function RecDataLength:Integer; //接受的数据长度
function ReadData(var Buf:Array of char; const Len: Integer):Integer;
function WaitForComData(Read_not_Write:Boolean):Integer;
procedure OpenPort;
Procedure ClosePort;
published
property Opened :Boolean read fOpened;
property Port:String read fPortName write fPortName;
property ComRecEvent: TComRecEvent read fComRecEvent write fComRecEvent;
property DataBits: TDataBits read fDataBits write fDataBits;
property StopBits: TStopBits read fStopBits write fStopBits;
property ParityBits: TParity read fParityBits write fParityBits;
property BaudRate: TBaudRate read fBaudRate write fBaudRate;
end;
implementation
constructor TComport.Create;
begin
hComFile:=INVALID_HANDLE_VALUE;
fOpened:=False;
///////////////////
FOutx_CtsFlow:=False;
FOutx_DsrFlow:=False;
FDsrSensitivity:=False;
FTxContinueOnXoff:=False;
fXonXoffOut:=False;
fXonXoffIn :=False;
FReplaceWhenParityError :=False;
FDisCardNull :=False;
ControlDTR:=dtrDisable;
ControlRTS:=rtsDisable;
///////////////////
fPortName:='COM1';
fBaudRate:=br9600;
fDataBits:=dbSeven;
fStopBits:=sb1;
fParityBits.Checked:=False;
fParityBits.Bits:=Even;
end;
destructor TComport.Destroy;
begin
if hComfile<>INVALID_HANDLE_VALUE then CloseHandle(hComfile);
end;
function TComPort.RecComPortData(var Len:Integer; TimeOuts:Cardinal ; var Buf: array of char):Boolean;
var
dt:Cardinal;
Overlapped: TOverlapped;
Signaled, BytesTrans, Mask: DWORD;
RecLen:Integer;
P
ointer;
RecBuf:Array[0..511]of char;
begin
Result:=False;
dt:=GetTickCount;Len:=0;RecLen:=0; P:=@Buf[0];
FillChar(Overlapped, SizeOf(Overlapped), 0);
Overlapped.hEvent := CreateEvent(nil, True, True, nil);
repeat
WaitCommEvent(hComfile, Mask, @Overlapped);
Signaled := WaitForSingleObject(Overlapped.hEvent, INFINITE);
if (Signaled = WAIT_OBJECT_0) and
GetOverlappedResult(hComfile, Overlapped, BytesTrans, False)
then
RecLen:=RecDataLength;
if RecLen>0 then begin
ReadData(RecBuf,RecLen);
CopyMemory(@Buf[Len],@RecBuf[0],RecLen);
Inc(PByte(p),RecLen);
Len:=Len+RecLen;
Result:=True;
end;
Sleep(10);
until (Signaled <> (WAIT_OBJECT_0)) or ((GetTickCount-dt)>TimeOuts);
SetCommMask(hComfile, 0);
PurgeComm(hComfile, PURGE_TXCLEAR or PURGE_RXCLEAR);
if Assigned(fComRecEvent) then fComRecEvent(Len,Buf);
end;
function TComPort.WaitForComData(Read_not_write:Boolean):Integer; //等待数据
var
Wok: Boolean;
BytesTrans,Signaled: DWORD;
begin
Signaled:=WaitForSingleObject(fOverlapped.hEvent,INFINITE);
wok:=(Signaled = WAIT_OBJECT_0) and
(GetOverlappedResult(hComfile, fOverlapped, BytesTrans, False));
if not wok then Raise Exception.Create('Write Data To ComPort Error ');
Result := BytesTrans;
end;
function TComport.WriteData(const Data; const Len: Integer):Integer; //写数据
var
Wok: Boolean;
BytesTrans: DWORD;
begin
FillChar(fOverlapped, SizeOf(TOverlapped), 0);
fOverlapped.hEvent:=CreateEvent( nil, True, False, nil );
Wok :=WriteFile(hComfile, Data, Len, BytesTrans, @fOverlapped) or
(GetLastError = ERROR_IO_PENDING);
if not wok then begin
CloseHandle(fOverlapped.hEvent);
Raise Exception.Create('Write Data To ComPort Error ');
end;
Result:=WaitForComData(False);
CloseHandle(fOverlapped.hEvent);
PurgeComm(hComfile, PURGE_TXCLEAR or PURGE_RXCLEAR);
end;
function TComport.RecDataLength:Integer; //接受的数据长度
var
Errors: DWORD;
ComStat: TComStat;
begin
if not ClearCommError(hComfile, Errors, @ComStat) then
raise Exception.Create('clear commerror error ');
Result := ComStat.cbInQue;
end;
function TComport.ReadData(var Buf:Array of char; const len: Integer):Integer; //读数据
var
wok: Boolean;
BytesTrans: DWORD;
begin
FillChar(fOverlapped, SizeOf(TOverlapped), 0);
fOverlapped.hEvent:=CreateEvent( nil, True, False, nil );
wok := ReadFile(hComfile, Buf, Len, BytesTrans, @fOverlapped) or
(GetLastError = ERROR_IO_PENDING);
if not wok then begin
CloseHandle(fOverlapped.hEvent);
Raise Exception.Create('read data from ComPort Error ');
end;
Result:=WaitForComData(True);
CloseHandle(fOverlapped.hEvent);
PurgeComm(hComfile, PURGE_TXCLEAR or PURGE_RXCLEAR);
end;
procedure TComport.OpenPort; //打开串口
begin
if hComfile<>INVALID_HANDLE_VALUE then Raise Exception.Create('Port '+fPortName+' is Opened.' );
hComFile:=CreateFile(PChar('//./'+fPortName),
GENERIC_READ or GENERIC_WRITE,
0, {not shared}
nil, {no security ??}
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED,
0 {template} );
if hComfile=INVALID_HANDLE_VALUE then Raise Exception.Create('Can''t Open '+fPortName );
if GetFileType( hComFile ) <> FILE_TYPE_CHAR then begin
CloseHandle( hComFile );
raise Exception.Create( 'File handle is not a comm handle ' );
end;
if not SetupComm( hComFile, COM_BLOCK, COM_BLOCK ) then begin
CloseHandle( hComFile );
raise Exception.Create( 'Cannot setup comm buffer' );
end;
if not PurgeComm( hComFile, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR ) then begin
CloseHandle( hComFile );
raise Exception.Create( 'Cannot clear comm buffer' );
end;
if not SetCommPortTimeout then begin
CloseHandle( hComFile );
raise Exception.Create( 'Setup COM TimeOut Error' );
end;
if not SetComPortParas then begin
CloseHandle( hComFile );
raise Exception.Create( 'Setup COM Dcb Paramstrs Error' );
end;
fOpened:=True;
end;
Function TComport.SetCommPortTimeout:Boolean;
var
ctout: TCommTimeouts;
begin
ctout.ReadIntervalTimeout:=MAXDWORD;
ctout.ReadTotalTimeoutMultiplier:=0;
ctout.ReadTotalTimeoutConstant:=0;
ctout.WriteTotalTimeoutMultiplier:=0;
ctout.WriteTotalTimeoutConstant:=0;
Result:=SetCommTimeouts(hComFile, ctout);
end;
Function TComport.SetComPortParas:Boolean; //设置参数
var
dcb: Tdcb;
commprop: TCommProp;
fdwEvtMask: DWORD;
begin
GetCommState( hComFile, dcb );
GetCommProperties( hComFile, commprop );
GetCommMask( hComFile, fdwEvtMask );
dcb.DCBlength:=SizeOf(dcb);
DCB.XonChar:=#17;
Dcb.XoffChar:=#19;
DCB.XonLim := COM_BLOCK div 2;
DCB.XoffLim := DCB.XonLim;
DCB.EvtChar := #0;
Dcb.ErrorChar:=#0;
DCB.Flags := 1;
if FOutx_CtsFlow then dcb.Flags := dcb.Flags or 4;
if FOutx_DsrFlow then dcb.Flags := dcb.Flags or 8;
if FDsrSensitivity then dcb.Flags := dcb.Flags or $40;
if FTxContinueOnXoff then dcb.Flags := dcb.Flags or $80;
if fXonXoffOut then DCB.Flags := DCB.Flags or $100;
if fXonXoffIn then DCB.Flags := DCB.Flags or $200;
if FReplaceWhenParityError then dcb.Flags := dcb.Flags or $400;
if FDisCardNull then dcb.Flags := dcb.Flags or $800;
DCB.Flags := DCB.Flags or CControlDTR[ControlDTR] or CControlRTS[ControlRTS];
//custom set
Dcb.ByteSize:=CDataBits[fDataBits];
dcb.StopBits:=CStopBits[fStopBits];
dcb.BaudRate:=CBaudRate[fBaudRate];
if fParityBits.Checked then dcb.Flags := dcb.Flags or 2; // Enable parity check
dcb.Parity:=CParityBits[fParityBits.Bits];
Result:=SetCommState(hComFile,dcb);
end;
Procedure TComport.ClosePort; //关闭串口
begin
if hComfile<>INVALID_HANDLE_VALUE then CloseHandle(hComfile);
hComfile:=INVALID_HANDLE_VALUE;
fOpened:=False;
end;
end.