www.pudn.com > cdma.rar > COMFUN.pas
unit COMFUN;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,Dialogs, StdCtrls,Forms,ComCtrls;
type
TCommThread = class;
Tcomfun = Class(TObject)
private
Receive: Boolean; //开关变量，代表是否接收
FCommThread:TCommThread;//串口处理线程
protected
// procedure Execute; override;
procedure SortOver(Sender:TObject);
public
Post_Event: THandle;//创建事件同步对象的句柄
hSend:THandle; //发送串口的句柄
//Commcount:String;
// constructor Create(CreateSuspended: Boolean;var SortArray: array of Integer);
function Opencom(CommName:String):boolean;
function wirtcom(CommStr:String):boolean;
function closecom():boolean;
published
end;
//==发送串口数据的线程===============================================
TCommThread = class(TThread)
//写入函数，阻塞模式，直到写入完成，返回写入字符个数
//function WriteComm(pBuf:PChar;nLen:integer):integer;
private
FidComDev:Cardinal;
protected
procedure Execute; override; //主执行过程
public
function wirtSort(CommName:String):Integer;
constructor Create(idComDev:Cardinal;Commcount:String);//
end;
TRecvThread = Class(TThread)
public
hRecv : THandle;//接收串口的句柄
Read_os:Toverlapped;//重叠结构的变量
Receive: Boolean; //开关变量，代表是否接收
constructor Create(idComDev:Cardinal;Commcount:String);//
private
//数据接收消息处理函数
procedure WMCOMMNOTIFY(var Message: TMessage); message WM_COMMNOTIFY;
protected
procedure Execute;override;
end;
var
wirtcomint:Integer;
CommTStr:String;
fWirtVal:boolean;
implementation
uses setcom;
//-------------读线程TRecvThread-------------------------------------------------------------------
//接收串口数据的线程执行体
constructor TCommThread.Create(idComDev:Cardinal;Commcount:String);
begin
inherited Create(True); //以立即执行方式创建线程
//FidComDev := idComDev;
//CommTStr:=Commcount;
end;
procedure TRecvThread.Execute ;
var
dwEvtMask, dwTranser: Dword;
Ok: Boolean;
Os: Toverlapped;
begin
Receive := True;
FillChar(Os, SizeOf(Os), 0);
// 创建重叠读事件对象
Os.hEvent := CreateEvent(nil, True, False, nil);
if Os.hEvent = null then
begin
MessageBox(0, 'Os.Event Create Error !', 'Notice', MB_OK);
Exit;
end;
if (not SetCommMask(hRecv, EV_RXCHAR)) then
begin
MessageBox(0, 'SetCommMask Error !', 'Notice', MB_OK);
Exit;
end;
while (Receive) do
begin
dwEvtMask := 0;
// 等待通讯事件发生
if not WaitCommEvent(hRecv, dwEvtMask, @Os) then
begin
if ERROR_IO_PENDING = GetLastError then
GetOverLappedResult(hRecv, Os, dwTranser, True)
end;
if ((dwEvtMask and EV_RXCHAR) = EV_RXCHAR) then
begin
// 等待允许传递WM_COMMNOTIFY通讯消息
WaitForSingleObject(Post_event, INFINITE);
// 处理WM_COMMNOTIFY消息时不再发送WM_COMMNOTIFY消息
ResetEvent(Post_Event);
// 传递WM_COMMNOTIFY通讯消息
Ok := PostMessage(frmMain.Handle, WM_COMMNOTIFY, hRecv, 0);
if (not Ok) then
begin
MessageBox(0, 'PostMessage Error !', 'Notice', MB_OK);
Exit;
end;
end;
end;
CloseHandle(Os.hEvent); // 关闭重叠读事件对象
end;
// 数据接收消息处理函数
procedure TfrmMain.WMCOMMNOTIFY(var Message: TMessage);
var
CommState: ComStat;
dwNumberOfBytesRead: Dword;
ErrorFlag: Dword;
InputBuffer: array[0..1024] of Char;
recvString : string;
begin
if not ClearCommError(hRecv, ErrorFlag, @CommState) then
begin
MessageBox(0, 'ClearCommError !', 'Notice', MB_OK);
PurgeComm(hRecv, Purge_Rxabort or Purge_Rxclear);
Exit;
end;
if (CommState.cbInQue > 0) then
begin
fillchar(InputBuffer, CommState.cbInQue, #0);
// 接收通讯数据
if (not ReadFile(hRecv, InputBuffer, CommState.cbInQue,
dwNumberOfBytesRead, @Read_os)) then
begin
ErrorFlag := GetLastError();
if (ErrorFlag <> 0) and (ErrorFlag <> ERROR_IO_PENDING) then
begin
Receive := False;
raise Exception.Create('读串口数据出错!');
end
else
begin
WaitForSingleObject(hRecv, INFINITE); // 等待操作完成
GetOverlappedResult(hRecv, Read_os,
dwNumberOfBytesRead, False);
end;
end;
if dwNumberOfBytesRead > 0 then
begin
Read_Os.Offset := Read_Os.Offset + dwNumberOfBytesRead;
// 处理接收的数据
InputBuffer[dwNumberOfBytesRead]:=#0;
mmoRecv.Lines.Add('接收到：'+intToStr(dwNumberOfBytesRead)+'个字节的数据');
mmoRecv.Lines.Add(strPas(inputBuffer));
end;
end;
// 允许发送下一个WM_COMMNOTIFY消息
SetEvent(Post_Event);
end;
//-------------写线程TCommThread-------------------------------------------------------------------
constructor TCommThread.Create(idComDev:Cardinal;Commcount:String);
begin
inherited Create(True); //以立即执行方式创建线程
FidComDev := idComDev;
CommTStr:=Commcount;
end;
procedure TCommThread.Execute;
begin
FreeOnTerminate := false; //当线程执行完，终止线程
wirtcomint:=wirtSort(CommTStr);
//wirtSort(CommTStr);
end;
function TCommThread.wirtSort(CommName:String):Integer;
var
dwNumberOfBytesWritten, dwNumberOfBytesToWrite,
ErrorFlag, dwWhereToStartWriting: DWORD;
pDataToWrite: PChar;
RXFinish:Bool;
//typedef struct _OVERLAPPED {
// ULONG_PTR Internal;
// ULONG_PTR InternalHigh;
// DWORD Offset;
// DWORD OffsetHigh;
// HANDLE hEvent;
// } OVERLAPPED; 包含了在异步输入输出种的信息
//载delphi中就是TOVERLAPED
write_os: Toverlapped;
begin
dwWhereToStartWriting := 0;
dwNumberOfBytesWritten := 0;
//设置将要向串口里写的数据长度
dwNumberOfBytesToWrite := Length(CommName);
//RXFinish:=false;
if (dwNumberOfBytesToWrite = 0) then
begin
result :=0;
exit;
end;
//将edtcomm里的文本传到pDataToWrite缓冲区
pDataToWrite := Pchar(CommName);
//把指定变量X在内存段中所占的低Count个字节赋为相同的值Value，
//其中Value是填充的值，只能是Byte、Char或Boolean等单字节类型的值。
//在Free Pascal中稍加扩展为FillChar(var X; Count: Longint; Value),
//功能没变。
FillChar(Write_Os, SizeOf(write_os), 'a');
// 为重叠写创建事件对象
Write_Os.hEvent := CreateEvent(nil, True, False, nil);
//设置直到最后一个字符被发送
//SetCommMask(hSend, EV_TXEMPTY);
repeat
// 发送通讯数据
if not WriteFile(FidComDev, pDataToWrite[dwWhereToStartWriting],
dwNumberOfBytesToWrite, dwNumberOfBytesWritten,
@write_os) then
begin
ErrorFlag := GetLastError;
//form2.mmoSend.Lines.Add('ErrorFlag：'+intToStr(dwNumberOfBytesToWrite)+'个字节的数据');
if ErrorFlag <> 0 then
begin
if ErrorFlag = ERROR_IO_PENDING then
begin
WaitForSingleObject(Write_Os.hEvent, INFINITE);
//等待设置好的事件发生,非零表示成功，零表示失败
//如bWait为FALSE，而且异步操作仍在执行，则函数回返回零，
//而GetLastError会设置成ERROR_IO_INCOMPLETE
//函数GetOverLappedResult对串行设备或用DeviceIoControl函数打开的对象正确操作。
//GetOverlappedResult函数来得到异步函数的执行情况
//如果函数调用返回FALSE则可以用GetLastError来得到错误，
//如果返回成功则可以通过lpNumberOfBytesTransferred参数来确定
//当前有多少数据已经被读或写。
//lpOverlapped参数必须与调用ReadFile或WriteFile时
//使用同一个数据区。
//最后一个参数bWait表明是否等待异步操作结束时才返回，
//如果设置为TRUE就可以等待文件读写完成时返回，
//否则就会马上返回，
//利用这个特点可以利用它来等待异步文件操作的结束（
//就如同等待事件变为有信号状态一样起到相同的作用）
//重叠模型
//用于因为读写操作未能完成返回ERROR_IO_PENDING的时候
//得到失败的详细的信息
//GetOverlappedResult API 在发出异步 I/O 请求后,
//您可以使用 GetOverlappedResult API 来轮询请求的状态,
//或者等待请求的完成。当请求完成时,GetOverlappedResult
//将返回请求过程所传输的字节数
GetOverlappedResult(hSend, Write_os,
dwNumberOfBytesWritten, False);
end
else
begin
result :=0;
exit;
end;
end;
end;
//减去已发生的数据长度
Dec(dwNumberOfBytesToWrite, dwNumberOfBytesWritten);
//记录已发送的数据长度
Inc(dwWhereToStartWriting, dwNumberOfBytesWritten);
//直到全部发送完
until (dwNumberOfBytesToWrite <= 0);
result :=dwWhereToStartWriting;
end;
//------------TCommThread类结束------------------------------------------------------------------------
//-----------Tcomfun类-------------------------------------------------------------------------
function Tcomfun.wirtcom(CommStr:String):boolean;
var
fRetVal:boolean;
begin
//result := false;
FCommThread :=TCommThread.Create(hSend,CommStr);
//FCommThread.OnTerminate
FCommThread.OnTerminate:=SortOver;
FCommThread.Resume;
FCommThread.WaitFor;
FCommThread.free;
{ if wirtcomint<>0 then
begin
//form2.mmoSend.Lines.Add('已发送：'+intToStr(wirtcomint)+'个字节的数据');
fWirtVal :=true;
end
else
begin
fWirtVal := false;
//form2.mmoSend.Lines.Add('发送数据失败11');
//Application.MessageBox('发送数据失败','',MB_OK );
//EXIT;
end;}
result :=fWirtVal;
end;
procedure Tcomfun.SortOver(Sender:TObject);
begin
if wirtcomint<>0 then
begin
//FCommThread.free;
//form2.mmoSend.Lines.Add('已发送：'+intToStr(wirtcomint)+'个字节的数据');
fWirtVal :=true;
end
else
begin
fWirtVal := false;
//form2.mmoSend.Lines.Add('发送数据失败11');
//Application.MessageBox('发送数据失败','',MB_OK );
//EXIT;
end;
//result := wirtcomint;
end;
function Tcomfun.closecom():boolean;
begin
CloseHandle(hSend);
end;
function Tcomfun.Opencom(CommName:String):boolean;
var
dcb: TDCB;
Error: Boolean;
begin
result := false;
//CommName := form2.ComboBox1.Text;
// 打开发送串口
hSend := CreateFile(PChar(CommName), GENERIC_READ or GENERIC_WRITE, 0, 0,
OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
// hWecv:= hWend;
if (hSend = INVALID_HANDLE_VALUE) then exit;
// 设置输入和输出缓冲区大小
SetupComm(hSend, 1024, 1024);//对指定设备初始化相关参数
//设置串口的波特率、字符位数、奇偶校验、停止位
GetCommState(hSend, dcb);//用指定通信设备的当前控制设置真充设备控制块（DCB)
dcb.BaudRate := strToInt(form2.ComboBox2.Text);//波特率
dcb.ByteSize := 8;//字符位数
dcb.StopBits := 0 ;//0,1,2分别为１，1.5，２
dcb.Parity := 0;//奇偶校验位
Error := SetCommState(hSend,dcb);//重新初始化所有硬件和控制设置
result :=Error;
{if (not Error) then
raise Exception.Create('设置'+ComboBox1.text+'错误');}
end;
end.