unit1.~pas

WAPI串口编程示例,用复杂的api函数,实现的串口功能更为强大.

        if  ByteToWrite=0 then exit;
        try
            StatusBar1.SimpleText := '正在发送数据';
            FillChar(writeoverlapped,Sizeof(writeoverlapped),0);//初始化一步读写结构
            writeoverlapped.hEvent:=CreateEvent(nil,True,False,nil);//避免贡献资源冲突


            //**************发送数据*************//


            if not WriteFile(Commhandle,data[0],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
                                exit
                            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
            else
                  StatusBar1.SimpleText := '发送中...';
        finally
           CloseHandle(writeoverlapped.hEvent);
        end;

end;

procedure TForm1.btnReceiveDataClick(Sender: TObject);
var
    com_thread: Thandle;
    ThreadID:DWORD;

begin
    form1.btnReceiveData.Enabled:=false;
    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;

procedure TForm1.Button1Click(Sender: TObject);
var
  CommState : ComStat;
  dwNumberOfBytesRead : Dword;
  ErrorFlag : Dword;
  InputBuffer : Array [0..1024] of Char;
  repVar:Variant;
  i,n:integer;
  s:string;

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,repVar,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
         showmessage(inttostr(dwNumberOfBytesRead));
        WaitForSingleObject(CommHandle,INFINITE); // 等待操作完成
        GetOverlappedResult(CommHandle,ReadOs,dwNumberOfBytesRead,False);
      end;
    end;
    if dwNumberOfBytesRead>0 then
    begin
       showmessage(inttostr(dwNumberOfBytesRead));
      ReadOs.Offset :=ReadOs.Offset+dwNumberOfBytesRead;
      ReceiveData := ReadOs.Offset;
       for i:=0 to dwNumberOfBytesRead-1 do
       begin
          n:= repVar[i];
          s:=s+inttohex(n,2);
       end;
      // 处理接收的数据
      self.Memo2.Text:=self.Memo2.Text+s;
      //AddToMemo(InputBuffer,dwNumberOfBytesRead);
    end;
  end;
  // 允许发送下一个WM_COMMNOTIFY消息
   showmessage(inttostr(dwNumberOfBytesRead));
  SetEvent(PostEvent);
end;


procedure TForm1.btnSendDataClick(Sender: TObject);
var
    senddata:array of byte;
     data:byte;
    Len:Integer;
    i,count,tmpInt:Integer;

    tmpStr:String;

begin
         //self.Memo2.Text:='';
         Len:=Length(self.Memo1.Text);
         i:=1;
         count:=0;

         SetLength(senddata,1);
         while(i<Len) do
         begin
              tmpStr:=Copy(self.Memo1.Text,i,2);
              tmpStr:=LowerCase(tmpStr);
              tmpInt:=HexToInt(tmpStr);

              if tmpInt=-1 then
              begin
                  showmessage('发送的数据格式有问题！');
                  exit;
              end
              else
              begin
                 senddata[Count]:=tmpInt;
              end;
              i:=i+2;
              if len>i then
              begin
                 Inc(count);
                 SetLength(senddata,count+1);
              end;
        end;
       // tmpInt:=HexToInt(self.Memo1.Text);
        //data:=tmpInt;
        send(senddata,count+1);

        //Form1.btnReceiveDataClick(Sender);


end;

procedure TForm1.Button2Click(Sender: TObject);
var
   len:integer;
begin
   // Receive:=false;
   len:=length(self.Memo2.Text);
   showmessage(inttostr(len));
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  CommState : ComStat;
  dwNumberOfBytesRead : Dword;
  ErrorFlag : Dword;
  InputBuffer : Array [0..1024] of Char;
  repVar:array[0..1024] of byte;
  var shuzu:array of byte;
  i,n:integer;
  s:string;
  tmpVar:Variant;
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
    chang:=CommState.cbInQue;
    setlength(shuzu,chang);
    if (not ReadFile(CommHandle,shuzu[0],chang,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;
      for i:=low(shuzu) to high(shuzu) do
      begin
          //n:= repVar[i];
          n:=shuzu[i];
          s:=s+inttohex(n,4);
      end;
      self.Memo2.Text:=self.Memo2.Text+s;


    end;
  end;
end;


//**********读com口数据***************//
//************************************//


function TForm1.read():string;
var
  CommState : ComStat;
  dwNumberOfBytesRead : Dword;
  ErrorFlag : Dword;
  repVar:array of byte;
  i,n:longint;
  s,sing:string;
  tmpVar:Variant;
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
    chang:=CommState.cbInQue;
    setlength(repVar,chang);
    if (not ReadFile(CommHandle,repVar[0],chang,dwNumberOfBytesRead,@ReadOs )) then
    begin
       showmessage('123dasfa');
      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;
      for i:=low(repVar) to high(repVar) do
      begin
          n:= repVar[i];
          s:=s+inttohex(n,2);
      end;
      result:=s;


    end;
  end;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
   shuzu:array of byte;
   i,n:integer;
   str:string;
begin
   setlength(shuzu,20);
   shuzu[3]:=2;
   for i:=low(shuzu) to high(shuzu) do
   begin

       n:=shuzu[i];
       str:=str+inttohex(n,2);

   end;
   showmessage(str);
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
    Form1.sendorder('06');
end;

//**********发命令函数****************//
//**********可以调用发命令************//
procedure TForm1.sendorder(order:string);
var
    senddata:array of byte;
    Len:Integer;
    i,count,tmpInt:Integer;
    tmpStr:String;

begin
         Len:=Length(order);
         i:=1;
         count:=0;

         SetLength(senddata,1);
         while(i<Len) do
         begin
              tmpStr:=Copy(order,i,2);
              tmpStr:=LowerCase(tmpStr);
              tmpInt:=HexToInt(tmpStr);

              if tmpInt=-1 then
              begin
                  showmessage('发送的数据格式有问题！');
                  exit;
              end
              else
              begin
                 senddata[Count]:=tmpInt;
              end;
              i:=i+2;
              if len>i then
              begin
                 Inc(count);
                 SetLength(senddata,count+1);
              end;
        end;
        send(senddata,count+1);
end;

procedure TForm1.Button3Click(Sender: TObject);
var
    CommTimeOut : TCOMMTIMEOUTS;
    DCB : TDCB;
    i:integer;
    coming:string;
    comshuju:string;
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;

    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;


    //***********找串口******************//
    for i:=1 to 16 do
    begin
       try

          CloseHandle(CommHandle);
          coming:='com'+inttostr(i);

          CommHandle := CreateFile(PChar(coming),GENERIC_WRITE or GENERIC_READ,
                 0,nil,OPEN_EXISTING,FILE_FLAG_OVERLAPPED or FILE_ATTRIBUTE_NORMAL,0);

          CommTimeOut.ReadIntervalTimeout := MAXDWORD;
          CommTimeOut.ReadTotalTimeoutMultiplier := 0;
          CommTimeOut.ReadTotalTimeoutConstant := 0;
          SetCommTimeouts(CommHandle, CommTimeOut);

          SetupComm(CommHandle,4096,1024);

          GetCommState(CommHandle,DCB);
          DCB.BaudRate := 115200;
          DCB.ByteSize := 8;
          DCB.Parity :=NOPARITY;
          DCB.StopBits := ONESTOPBIT;
          Connected := SetCommState(CommHandle, DCB);


          if (not SetCommMask(CommHandle,EV_RXCHAR)) then
          begin
              continue;
          end;
       except
           continue;
       end;

          if (Connected) then
          begin
              sendorder('06');
              delay(20);
              comshuju:=read();
              if comshuju='06' then
              begin
                 Receive:=true;
                 StatusBar1.SimpleText := '已同端口 '+ coming + ' 连接！';
                 exit;
              end
              else
                 CloseHandle(CommHandle);

          end
          else begin
              CloseHandle(CommHandle);
              StatusBar1.SimpleText := '设置串口失败';
          end;
    end;
    showmessage(inttostr(i));
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
    Form1.Memo2.Text:='';
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
     form1.Timer1.Interval:=strtoint(form1.Edit1.Text);
     form1.Timer1.Enabled:=true;
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
     form1.Timer1.Enabled:=false;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
     Form1.btnSendDataClick(Sender);
end;

end.