小弟是一新手做一个串口通信程序，下面是原程序。当我执行是老是出现 [Fatal Error]Unit1.pas(383:Could not create output file "Unit1.dcu")不知道那里出现问题，请各位大虾帮忙改改，谢谢！！ unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls;
const WM_COMMNOTIFY = WM_USER + 100; // 通讯消息
type TForm1 = class(TForm) StatusBar1: TStatusBar; Memo1: TMemo; Memo2: TMemo; Label1: TLabel; Label2: TLabel; GroupBox1: TGroupBox; Label3: TLabel; Label4: TLabel; Label5: TLabel; Label6: TLabel; ComboBox4: TComboBox; ComboBox3: TComboBox; ComboBox2: TComboBox; ComboBox1: TComboBox; Label7: TLabel; ComboBox5: TComboBox; btnOpenCom: TButton; btnSendData: TButton; btnReceiveData: TButton; btnCloseCom: TButton; procedure btnOpenComClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure btnCloseComClick(Sender: TObject); procedure btnSendDataClick(Sender: TObject); procedure btnReceiveDataClick(Sender: TObject); private { Private declarations } procedure WMCOMMNOTIFY(var Message :TMessage);message WM_COMMNOTIFY; public { Public declarations } end;
var Form1: TForm1;
implementation
{$R *.dfm}
var CommHandle:THandle; PostEvent:THandle; ReadOs : Toverlapped; Connected:Boolean; Receive :Boolean; ReceiveData : Dword;
procedure AddToMemo(Str:PChar;Len:Dword); // 接收的数据送入显示区Memo2 begin //接收厚的字符串为NULL终止 str[Len]:=#0; Form1.Memo2.Text:=Form1.Memo2.Text+StrPas(str); end;
procedure CommWatch(Ptr:Pointer);stdcall; // 通讯监视线程 var dwEvtMask,dwTranser : Dword; PostMsgFlag: Boolean; overlapped : Toverlapped;
begin Receive :=True; FillChar(overlapped,SizeOf(overlapped),0); overlapped.hEvent :=CreateEvent(nil,True,False,nil); // 创建重叠读事件对象 if overlapped.hEvent=null then begin MessageBox(0,'overlapped.Event Create Error !','Notice',MB_OK); Exit; end;
//进入串口监视状态，直到全局变量Receive置为False停止 while(Receive) do begin dwEvtMask:=0; // 等待串口事件发生 if not WaitCommEvent(CommHandle,dwEvtMask,@overlapped) then begin if ERROR_IO_PENDING=GetLastError then GetOverLappedResult(CommHandle,overlapped,dwTranser,True) end;
//串口读事件发布消息 if ((dwEvtMask and EV_RXCHAR)=EV_RXCHAR) then begin // 等待允许传递WM_COMMNOTIFY通讯消息 WaitForSingleObject(Postevent,INFINITE); // 处理WM_COMMNOTIFY消息时不再发送WM_COMMNOTIFY消息 ResetEvent(PostEvent); // 传递WM_COMMNOTIFY通讯消息，告知主线程调用读串口的过程 PostMsgFlag:=PostMessage(Form1.Handle,WM_COMMNOTIFY,CommHandle,0); if (not PostMsgFlag) then begin MessageBox(0,'PostMessage Error !','Notice',MB_OK); Exit; end; end; end; CloseHandle(overlapped.hEvent); // 关闭重叠读事件对象 end;
procedure TForm1.WMCOMMNOTIFY(var Message :TMessage); // 消息处理函数 var CommState : ComStat; dwNumberOfBytesRead : Dword; ErrorFlag : Dword; InputBuffer : Array [0..1024] of Char;
begin if not ClearCommError(CommHandle,ErrorFlag,@CommState) then begin MessageBox(0,'ClearCommError !','Notice',MB_OK); PurgeComm(CommHandle,Purge_Rxabort or Purge_Rxclear); Exit; end;
if CommState.cbInQue>0 then begin fillchar(InputBuffer,CommState.cbInQue,#0); // 接收通讯数据 if (not ReadFile( CommHandle,InputBuffer,CommState.cbInQue, dwNumberOfBytesRead,@ReadOs )) then begin ErrorFlag := GetLastError(); if (ErrorFlag <> 0) and (ErrorFlag <> ERROR_IO_PENDING) then begin MessageBox(0,'ReadFile Error!','Notice',MB_OK); Receive :=False; CloseHandle(ReadOs.hEvent); CloseHandle(PostEvent); CloseHandle(CommHandle); Exit; end else begin WaitForSingleObject(CommHandle,INFINITE); // 等待操作完成 GetOverlappedResult(CommHandle,ReadOs,dwNumberOfBytesRead,False); end; end; if dwNumberOfBytesRead>0 then begin ReadOs.Offset :=ReadOs.Offset+dwNumberOfBytesRead; ReceiveData := ReadOs.Offset; // 处理接收的数据 AddToMemo(InputBuffer,dwNumberOfBytesRead); end; end; // 允许发送下一个WM_COMMNOTIFY消息 SetEvent(PostEvent); end;
procedure TForm1.btnOpenComClick(Sender: TObject); var CommTimeOut : TCOMMTIMEOUTS; DCB : TDCB;
begin StatusBar1.SimpleText := '连接中...';
//发送消息的句柄 PostEvent:=CreateEvent(nil,True,True,nil); if PostEvent=null then begin MessageBox(0,'CreateEvent Error!','Notice',MB_OK); StatusBar1.SimpleText := '串口打开失败'; Exit; end;
//Overlapped Read建立句柄 ReadOs.hEvent :=CreateEvent(nil,true,False,nil); if ReadOs.hEvent=null then begin MessageBox(0,'CreateEvent Error!','Notice',MB_OK); CloseHandle(PostEvent); StatusBar1.SimpleText := '串口打开失败'; Exit; end;
//建立串口句柄 CommHandle := CreateFile(PChar(ComboBox1.Text),GENERIC_WRITE or GENERIC_READ, 0,nil,OPEN_EXISTING,FILE_FLAG_OVERLAPPED or FILE_ATTRIBUTE_NORMAL,0);
if CommHandle = INVALID_HANDLE_VALUE then begin CloseHandle(PostEvent); CloseHandle(ReadOs.hEvent); MessageBox(0,'串口打开失败!','Notice',MB_OK); StatusBar1.SimpleText := '串口打开失败'; Exit; end; StatusBar1.SimpleText := '已同端口 '+ ComboBox1.Text + ' 连接！';
//设置超时 CommTimeOut.ReadIntervalTimeout := MAXDWORD; CommTimeOut.ReadTotalTimeoutMultiplier := 0; CommTimeOut.ReadTotalTimeoutConstant := 0; SetCommTimeouts(CommHandle, CommTimeOut);
//设置读写缓存 SetupComm(CommHandle,4096,1024);
//对串口进行指定配置 GetCommState(CommHandle,DCB); DCB.BaudRate := StrToInt(ComboBox2.Text); DCB.ByteSize := StrToInt(ComboBox3.Text); DCB.Parity := ComboBox4.ItemIndex;; DCB.StopBits := ComboBox5.ItemIndex; Connected := SetCommState(CommHandle, DCB);
//关系串口的读事件 if (not SetCommMask(CommHandle,EV_RXCHAR)) then begin MessageBox(0,'SetCommMask Error !','Notice',MB_OK); Exit; end;
if (Connected) then begin btnOpenCom.Enabled :=False; end else begin CloseHandle(CommHandle); StatusBar1.SimpleText := '设置串口失败'; end; end;
procedure TForm1.FormCreate(Sender: TObject); begin Connected:=False; ComboBox1.ItemIndex:=0; ComboBox2.ItemIndex:=0; ComboBox3.ItemIndex:=4; ComboBox4.ItemIndex:=0; ComboBox5.ItemIndex:=0; end;
procedure TForm1.btnCloseComClick(Sender: TObject); begin if not Connected then begin StatusBar1.SimpleText := '未打开串口'; Exit; end; Receive :=False; //取消事件监视，此时监视线程中的WaitCommEvent将返回 SetCommMask(CommHandle,0); //等待监视线程结束 WaitForSingleObject(PostEvent,INFINITE); //关闭事件句柄 CloseHandle(PostEvent); //停止发送和接收数据，并清除发送和接收缓冲区 PurgeComm(CommHandle,PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR); //关闭其他的句柄 CloseHandle(ReadOs.hEvent); CloseHandle(CommHandle); btnOpenCom.Enabled :=True; Connected:=False; StatusBar1.SimpleText := '串口已经关闭'; end;
procedure TForm1.btnSendDataClick(Sender: TObject); var Str:String; i:Integer; writeoverlapped:TOverlapped; ByteToWrite,BytesWritten,AllBytesWritten:DWORD; ErrorCode,ErrorFlag:DWORD; CommStat:COMSTAT;
begin if not Connected then begin StatusBar1.SimpleText := '未打开串口'; Exit; end;
if (Memo1.GetTextLen=0) then begin StatusBar1.SimpleText := '缓冲区为空'; Exit; end;
AllBytesWritten:=0; for i:=0 to memo1.Lines.Count-1 do begin Str:=memo1.Lines[i]; ByteToWrite:=length(Str); if ByteToWrite=0 then continue; try StatusBar1.SimpleText := '正在发送数据'; //初始化一步读写结构 FillChar(writeoverlapped,Sizeof(writeoverlapped),0); //避免贡献资源冲突 writeoverlapped.hEvent:=CreateEvent(nil,True,False,nil); //发送数据 if not WriteFile(Commhandle,Str[1],ByteToWrite,BytesWritten,@writeoverlapped) then begin ErrorCode:=GetLastError; if ErrorCode<>0 then begin if ErrorCode=ERROR_IO_PENDING then begin StatusBar1.SimpleText := '端口忙，正在等待...'; while not GetOverlappedResult(Commhandle,writeoverlapped,BytesWritten,True) do begin ErrorCode:=GetLastError; if ErrorCode=ERROR_IO_PENDING then continue else begin ClearCommError(Commhandle,ErrorFlag,@CommStat); showmessage('发送数据出错'); CloseHandle(WriteOverlapped.hEvent); CloseHandle(Commhandle); btnOpenCom.Enabled :=True; Exit; end; end; AllBytesWritten:=AllBytesWritten+BytesWritten; end else begin ClearCommError(Commhandle,ErrorFlag,@CommStat); showmessage('发送数据出错'); CloseHandle(WriteOverlapped.hEvent); Receive :=False; CloseHandle(Commhandle); CloseHandle(PostEvent); btnOpenCom.Enabled :=True; Exit; end; end; end; finally CloseHandle(writeoverlapped.hEvent); end; end; StatusBar1.SimpleText:='已经发送了Byte个数：'+IntToStr(ALLBytesWritten); end;
procedure TForm1.btnReceiveDataClick(Sender: TObject); var com_thread: Thandle; ThreadID:DWORD;
begin if not connected then begin StatusBar1.SimpleText := '未打开串口'; Exit; end;
ReceiveData :=0; Memo2.Clear; FillChar(ReadOs,SizeOf(ReadOs),0); ReadOs.Offset := 0; ReadOs.OffsetHigh := 0;
// 建立通信监视线程 Com_Thread:=CreateThread(nil,0,@CommWatch,nil,0,ThreadID); if (Com_Thread=0) then MessageBox(Handle,'No CreateThread!',nil,mb_OK); //设置DTR信号线 EscapeCommFunction(Commhandle,SETDTR); StatusBar1.SimpleText := '正在接收数据...'; end;
end.
