📄 spcomm.pas.~8~
字号:
property StopBits: TStopBits read FStopBits write SetStopBits;
property XonChar: AnsiChar read FXonChar write SetXonChar;
property XoffChar: AnsiChar read FXoffChar write SetXoffChar;
property ReplacedChar: AnsiChar read FReplacedChar write SetReplacedChar;
property ReadIntervalTimeout: DWORD read FReadIntervalTimeout write SetReadIntervalTimeout;
property ReadTotalTimeoutMultiplier: DWORD read FReadTotalTimeoutMultiplier write SetReadTotalTimeoutMultiplier;
property ReadTotalTimeoutConstant: DWORD read FReadTotalTimeoutConstant write SetReadTotalTimeoutConstant;
property WriteTotalTimeoutMultiplier: DWORD read FWriteTotalTimeoutMultiplier write SetWriteTotalTimeoutMultiplier;
property WriteTotalTimeoutConstant: DWORD read FWriteTotalTimeoutConstant write SetWriteTotalTimeoutConstant;
property OnReceiveData: TReceiveDataEvent
read FOnReceiveData write FOnReceiveData;
property OnReceiveError: TReceiveErrorEvent
read FOnReceiveError write FOnReceiveError;
property OnModemStateChange: TModemStateChangeEvent
read FOnModemStateChange write FOnModemStateChange;
property OnRequestHangup: TNotifyEvent
read FOnRequestHangup write FOnRequestHangup;
property OnSendDataEmpty: TSendDataEmptyEvent
read FOnSendDataEmpty write FOnSendDataEmpty;
end;
procedure Register;
implementation
(******************************************************************************)
// TComm PUBLIC METHODS
(******************************************************************************)
constructor TComm.Create( AOwner: TComponent );
begin
inherited Create( AOwner );
ReadThread := nil;
WriteThread := nil;
hCommFile := 0;
hCloseEvent := 0;
FSendDataEmpty := True;
FCommName := 'COM2';
FBaudRate := 9600;
FParityCheck := False;
FOutx_CtsFlow := False;
FOutx_DsrFlow := False;
FDtrControl := DtrEnable;
FDsrSensitivity := False;
FTxContinueOnXoff := True;
FOutx_XonXoffFlow := True;
FInx_XonXoffFlow := True;
FReplaceWhenParityError := False;
FIgnoreNullChar := False;
FRtsControl := RtsEnable;
FXonLimit := 500;
FXoffLimit := 500;
FByteSize := _8;
FParity := None;
FStopBits := _1;
FXonChar := chr($11); // Ctrl-Q
FXoffChar := chr($13); // Ctrl-S
FReplacedChar := chr(0);
// 串口超时控制参数 TCommTimeouts 结构参数意义:
// ReadIntervalTimeout：两字符之间最大的延时，当读取串口数据时，
// 一旦两个字符传输的时间差超过该时间，读取函数将返回现有的数据。
// 设置为0表示该参数不起作用。
// ReadTotalTimeoutMultiplier：读取每字符间的超时。
// ReadTotalTimeoutConstant：一次读取串口数据的固定超时。
// WriteTotalTimeoutMultiplier：写入每字符间的超时。
// WriteTotalTimeoutConstant：一次写入串口数据的固定超时。
// 所以:
// 在一次读取串口的操作中，其超时为ReadTotalTimeoutMultiplier乘以读取的字节数
// 再加上 ReadTotalTimeoutConstant。将ReadIntervalTimeout设置为MAXDWORD，并将
// ReadTotalTimeoutMultiplier 和ReadTotalTimeoutConstant设置为0，表示读取操作将
// 立即返回存放在输入缓冲区的字符。
// 在一次写入串口的操作中，其超时为WriteTotalTimeoutMultiplier乘以写入的字节数
// 再加上 WriteTotalTimeoutConstant。
FReadIntervalTimeout := 100; // 读字符间隔超时时间: 100 ms
FReadTotalTimeoutMultiplier := 1; // 读操作时每字符间的超时时间: 1 ms (n个字符总共为n ms)
FReadTotalTimeoutConstant := 100; // 基本的(额外的)读超时时间: 500 ms
FWriteTotalTimeoutMultiplier := 1; // 写操作时每字符间的超时时间: 1 ms (n个字符总共为n ms
FWriteTotalTimeoutConstant := 100; // 基本的(额外的)写超时时间: 100 ms
FInputLen := 0; //默认是一次执行全部读取
FUseRWThread := False; //默认为异步操作
OutputTimeout := 500;
InputTimeout := 500;
if not (csDesigning in ComponentState) then
FHWnd := AllocateHWnd(CommWndProc)
end;
destructor TComm.Destroy;
begin
if not (csDesigning in ComponentState) then
DeallocateHWnd(FHwnd);
inherited Destroy;
end;
{****************************************************************************
** Procedure: StartComm** Author: Administrator** Date: 23-七月-2007** Arguments: None** Result: None** PURPOSE: Starts communications over the comm port.** PARAMETERS:
** hNewCommFile - This is the COMM File handle to communicate with.
** This handle is obtained from TAPI.
** Output:
** Successful: Startup the communications.
** Failure: Raise a exception
** COMMENTS:
** StartComm makes sure there isn't communication in progress already,
** creates a Comm file, and creates the read and write threads. It
** also configures the hNewCommFile for the appropriate COMM settings.
** If StartComm fails for any reason, it's up to the calling application
** to close the Comm file handle.
****************************************************************************}procedure TComm.StartComm;
var
hNewCommFile: THandle;
sCommName: string;
begin
// Are we already doing comm?
if (hCommFile <> 0) then
raise ECommsError.Create( 'This serial port already opened' );
//一般COM9以上的串口设备只能用"\\.\COM10",不能写成COM10, 还要注意大小写
sCommName:= UpperCase(FCommName);
if Length(FCommName)>4 then
sCommName:=UpperCase('\\.\'+FCommName);
hNewCommFile := CreateFile( PChar(sCommName),
GENERIC_READ or GENERIC_WRITE,
0, {not shared}
nil, {no security ??}
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED,
0 {template} );
if hNewCommFile = INVALID_HANDLE_VALUE then
raise ECommsError.Create( 'Error opening serial port' );
// Is this a valid comm handle?
if GetFileType( hNewCommFile ) <> FILE_TYPE_CHAR then
begin
CloseHandle( hNewCommFile );
raise ECommsError.Create( 'File handle is not a comm handle ' )
end;
if not SetupComm( hNewCommFile, 10000, 10000 ) then
//if not SetupComm( hNewCommFile, 4096, 4096 ) then
begin
CloseHandle( hCommFile );
raise ECommsError.Create( 'Cannot setup comm buffer' )
end;
// It is ok to continue.
hCommFile := hNewCommFile;
// purge any information in the buffer
PurgeComm( hCommFile, PURGE_TXABORT or PURGE_RXABORT or
PURGE_TXCLEAR or PURGE_RXCLEAR ) ;
FSendDataEmpty := True;
// Setting the time-out value
_SetCommTimeout;
// Querying then setting the comm port configurations.
_SetCommState;
// Create the event that will signal the threads to close.
hCloseEvent := CreateEvent( nil, True, False, nil );
if hCloseEvent = 0 then
begin
CloseHandle( hCommFile );
hCommFile := 0;
raise ECommsError.Create( 'Unable to create event' )
end;
if FUseRWThread then
begin
CreateAndStartRWThread;
end;
// Everything was created ok. Ready to go!
end; {TComm.StartComm}
{****************************************************************************
** Procedure: StopComm** Author: Administrator** Date: 23-七月-2007** Arguments: None** Result: None** PURPOSE: Stop and end all communication threads.** PARAMETERS: none
** RETURN VALUE: none
** COMMENTS:
** Tries to gracefully signal all communication threads to
** close, but terminates them if it has to.
****************************************************************************}procedure TComm.StopComm;
begin
// No need to continue if we're not communicating.
if hCommFile = 0 then
Exit;
// Close the threads.
CloseRWThread;
// Not needed anymore.
CloseHandle( hCloseEvent );
// Now close the comm port handle.
CloseHandle( hCommFile );
hCommFile := 0
end; {TComm.StopComm}
{****************************************************************************
** Procedure: WriteCommData** Author: Administrator** Date: 23-七月-2007** Arguments: pDataToWrite: PChar; dwSizeofDataToWrite: Word** Result: Boolean** PURPOSE: Send a String to the Write Thread to be written to the Comm.** PARAMETERS:
** pszStringToWrite - String to Write to Comm port.
** nSizeofStringToWrite - length of pszStringToWrite.
** bIsManualRead -读缓冲区读取方式,默认False为事件方式,否则为读函数调用方式,
** 由用户在写完数据后自己调用读函数获取读缓冲区数据
** RETURN VALUE:
** Returns TRUE if the PostMessage is successful.
** Returns FALSE if PostMessage fails or Write thread doesn't exist.
** COMMENTS:
** This is a wrapper function so that other modules don't care that
** Comm writing is done via PostMessage to a Write thread. Note that
** using PostMessage speeds up response to the UI (very little delay to
** 'write' a string) and provides a natural buffer if the comm is slow
** (ie: the messages just pile up in the message queue).
** Note that it is assumed that pszStringToWrite is allocated with
** LocalAlloc, and that if WriteCommData succeeds, its the job of the
** Write thread to LocalFree it. If WriteCommData fails, then its
** the job of the calling function to free the string.
****************************************************************************}function TComm.WriteCommData( pDataToWrite: PChar; dwSizeofDataToWrite: Word): Boolean;
var
Buffer: Pointer;
begin
if (WriteThread <> nil) and (dwSizeofDataToWrite <> 0) then
begin
Buffer := Pointer(LocalAlloc( LPTR, dwSizeofDataToWrite+1 ));
Move( pDataToWrite^, Buffer^, dwSizeofDataToWrite );
if PostThreadMessage( WriteThread.ThreadID, PWM_COMMWRITE,
WPARAM(dwSizeofDataToWrite), LPARAM(Buffer) ) then
begin
FSendDataEmpty := False;
Result := True;
Exit;
end
end;
Result := False
end; {TComm.WriteCommData}
(****************************************************************************
* 函数: WriteDataToComm(DataPtr: pchar; DataSize: DWORD; Timeout: DWORD=500);
* 功能: 由通信端口送出字符串数据
* 作者: Administrator
* 日期: 2007-09-25
* 参数: DataPtr: pchar; 待发送的字符串缓冲区
DataSize: DWORD; 字符串长度
Timeout: DWORD=500 写超时时间
* 返回值: Boolean 是否发送成功
* 描述:
****************************************************************************)
function TComm.WriteDataToComm(ADataPtr: PChar; ADataSize: DWORD; ATimeout: DWORD=500): Boolean;
var
t1,
dwLastError,
dwHandleSignaled,
dwNumberOfBytesWritten,
dwWhereToStartWriting : DWORD;
HandlesToWaitFor: array[0..1] of THandle;
ovOverLapped: TOverlapped; // Needed for overlapped I/O
buseRwThread: Boolean;
begin
// Do nothing if port has not been opened
Result := False;
if hCommFile = 0 then Exit;
buseRwThread:= UseRWThread;
UseRWThread:=False;
dwNumberOfBytesWritten := 0;
dwWhereToStartWriting := 0; // Start at the beginning.
if ADataSize < 1 then //空数据写
Exit;
// create event for overlapped I/O
ovOverLapped.hEvent := CreateEvent(nil, // pointer to security attributes
FALSE, // flag for manual-reset event
FALSE, // flag for initial state
''); // pointer to event-object name
HandlesToWaitFor[0] := hCloseEvent;
HandlesToWaitFor[1] := ovOverLapped.hEvent;
if ovOverLapped.hEvent = INVALID_HANDLE_VALUE then
// Handle the error. "WriteData(): CreateEvent() failed"
Exit;
try
t1:= GetTickCount; //获得Windows系统开始运行到现在所经历的时间，单位毫秒
// Keep looping until all characters have been written.
repeat
if not WriteFile(hCommFile, // handle to file to write to
ADataPtr[ dwWhereToStartWriting ],// pointer to data to write to file
ADataSize, // number of bytes to write
dwNumberOfBytesWritten, // pointer to number of bytes written
@ovOverLapped) then // pointer to structure needed for overlapped I/O
begin
// WriteFile failed. Expected; lets handle it.
dwLastError := GetLastError;
// Its possible for this error to occur if the
// service provider has closed the port. Time to end.
if dwLastError = ERROR_INVALID_HANDLE then
begin
Exit;
end;
// Unexpected error. No idea what.
if dwLastError <> ERROR_IO_PENDING then
begin
Exit;
end;
// This is the expected ERROR_IO_PENDING case.
// Wait for either overlapped I/O completion,
// or for the CloseEvent to get signaled. 将用于等待多个对象变为有信号状态
//DWORD WaitForMultipleObjects( DWORD nCount, // 等待的对象数量
//CONST HANDLE *lpHandles, // 对象句柄数组指针
//BOOL fWaitAll, // 等待方式，为TRUE表示等待全部对象都变为有信号状态才返回，为FALSE表示任何一个对象变为有信号状态则返回
//DWORD dwMilliseconds); // 超时设置，以ms为单位，如果为INFINITE表示无限期的等待
dwHandleSignaled := WaitForMultipleObjects(2, @HandlesToWaitFor,
False, ATimeout);
case dwHandleSignaled of
WAIT_OBJECT_0: // CloseEvent signaled!
begin
// Time to exit.
Exit;
end;
WAIT_OBJECT_0 + 1: // Wait finished.
begin
// Time to get the results of the WriteFile
if not GetOverlappedResult(hCommFile,
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -