comm1.pas

串口调试助手源码

unit comm1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Menus;

Const
  Wm_commNotify=Wm_User+12;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    ListBox1: TListBox;
    PopupMenu1: TPopupMenu;
    Clear1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Clear1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  published
    procedure InitCom1;
  private
    { Private declarations }
     Procedure MsgcommProcess(Var Message:Tmessage);Message Wm_commnotify;

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  hCom,Post_Event:Thandle;
  lpol:Poverlapped;
  ComMsg: String;

implementation
    uses
        JsCom1;
{$R *.DFM}

procedure TForm1.InitCom1;
Var
    lpdcb:Tdcb;
    Success,error:boolean;
begin
    hcom:=createfile('com1',
    generic_read or generic_write,
    0,
    nil,
    open_existing,
    file_attribute_normal or file_flag_overlapped,0);

    if hcom=invalid_handle_value then showmessage('错误：服务器无法打开串口设备！')
    else
        setupcomm(hcom,4096,4096);
        error:=getcommstate(hcom,lpdcb);
        if not error then ShowMessage('无法获取串口当前参数！');
        lpdcb.baudrate:=2400;
        lpdcb.StopBits:=ONESTOPBIT;
        lpdcb.ByteSize:=8;
        lpdcb.Parity:=NOPARITY;
  //    lpdcb.fparity:=false;
        error:=Setcommstate(hcom,lpdcb);
        if not error then ShowMessage('无法设置串口参数！');
        success:=setcommMask(hcom,ev_rxchar);
        if not success then ShowMessage('串口监视事件创建错误！');
end;

Procedure TForm1.MsgcommProcess(Var Message:Tmessage);
var
Clear:Boolean;
Coms:Tcomstat;
i:Integer;
lpErrors,cbNum,ReadNumber:DWORD;
Read_Buffer:array[1..100]of byte;
Begin
  Clear:=Clearcommerror(hcom,lpErrors,@Coms);
  if not Clear Then
  begin
  MessageBox(0,'串口缓存错误!','系统错误',MB_OK);
  PurgeComm(hCom,Purge_Rxabort or Purge_Rxclear);
  end
  else
  Begin
    cbNum:=Coms.cbInQue;
    if cbNum>0 then
    begin
     ReadFile(hCom,Read_Buffer,cbNum,ReadNumber,@lpol);
    for i:=1 to Readnumber do
    ListBox1.Items.Add(inttostr(Read_Buffer[i]));
    end;
  end;
  SetEvent(Post_Event);
end;



procedure TForm1.FormCreate(Sender: TObject);
begin
    Initcom1;
    post_event:=CreateEvent(nil,true,true,nil);
    TJsCom1.Create(false);
end;


procedure TForm1.Clear1Click(Sender: TObject);
begin
    ListBox1.Clear;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   SendMsg:String;
   Write_buffer:array[1..100]of char;
   WriteByte,i:integer;
   Writenumber:Cardinal;
   error:boolean;
begin
   SendMsg:=edit1.Text;
   WriteByte:=Length(SendMsg);
   if WriteByte>0 then
   begin
   //showmessage(SendMsg);
   //showmessage(Inttostr(WriteByte));
   for i:=1 to writebyte do
   begin
       Write_buffer[i]:=SendMsg[i];
  //     showmessage(Write_buffer[i]);
   end;
   Writefile(hcom,Write_buffer,WriteByte,Writenumber,lpol);
//   showmessage('by write'+inttostr(Writenumber));
   end;
end;

end.