|
自己用API写的串口类, 希望能帮到需要的人
unit SerialPort;
interface
{$I Ver.inc}
uses
Classes, Windows, SysUtils, Variants, Registry, SiTimer;
const
SER_SUCCESS = 0; ///< No error
SER_ERR_CLASS = $1100; ///< Serial error class
SER_INVALID_PARAMETER = $1101; ///< Parameter invalid or not supported
SER_API_ERROR = $1102; ///< Underlaying API returns an error
SER_PORT_NOT_FOUND = $1103; ///< Serial port not found
SER_ALREADY_OPEN = $1104; ///< Serial port already open
SER_NOT_OPEN = $1105; ///< Port not opened
SER_TIME_OUT = $1106; ///< Operation timed out
SER_LINE_ERROR = $1107; ///< RS232 line error
SER_UNSUPPORTED_OPERATION = $1108; /// Operation not supported in current configuration
SER_PORT_NO_ACCESS = $1109; ///< No access rights for port (Try as root)
SER_DATABITS_4 = 4; ///< 4 data bits
SER_DATABITS_5 = 5; ///< 5 data bits
SER_DATABITS_6 = 6; ///< 6 data bits
SER_DATABITS_7 = 7; ///< 7 data bits
SER_DATABITS_8 = 8; ///< 8 data bits
SER_STOPBITS_1 = 0; ///< 1 stop bit
SER_STOPBITS_15 = 1; ///< 1.5 stop bit
SER_STOPBITS_2 = 2; ///< 2 stop bits
SER_PARITY_NONE = 0; ///< No parity
SER_PARITY_ODD = 1; ///< Odd parity
SER_PARITY_EVEN = 2; ///< Even parity
SER_PARITY_MARK = 3; ///< Mark parity
SER_PARITY_SPACE = 4; ///< Space parity
SER_HANDSHAKE_NONE = 0; ///< No handshake
SER_HANDSHAKE_XONXOFF = 1; ///< Xon/Xoff software handshake
SER_HANDSHAKE_HARDWARE = 2; ///< hardware handshake
type
TSerialPort = class(TComponent)
private
FHandle: THandle;
commTimeOutBlock: TCommTimeouts;
savedCommTimeOutBlock: TCommTimeouts;
savedDevCtrlBlock: TDCB;
FPort: Integer;
FBaudRate: DWORD;
FDataBits: Integer;
FParity: Integer;
FStopBits: Integer;
FFlowControl: Integer;
FOverlapped: Boolean;
ovInternal: TOverlapped;
timeoutTimer: TSiTimer;
procedure SetPort(Value: Integer);
procedure SetBaudRate(Value: DWORD);
procedure SetDataBits(Value: Integer);
procedure SetParity(Value: Integer);
procedure SetStopBits(Value: Integer);
procedure SetFlowControl(Value: Integer);
protected
procedure SyncSend(bufPtr: array of Byte; len: DWORD; timeout: DWORD);
function SyncReceive(out bufPtr: array of Byte; len: DWORD; timeout: DWORD): Integer;
function SyncReceiveByte(out bufPtr: Byte; timeout: DWORD): Integer;
procedure AsyncSend(bufPtr: array of Byte; len: DWORD; timeout: DWORD);
function AsyncReceive(out bufPtr: array of Byte; len: DWORD; timeout: DWORD): Integer;
function AsyncReceiveByte(out bufPtr: Byte; timeout: DWORD): Integer;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function Open(port: Integer; overlapped: Boolean): Integer;
procedure Close;
function Config(baudRate: DWORD; dataBits: Integer; stopBits: Integer;
parity: Integer; flowControl: Integer): Integer;
function SetBufferSizes(input: DWORD; output: DWORD): Integer;
procedure Send(bufPtr: array of Byte; len: DWORD; timeout: DWORD);
//返回接收的字节数
function Receive(out bufPtr: array of Byte; len: DWORD; timeout: DWORD): Integer; overload;
//返回接收的字节数
function Receive(out bufPtr: array of Byte; len: DWORD; const startBytes, endBytes: array of Byte; timeout: DWORD): Integer; overload;
//返回接收的字节数
function ReceiveByte(out bufPtr: Byte; timeout: DWORD): Integer;
function PurgeInput: Integer;
function PurgeOutput: Integer;
function ClearInput: Integer;
function ClearOutput: Integer;
function AbortInput: Integer;
function AbortOutput: Integer;
function Drain: Integer;
function Flush: Integer;
function IsOpen: Boolean;
function IsOverlapped: Boolean;
function ConfigDialog: Integer;
function ClearLineErrors: Integer;
function ResetDevice: Integer;
function ClearBreak: Integer;
function SetBreak: Integer;
function ClearDTR: Integer;
function SetDTR: Integer;
function ClearRTS: Integer;
function SetRTS: Integer;
function SetXOn: Integer;
function SetXOff: Integer;
property Handle: THandle read FHandle;
property Port: Integer read FPort write SetPort;
property BaudRate: DWORD read FBaudRate write SetBaudRate;
property DataBits: Integer read FDataBits write SetDataBits;
property Parity: Integer read FParity write SetParity;
property StopBits: Integer read FStopBits write SetStopBits;
property FlowControl: Integer read FFlowControl write SetFlowControl;
end;
procedure EnumDevices(List: TStrings);
procedure EnumComDevices(List: TStrings);
procedure EnumComDevicesFromRegistry(List: TStrings);
implementation
procedure EnumDevices(List: TStrings);
var
Count, Start, i: Integer;
Buffer: array [0..$FFFE] of Char;
DeviceName: string;
begin
Count := QueryDosDevice(nil, Buffer, SizeOf(Buffer));
Start := 0;
for i := 0 to Count - 1 do
if Buffer[i] = #0 then
begin
DeviceName := StrPas(PChar(@Buffer[Start]));
if DeviceName <> '' then
List.Add(DeviceName);
Start := i + 1;
end;
end;
procedure EnumComDevices(List: TStrings);
var
Count, Start, i: Integer;
Buffer: array [0..$FFFE] of Char;
DeviceName: String;
begin
Count := QueryDosDevice(nil, Buffer, SizeOf(Buffer));
Start := 0;
for i := 0 to Count - 1 do
if Buffer[i] = #0 then
begin
DeviceName := StrPas(PChar(@Buffer[Start]));
if (Pos('COM', DeviceName) = 1) or (Pos('\\.\COM', DeviceName) = 1) then
List.Add(DeviceName);
Start := i + 1;
end;
end;
procedure EnumComDevicesFromRegistry(List: TStrings);
var
Names: TStringList;
i: Integer;
begin
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
if OpenKeyReadOnly('\HARDWARE\DEVICEMAP\SERIALCOMM') then
begin
Names := TStringList.Create;
try
GetValueNames(Names);
for i := 0 to Names.Count - 1 do
if GetDataType(Names[i]) = rdString then
List.Add(ReadString(Names[i]));
finally
Names.Free;
end
end;
finally
Free;
end;
end;
constructor TSerialPort.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FHandle := INVALID_HANDLE_VALUE;
FPort := 1;
FBaudRate := CBR_9600;
FDataBits := SER_DATABITS_8;
FParity := SER_PARITY_NONE;
FStopBits := SER_STOPBITS_1;
FFlowControl := SER_HANDSHAKE_NONE;
FOverlapped := False;
timeoutTimer := TSiTimer.Create;
end;
destructor TSerialPort.Destroy;
begin
timeoutTimer.Free;
Close;
inherited Destroy;
end;
function TSerialPort.Open(port: Integer; overlapped: Boolean): Integer;
var
flags: Cardinal;
begin
if IsOpen then Close;
FPort := port;
FOverlapped := overlapped;
flags := 0;
if FOverlapped then flags := FILE_FLAG_OVERLAPPED;
FHandle := CreateFile(PChar('\\.\COM' + IntToStr(FPort)),
GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, flags, 0);
if (FHandle = INVALID_HANDLE_VALUE) then
begin
case GetLastError of
ERROR_FILE_NOT_FOUND:
begin
Result := (SER_PORT_NOT_FOUND);
Exit;
end;
ERROR_ACCESS_DENIED:
begin
Result := (SER_ALREADY_OPEN);
Exit;
end;
else
begin
Result := (SER_API_ERROR);
Exit;
end;
end;
end;
// Save current device control block
if (not GetCommState(FHandle, savedDevCtrlBlock)) then
begin
Result := (SER_API_ERROR);
Exit;
end;
if (not GetCommtimeouts(FHandle, savedCommtimeoutBlock)) then
begin
Result := (SER_API_ERROR);
Exit;
end;
if FOverlapped then
begin
ZeroMemory(@commtimeoutBlock, SizeOf(commtimeoutBlock));
SetCommtimeouts(FHandle, commtimeoutBlock);
ZeroMemory(@ovInternal,SizeOf(ovInternal));
ovInternal.hEvent := CreateEvent(nil,True,False,nil);
//如果无法创建事件,转为同步通讯模式
if (ovInternal.hEvent=0) then
FOverlapped := False;
end;
Flush();
Result := (Config(FBaudRate, FDataBits, FStopBits, FParity, FFlowControl));
end;
procedure TSerialPort.Close;
begin
Flush(); // Clear buffer in case OS won't do it for us
// Restore saved device control block
SetCommState(FHandle, savedDevCtrlBlock);
SetCommtimeouts(FHandle, savedCommtimeoutBlock);
if (FOverlapped and (ovInternal.hEvent<>0)) then
begin
CloseHandle(ovInternal.hEvent);
ovInternal.hEvent := 0;
end;
CloseHandle(FHandle);
FHandle := INVALID_HANDLE_VALUE;
end;
function TSerialPort.Config(baudRate: DWORD; dataBits: Integer; stopBits: Integer;
parity: Integer; flowControl: Integer): Integer;
const
flagBinary = $00000001;
flagParity = $00000002;
flagOutxCtsFlow = $00000004;
flagOutxDsrFlow = $00000008;
flagDtrControlEnable = $00000010;
flagDtrControlHandshake = $00000020;
flagDtrControl = $00000030;
flagDsrSensitivity = $00000040;
flagTXContinueOnXoff = $00000080;
flagOutX = $00000100;
flagInX = $00000200;
flagErrorChar = $00000400;
flagNull = $00000800;
flagRtsControlEnable = $00001000;
flagRtsControlHandshake = $00002000;
flagRtsControlToggle = $00003000;
flagAbortOnError = $00004000;
flagDummy2 = $FFFF8000;
//流控制
flagProtocolCommon = flagBinary or flagDtrControlEnable {or flagAbortOnError};
flagProtocolNone = flagProtocolCommon or flagRtsControlEnable;
flagProtocolXOnXOff = flagProtocolCommon or flagOutX or flagInX or flagRtsControlEnable;
flagProtocolHardware = flagProtocolCommon or flagOutxCtsFlow or flagRtsControlHandshake;
flagProtocolRS485 = flagProtocolCommon or flagRtsControlToggle;
flagProtocolClear = not (flagProtocolHardware or flagProtocolXOnXOff or flagDummy2 or flagProtocolRS485);
var
devCtrlBlock: DCB;
flags: Longint;
begin
Result := (SER_NOT_OPEN);
if (IsOpen) then
begin
// Retrieve current device control block
if (not GetCommState(FHandle, devCtrlBlock)) then
begin
Result := (SER_API_ERROR);
Exit;
end;
// Modify device control block
devCtrlBlock.BaudRate := baudRate;
case dataBits of
SER_DATABITS_4:
devCtrlBlock.ByteSize := 4;
SER_DATABITS_5:
devCtrlBlock.ByteSize := 5;
SER_DATABITS_6:
devCtrlBlock.ByteSize := 6;
SER_DATABITS_7:
devCtrlBlock.ByteSize := 7;
SER_DATABITS_8:
devCtrlBlock.ByteSize := 8;
else
begin
Result := (SER_INVALID_PARAMETER);
Exit;
end;
end;
case stopBits of
SER_STOPBITS_1:
devCtrlBlock.StopBits := ONESTOPBIT;
SER_STOPBITS_15:
devCtrlBlock.StopBits := ONE5STOPBITS;
SER_STOPBITS_2:
devCtrlBlock.StopBits := TWOSTOPBITS;
else
begin
Result := (SER_INVALID_PARAMETER);
Exit;
end;
end;
flags := devCtrlBlock.Flags;
case parity of
SER_PARITY_NONE:
begin
flags := flags and (not flagParity);
devCtrlBlock.Parity := NOPARITY;
end;
SER_PARITY_EVEN:
begin
flags := flags or flagParity;
devCtrlBlock.Parity := EVENPARITY;
end;
SER_PARITY_ODD:
begin
flags := flags or flagParity;
devCtrlBlock.Parity := ODDPARITY;
end;
SER_PARITY_MARK:
begin
flags := flags or flagParity;
devCtrlBlock.Parity := MARKPARITY;
end;
SER_PARITY_SPACE:
begin
flags := flags or flagParity;
devCtrlBlock.Parity := SPACEPARITY;
end;
else
begin
Result := (SER_INVALID_PARAMETER);
Exit;
end;
end;
flags := flags and flagProtocolClear;
case flowControl of
SER_HANDSHAKE_NONE:
begin
flags := flags or flagProtocolNone;
end;
SER_HANDSHAKE_XONXOFF:
begin
flags := flags or flagProtocolXOnXOff;
end;
SER_HANDSHAKE_HARDWARE:
begin
flags := flags or flagProtocolHardware;
end;
else
begin
Result := (SER_INVALID_PARAMETER);
Exit;
end;
end;
flags := flags and (not (flagErrorChar or flagNull or flagAbortOnError));
devCtrlBlock.Flags := flags;
devCtrlBlock.XonLim := 80;
devCtrlBlock.XoffLim := 200;
devCtrlBlock.XonChar := #$11;
devCtrlBlock.XoffChar := #$13;
// Store device control block
Result := (SER_INVALID_PARAMETER);
if SetCommState(FHandle, devCtrlBlock) then
begin
FBaudRate := baudRate;
FDataBits := dataBits;
FParity := parity;
FStopBits := stopBits;
FFlowControl := flowControl;
Result := (SER_SUCCESS);
end;
end;
end;
function TSerialPort.IsOpen: Boolean;
begin
Result := FHandle <> INVALID_HANDLE_VALUE;
end;
function TSerialPort.IsOverlapped:Boolean;
begin
Result := FOverlapped;
end;
function TSerialPort.SetBufferSizes(input: DWORD; output: DWORD): Integer;
begin
Result := (SER_NOT_OPEN);
if (IsOpen) then
begin
Result := SER_INVALID_PARAMETER;
if SetupComm(FHandle, input, output) then
Result := SER_SUCCESS;
end;
end;
function TSerialPort.Flush: Integer;
begin
Result := (SER_NOT_OPEN);
if (IsOpen) then
begin
Result := (SER_API_ERROR);
if PurgeComm(FHandle, PURGE_TXCLEAR or PURGE_RXCLEAR) then
Result := (SER_SUCCESS);
end;
end;
function TSerialPort.Drain: Integer;
begin
Result := (SER_NOT_OPEN);
if (IsOpen) then
begin
if (flowControl <> SER_HANDSHAKE_NONE) then
begin
Result := (SER_UNSUPPORTED_OPERATION);
Exit;
end;
ZeroMemory(@commtimeoutBlock, SizeOf (commtimeoutBlock));
if (not SetCommtimeouts(FHandle, commtimeoutBlock)) then
begin
Result := (SER_API_ERROR);
Exit;
end;
Result := (SER_API_ERROR);
if FlushFileBuffers(FHandle) then
Result := (SER_SUCCESS);
end;
end;
function TSerialPort.PurgeInput: Integer;
begin
Result := (SER_NOT_OPEN);
if (IsOpen) then
begin
Result := SER_API_ERROR;
if PurgeComm(FHandle, PURGE_RXABORT or PURGE_RXCLEAR) then
Result := (SER_SUCCESS);
end;
end;
function TSerialPort.PurgeOutput: Integer;
begin
Result := (SER_NOT_OPEN);
if (IsOpen) then
begin
Result := SER_API_ERROR;
if PurgeComm(FHandle, PURGE_TXABORT or PURGE_TXCLEAR) then
Result := (SER_SUCCESS);
end;
end;
function TSerialPort.ClearInput: Integer;
begin
Result := (SER_NOT_OPEN);
if (IsOpen) then
begin
Result := SER_API_ERROR;
if PurgeComm(FHandle, PURGE_RXCLEAR) then
Result := (SER_SUCCESS);
end;
end;
function TSerialPort.ClearOutput: Integer;
begin
Result := (SER_NOT_OPEN);
if (IsOpen) then
begin
Result := SER_API_ERROR;
if PurgeComm(FHandle, PURGE_TXCLEAR) then
Result := (SER_SUCCESS);
end;
end;
function TSerialPort.AbortInput: Integer;
begin
Result := (SER_NOT_OPEN);
if (IsOpen) then
begin
Result := SER_API_ERROR;
if PurgeComm(FHandle, PURGE_RXABORT) then
Result := (SER_SUCCESS);
end;
end;
function TSerialPort.AbortOutput: Integer;
begin
Result := (SER_NOT_OPEN);
if (IsOpen) then
begin
Result := SER_API_ERROR;
if PurgeComm(FHandle, PURGE_TXABORT) then
Result := (SER_SUCCESS);
end;
end;
function TSerialPort.SetBreak: Integer;
begin
Result := (SER_NOT_OPEN);
if (IsOpen) then
begin
Result := SER_API_ERROR;
if SetCommBreak(FHandle) then
Result := (SER_SUCCESS);
end;
end;
function TSerialPort.ClearBreak: Integer;
begin
Result := (SER_NOT_OPEN);
if (IsOpen) then
begin
Result := SER_API_ERROR;
if ClearCommBreak(FHandle) then
Result := (SER_SUCCESS);
end;
end;
function TSerialPort.SetDTR: Integer;
begin
Result := (SER_NOT_OPEN);
if (IsOpen) then
begin
Result := SER_API_ERROR;
if EscapeCommFunction(FHandle, Windows.SETDTR) then
Result := (SER_SUCCESS);
end;
end;
function TSerialPort.ClearDTR: Integer;
begin
Result := (SER_NOT_OPEN);
if (IsOpen) then
begin
Result := SER_API_ERROR;
if EscapeCommFunction(FHandle, CLRDTR) then
Result := (SER_SUCCESS);
end;
end;
function TSerialPort.SetRTS: Integer;
begin
Result := (SER_NOT_OPEN);
if (IsOpen) then
begin
if (flowControl <> SER_HANDSHAKE_NONE) then
begin
Result := (SER_UNSUPPORTED_OPERATION);
Exit;
end;
Result := SER_API_ERROR;
if EscapeCommFunction(FHandle, Windows.SETRTS) then
Result := (SER_SUCCESS);
end;
end;
function TSerialPort.ClearRTS: Integer;
begin
Result := (SER_NOT_OPEN);
if (IsOpen) then
begin
if (flowControl <> SER_HANDSHAKE_NONE) then
begin
Result := (SER_UNSUPPORTED_OPERATION);
Exit;
end;
Result := SER_API_ERROR;
if EscapeCommFunction(FHandle, CLRRTS) then
Result := (SER_SUCCESS);
end;
end;
function TSerialPort.SetXOn: Integer;
begin
Result := (SER_NOT_OPEN);
if (IsOpen) then
begin
Result := SER_API_ERROR;
if EscapeCommFunction(FHandle, Windows.SETXON) then
Result := (SER_SUCCESS);
end;
end;
function TSerialPort.SetXOff: Integer;
begin
Result := (SER_NOT_OPEN);
if (IsOpen) then
begin
Result := SER_API_ERROR;
if EscapeCommFunction(FHandle, Windows.SETXOFF) then
Result := (SER_SUCCESS);
end;
end;
function TSerialPort.ResetDevice: Integer;
begin
Result := (SER_NOT_OPEN);
if (IsOpen) then
begin
Result := SER_API_ERROR;
if EscapeCommFunction(FHandle, RESETDEV) then
Result := (SER_SUCCESS);
end;
end;
function TSerialPort.ClearLineErrors: Integer;
var
dwError: DWORD;
begin
Result := (SER_NOT_OPEN);
if (IsOpen) then
begin
Result := SER_API_ERROR;
if ClearCommError(FHandle, dwError, nil) then
Result := (SER_SUCCESS);
end;
end;
function TSerialPort.ConfigDialog: Integer;
var
Device: string;
CommConfig: TCommConfig;
dwSize: DWord;
begin
Device := 'COM' + IntToStr(FPort);
dwSize := SizeOf(CommConfig);
Result := SER_API_ERROR;
if GetDefaultCommConfig(PChar(Device), CommConfig, dwSize) then
begin
if CommConfigDialog(PChar(Device), 0, CommConfig) then
begin
if SetDefaultCommConfig(PChar(Device), @CommConfig, dwSize) then
Result := SER_SUCCESS;
end;
end;
end;
procedure TSerialPort.SyncSend(bufPtr: array of Byte; len: DWORD; timeout: DWORD);
var
bytesSent: DWORD;
begin
if (IsOpen) then
begin
ZeroMemory(@commtimeoutBlock, SizeOf(commtimeoutBlock));
commtimeoutBlock.WriteTotaltimeoutConstant := timeout;
commtimeoutBlock.WriteTotaltimeoutMultiplier := 0;
if SetCommtimeouts(FHandle, commtimeoutBlock) then
begin
bytesSent := 0;
WriteFile(FHandle, bufPtr, len, bytesSent, nil);
end;
end;
end;
function TSerialPort.SyncReceive(out bufPtr: array of Byte; len: DWORD; timeout: DWORD): Integer;
var
bytesRead: DWORD;
begin
Result := 0;
if (IsOpen) then
begin
ZeroMemory(@commtimeoutBlock, SizeOf(commtimeoutBlock));
commtimeoutBlock.ReadTotaltimeoutConstant := timeout;
if SetCommtimeouts(FHandle, commtimeoutBlock) then
begin
bytesRead := 0;
if ReadFile(FHandle, bufPtr, len, bytesRead, nil) then
Result := bytesRead;
end;
end;
end;
function TSerialPort.SyncReceiveByte(out bufPtr: Byte; timeout: DWORD): Integer;
begin
Result := SyncReceive(bufPtr, 1, timeout);
end;
procedure TSerialPort.AsyncSend(bufPtr: array of Byte; len: DWORD; timeout: DWORD);
var
bytesSent: DWORD;
Stat: TComStat;
dwError: DWORD;
begin
if (IsOpen) then
begin
if (ClearCommError(FHandle, dwError, @Stat)) then
begin
if (dwError > 0) then
begin
PurgeComm(FHandle, PURGE_TXABORT or PURGE_TXCLEAR);
end
else
begin
ovInternal.Internal := 0;
ovInternal.InternalHigh := 0;
ovInternal.Offset := 0;
ovInternal.OffsetHigh := 0;
bytesSent := 0;
if (WriteFile(FHandle, bufPtr, len, bytesSent, @ovInternal)) then
begin
end
else
begin
case GetLastError of
ERROR_IO_PENDING:
case (WaitForSingleObject(ovInternal.hEvent, timeout)) of
WAIT_OBJECT_0:
begin
GetOverlappedResult(FHandle, ovInternal, bytesSent, False);
end;
else
begin
PurgeComm(FHandle, PURGE_TXABORT or PURGE_TXCLEAR);
end;
end;
ERROR_ACCESS_DENIED:
begin
PurgeComm(FHandle, PURGE_TXABORT or PURGE_TXCLEAR);
end;
else
begin
PurgeComm(FHandle, PURGE_TXABORT or PURGE_TXCLEAR);
end;
end;
end;
end;
end;
end;
end;
function TSerialPort.AsyncReceive(out bufPtr: array of Byte; len: DWORD; timeout: DWORD): Integer;
var
bytesRead: DWORD;
Stat: TComStat;
dwError: DWORD;
begin
Result := 0;
if (IsOpen) then
begin
if (ClearCommError(FHandle, dwError, @Stat)) then
begin
if (dwError > 0) then
begin
PurgeComm(FHandle, PURGE_RXABORT or PURGE_RXCLEAR);
end
else
begin
ovInternal.Internal := 0;
ovInternal.InternalHigh := 0;
ovInternal.Offset := 0;
ovInternal.OffsetHigh := 0;
bytesRead := 0;
if (ReadFile(FHandle, bufPtr, len, bytesRead, @ovInternal)) then
begin
Result := len;
end
else
begin
case GetLastError of
ERROR_IO_PENDING:
case (WaitForSingleObject(ovInternal.hEvent, timeout)) of
WAIT_OBJECT_0:
begin
GetOverlappedResult(FHandle, ovInternal, bytesRead, False);
Result := bytesRead;
end;
else
begin
PurgeComm(FHandle, PURGE_RXABORT or PURGE_RXCLEAR);
end;
end;
ERROR_ACCESS_DENIED:
begin
PurgeComm(FHandle, PURGE_RXABORT or PURGE_RXCLEAR);
end;
else
begin
PurgeComm(FHandle, PURGE_RXABORT or PURGE_RXCLEAR);
end;
end;
end;
end;
end;
end;
end;
function TSerialPort.AsyncReceiveByte(out bufPtr: Byte; timeout: DWORD): Integer;
begin
Result := AsyncReceive(bufPtr, 1, timeout);
end;
procedure TSerialPort.Send(bufPtr: array of Byte; len: DWORD; timeout: DWORD);
begin
if FOverlapped then
begin
AsyncSend(bufPtr, len, timeout);
end
else
begin
SyncSend(bufPtr, len, timeout);
Drain;
end;
end;
function TSerialPort.Receive(out bufPtr: array of Byte; len: DWORD; timeout: DWORD): Integer;
begin
if FOverlapped then
begin
Result := AsyncReceive(bufPtr, len, timeout);
end
else
begin
Result := SyncReceive(bufPtr, len, timeout);
end;
end;
function TSerialPort.Receive(out bufPtr: array of Byte; len: DWORD; const startBytes, endBytes: array of Byte; timeout: DWORD): Integer;
var
bytesRead, FOffset, FIndex: Integer;
FFlagStart, FFlagEnd: Boolean;
begin
Result := 0;
bytesRead := 0;
FOffset := 0;
FIndex := 0;
FFlagStart := (High(startBytes) = -1);
FFlagEnd := (High(endBytes) = -1);
if (FFlagStart and FFlagEnd) then Exit;
timeoutTimer.startMillis(timeout);
while True do
begin
if (timeoutTimer.isExpired()) then Break;
if ((FOffset + 1) <= len) then
begin
bytesRead := ReceiveByte(bufPtr[FOffset], timeout);
end
else
begin
Break;
end;
Inc(FOffset, bytesRead);
if (not FFlagStart) then
begin
if (bufPtr[FIndex] = startBytes[FIndex]) then
begin
Inc(FIndex);
end
else
begin
FOffset := 0;
FIndex := 0;
end;
if (FIndex = Length(startBytes)) then
begin
FFlagStart := True;
FIndex := 0;
end;
end;
if ((not FFlagEnd) and FFlagStart) then
begin
if (bufPtr[FOffset - 1] = endBytes[FIndex]) then
begin
Inc(FIndex);
end
else
begin
FIndex := 0;
end;
if (FIndex = Length(endBytes)) then
begin
FFlagEnd := True;
FIndex := 0;
end;
end;
if (FFlagStart and FFlagEnd) then
begin
Result := FOffset;
Break;
end;
end;
end;
function TSerialPort.ReceiveByte(out bufPtr: Byte; timeout: DWORD): Integer;
begin
if FOverlapped then
begin
Result := AsyncReceiveByte(bufPtr, timeout);
end
else
begin
Result := SyncReceiveByte(bufPtr, timeout);
end;
end;
procedure TSerialPort.SetPort(Value: Integer);
begin
if not IsOpen then FPort := Value;
end;
procedure TSerialPort.SetBaudRate(Value: DWORD);
begin
if not IsOpen then FBaudRate := Value;
end;
procedure TSerialPort.SetDataBits(Value: Integer);
begin
if not IsOpen then FDataBits := Value;
end;
procedure TSerialPort.SetParity(Value: Integer);
begin
if not IsOpen then FParity := Value;
end;
procedure TSerialPort.SetStopBits(Value: Integer);
begin
if not IsOpen then FStopBits := Value;
end;
procedure TSerialPort.SetFlowControl(Value: Integer);
begin
if not IsOpen then FFlowControl := Value;
end;
end.
|
阿莫论坛20周年了!感谢大家的支持与爱护!!
你熬了10碗粥,别人一桶水倒进去,淘走90碗,剩下10碗给你,你看似没亏,其实你那10碗已经没有之前的裹腹了,人家的一桶水换90碗,继续卖。说白了,通货膨胀就是,你的钱是挣来的,他的钱是印来的,掺和在一起,你的钱就贬值了。
|