unit1.~pas

需要安装“MSCOMM”组件,api方件串口传输

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, MSCommLib_TLB, ComCtrls, XPMan;
const WM_COMMNOTIFY=WM_USER+1;  //通信消息

type
  TForm1 = class(TForm)
    MSComm1: TMSComm;
    Button1: TButton;
    RichEdit1: TRichEdit;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    StatusBar1: TStatusBar;
    XPManifest1: TXPManifest;
    procedure WMCOMMNOTIFY(var Message :TMessage);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  hNewCommFile,Post_Event : THandle;
  Read_os : Toverlapped;
  Receive : Boolean;
  ReceiveData : DWord;
implementation

{$R *.dfm}

//接收数据送入显示区
procedure AddToMemo(Str:PChar;Len:DWord);
begin
  Str[Len] := #0;
  Form1.RichEdit1.Text := Form1.RichEdit1.Text+StrPas(Str);
end;
//通信监察线程
procedure CommWatch(Ptr:Pointer);Stdcall;
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(hNewCommFile,EV_RXCHAR)) then
  begin
    MessageBox(0,'SetCommMask Error !','Notice',MB_OK);
    Exit;
  end;
  while(Receive) do
  begin
    dwEvtMask:=0;
    // 等待通讯事件发生
    if not WaitCommEvent(hNewCommFile,dwEvtMask,@Os) then
    begin
      if ERROR_IO_PENDING=GetLastError then
        GetOverLappedResult(hNewCommFile,Os,dwTranser,True)
    end;
    if ((dwEvtMask and EV_RXCHAR)=EV_RXCHAR) then
    begin
      //等待允许传递WM_COMMNOTIFY通讯消息处理WM_COMMNOTIFY消息时不再发送WM_COMMNOTIFY消息
      ResetEvent(Post_Event);
      // 传递WM_COMMNOTIFY通讯消息
      Ok:=PostMessage(Form1.Handle,WM_COMMNOTIFY,hNewCommFile,0);
      if (not Ok) then
      begin
        MessageBox(0,'PostMessage Error !','Notice',MB_OK);
        Exit;
      end;
    end;
  end;
  CloseHandle(Os.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(hNewCommFile,ErrorFlag,@CommState) then
  begin
    MessageBox(0,'ClearCommError !','Notice',MB_OK);
    PurgeComm(hNewCommFile,Purge_Rxabort or Purge_Rxclear);
    Exit;
  end;
  if (CommState.cbInQue>0) then
  begin
    fillchar(InputBuffer,CommState.cbInQue,#0);
    //接收通讯数据
    if (not ReadFile( hNewCommFile,InputBuffer,CommState.cbInQue,
    dwNumberOfBytesRead,@Read_os )) then
    begin
      ErrorFlag := GetLastError();
      if (ErrorFlag <> 0) and (ErrorFlag <> ERROR_IO_PENDING) then
      begin
        MessageBox(0,'ReadFile Error!','Notice',MB_OK);
        Receive :=False;
        CloseHandle(Read_Os.hEvent);
        CloseHandle(Post_Event);
        CloseHandle(hNewCommFile);
        Exit;
      end
      else
      begin
        WaitForSingleObject(hNewCommFile,INFINITE); // 等待操作完成
        GetOverlappedResult(hNewCommFile,Read_os,
        dwNumberOfBytesRead,False);
      end;
    end;
    if dwNumberOfBytesRead>0 then
    begin
      Read_Os.Offset :=Read_Os.Offset+dwNumberOfBytesRead;
      ReceiveData := Read_Os.Offset;
      // 理接收的数据
      AddToMemo(InputBuffer,dwNumberOfBytesRead);
    end;
  end;
  //允许发送下一个WM_COMMNOTIFY消息
  SetEvent(Post_Event);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    Button3.Enabled :=False;
    Button4.Enabled :=False;
    RichEdit1.Lines.LoadFromFile(OpenDialog1.FileName);
    StatusBar1.Panels[1].Text := ExtractFileName(OpenDialog1.FileName)+'文件';
    StatusBar1.Panels[2].Text := IntToStr(RichEdit1.GetTextLen);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  dcb : TDCB;
  Error :Boolean;
  dwNumberOfBytesWritten,dwNumberOfBytesToWrite,
  ErrorFlag,dwWhereToStartWriting : DWORD;
  pDataToWrite : PChar;
  write_os: Toverlapped;
begin
  //打开通讯端口COM1
  hNewCommFile:=CreateFile( 'COM1',GENERIC_WRITE,0,nil, OPEN_EXISTING,FILE_FLAG_OVERLAPPED,0 );
  if hNewCommFile = INVALID_HANDLE_VALUE then
    MessageBox(0,'Error opening com port!','Notice',MB_OK);
  SetupComm(hNewCommFile,1024,1024); //设置缓冲区大小及主要通讯参数
  GetCommState( hNewCommFile,dcb);
  dcb.BaudRate :=9600;
  dcb.ByteSize :=8;
  dcb.Parity :=NOPARITY;
  dcb.StopBits := ONESTOPBIT;
  Error := SetCommState( hNewCommFile, dcb );
  if ( not Error) then MessageBox(0,'SetCommState Error!','Notice',MB_OK);
    dwWhereToStartWriting := 0;
  dwNumberOfBytesWritten := 0;
  dwNumberOfBytesToWrite :=RichEdit1.GetTextLen;
  if (dwNumberOfBytesToWrite=0) then
  begin
    ShowMessage('Text Buffer is Empty!');
    Exit;
  end
  else
  begin
    pDataToWrite:=StrAlloc(dwNumberOfBytesToWrite+1);
  try
    RichEdit1.GetTextBuf(pDataToWrite,dwNumberOfBytesToWrite);
    FillChar(Write_Os,SizeOf(write_os),0);
    //为重叠写创建事件对象
    Write_Os.hEvent := CreateEvent(nil,True,False,nil);
    SetCommMask(hNewCommFile,EV_TXEMPTY);
    StatusBar1.Panels[1].Text := '  正在发送数据...!';
  repeat
    //发送通讯数据
    if not WriteFile( hNewCommFile,pDataToWrite[dwWhereToStartWriting],dwNumberOfBytesToWrite,dwNumberOfBytesWritten,@write_os ) then
    begin
      ErrorFlag :=GetLastError;
      if ErrorFlag<>0 then
      begin
        if ErrorFlag=ERROR_IO_PENDING then
        begin
          WaitForSingleObject(Write_Os.hEvent,INFINITE);
          GetOverlappedResult(hNewCommFile,Write_os,
          dwNumberOfBytesWritten,False);
        end
        else
        begin
          MessageBox(0,'WriteFile Error!','Notice',MB_OK);
          Receive :=False;
          CloseHandle(Read_Os.hEvent);
          CloseHandle(Post_Event);
          CloseHandle(hNewCommFile);
          Exit;
        end;
      end;
    end;
    Dec( dwNumberOfBytesToWrite, dwNumberOfBytesWritten );
    Inc( dwWhereToStartWriting, dwNumberOfBytesWritten );
    until (dwNumberOfBytesToWrite <= 0); // Write the whole thing!
      StatusBar1.Panels[2].Text := IntToStr(dwWhereToStartWriting);
    finally
      StrDispose(pDataToWrite);
    end;
    CloseHandle(hNewCommFile);
  end;
  StatusBar1.Panels[1].Text := '  发送成功!';
  Button1.Enabled :=True;
  Button3.Enabled :=True;
  Button4.Enabled :=True;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  Ok : Boolean;
  dcb : TDCB;
  com_thread: Thandle;
  ThreadID:DWORD;
begin
  ReceiveData :=0;
  Button1.Enabled :=False;
  Button2.Enabled :=False;
  RichEdit1.Clear;
  //打开COM1
  hNewCommFile:=CreateFile('COM1',GENERIC_READ,0,nil, OPEN_EXISTING,FILE_FLAG_OVERLAPPED,0 );
  if hNewCommFile = INVALID_HANDLE_VALUE then
  begin
    MessageBox(0,'Error opening com port!','Notice',MB_OK);
    Exit;
  end;
  Ok:=SetCommMask(hNewCommFile,EV_RXCHAR);
  if ( not Ok) then
  begin
    MessageBox(0,'SetCommMask Error!','Notice',MB_OK);
    Exit;
  end;
  SetupComm(hNewCommFile,1024,1024);
  GetCommState( hNewCommFile, dcb );
  dcb.BaudRate :=9600;
  dcb.ByteSize :=8;
  dcb.Parity :=NOPARITY;
  dcb.StopBits := ONESTOPBIT;
  Ok := SetCommState( hNewCommFile, dcb );
  if ( not Ok) then
    MessageBox(0,'SetCommState Error!','Notice',MB_OK);
  FillChar(Read_Os,SizeOf(Read_Os),0);
  Read_Os.Offset := 0;
  Read_Os.OffsetHigh := 0;
  Read_Os.hEvent :=CreateEvent(nil,true,False,nil);
  if Read_Os.hEvent=null then
  begin
    CloseHandle(hNewCommFile);
    MessageBox(0,'CreateEvent Error!','Notice',MB_OK);
    Exit;
  end;
  Post_Event:=CreateEvent(nil,True,True,nil);
  if Post_Event=null then
  begin
    CloseHandle(hNewCommFile);
    CloseHandle(Read_Os.hEvent);
    MessageBox(0,'CreateEvent Error!','Notice',MB_OK);
    Exit;
  end;
  //建立通信监视线程
  Com_Thread:=CreateThread(nil,0,@CommWatch,nil,0,ThreadID);
  if (Com_Thread=0) then
    MessageBox(Handle,'No CraeteThread!',nil,mb_OK);
  EscapeCommFunction(hNewCommFile,SETDTR);
  StatusBar1.Panels[1].Text := '  正在接收数据...!';
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  StatusBar1.Panels[1].Text := '  停止处理！';
  StatusBar1.Panels[2].Text := IntToStr(ReceiveData);
  Receive :=False;
  CloseHandle(Read_Os.hEvent);
  CloseHandle(Post_Event);
  CloseHandle(hNewCommFile);
  Button1.Enabled :=True;
  Button2.Enabled :=True;
end;

end.