Delphi MSComm 比较完整的用法例子-木庄网络博客

本文整理自网络，侵删。
 unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, MSCommLib_TLB, Math, ExtCtrls;
 
type
  TForm1 = class(TForm)
    infoMemo: TMemo;
    sendMemo: TMemo;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    MSComm2: TMSComm;
    ShowHexCheckBox: TCheckBox;
    Edit1: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Edit2: TEdit;
    AutoCLSCheckBox: TCheckBox;
    SendHexCheckBox: TCheckBox;
    Label4: TLabel;
    Label5: TLabel;
    Edit3: TEdit;
    Edit4: TEdit;
    TXLabel: TLabel;
    RXLabel: TLabel;
    AutoSendTimer: TTimer;
    procedure Button2Click(Sender: TObject);
    procedure MSComm2Comm(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure AutoSendTimerTimer(Sender: TObject);
    procedure ShowHexCheckBoxClick(Sender: TObject);
  private
    {
 Private declarations 
}
    _ControlID_:integer;
    RXNum,TXNum:integer;
    inputstr,recvstr:string;
    procedure ShowTX;
    procedure ShowRx;
  public
    {
 Public declarations 
}
  end;
 
var
  Form1: TForm1;
 
implementation
 
{
$R *.dfm
}
 
function StrToHexStr(const S:string):string;
var
  I:Integer;
begin
  for I:=1 to Length(S) do
  begin
    if I=1 then
      Result:=IntToHex(Ord(S[1]),2)
    else Result:=Result+' '+IntToHex(Ord(S[I]),2);
  end;
end;
 
function TrimAll(Str:string):string;
begin
  Result:=StringReplace(Str,' ','',[rfReplaceAll]);
end;
 
function HexToInt32(const aHex: string ):Integer;
var
  I,L,K: Integer;
begin
  Result := 0 ;
  if aHex ='' then
    begin
      Exit;
    end
  else
    begin
      K := 0;
      L := Length(aHex);
      for I:=1 to L do
        begin
          if (not(aHex[I] in['A'..'F'])) and (not(aHex[I] in['a'..'f'])) then
            K := K + Trunc(StrToInt(aHex[I]) * Power(16, L-I))
          else case aHex[I] of
            'a', 'A' : K := K + Trunc(10 * Power(16, L-I));
            'b', 'B' : K := K + Trunc(11 * Power(16, L-I));
            'c', 'C' : K := K + Trunc(12 * Power(16, L-I));
            'd', 'D' : K := K + Trunc(13 * Power(16, L-I));
            'e', 'E' : K := K + Trunc(14 * Power(16, L-I));
            'f', 'F' : K := K + Trunc(15 * Power(16, L-I));
          end;
        end;
    end;
  Result := k;
end;
 
function StrToASCIIStr(const S: string): string;
var
  i: Integer;
begin
  for i:= 1 to Length(S) do
  begin
    if i = 1 then
      Result:= IntToHex(Ord(S[1]), 2)
    else
      Result:= Result + ' ' + IntToHex(Ord(S[i]), 2);
  end;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  try
    MSComm2.CommPort := StrToInt(Edit1.Text);                //指定端口
    MSComm2.Settings := Edit2.Text+',n,8,1';                 //其它参数
    MSComm2.InputMode := _ControlID_;                        //文本接收模式 0  二进制接收模式 1
    MSComm2.InBufferSize := 1024;                            //接收缓冲区
    MSComm2.OutBufferSize := 1024;                           //发送缓冲区
    MSComm2.InputLen := 0;                                   //一次读取所有数据
    MSComm2.InBufferCount := 0;                              //清空读取缓冲区
    MSComm2.OutBufferCount := 0;                             //清空发送缓冲区
    MSComm2.SThreshold := 1;                                 //一次发送所有数据
    MSComm2.RThreshold := 1;                                 //设置接收多少字节开产生oncomm事件
    MSComm2.PortOpen:=True;                                  //打开端口
    label1.Caption:='Open Success!';
  except
    Label1.Caption:='Open faile!'
  end;
end;
 
procedure TForm1.MSComm2Comm(Sender: TObject);
var
  i,InputLen:Integer;
  tmpvar,aaa:Variant;
  bmp:byte;
  ddd:string;
begin
  InputLen:=0;
   
  //接收数据时
  if MSComm2.CommEvent = 2 then
    begin
      //返回输入缓冲区内等待读取的字节数
      InputLen:=MSComm2.InBufferCount;
 
      //自动清空
      if AutoCLSCheckBox.Checked=True then
        begin
          if Length(InfoMemo.Text)>5000 then //字符长度大于5000时，自动清空
            begin
              InfoMemo.Clear;
              InfoMemo.Lines.Add('==================== Too long text ====================')
            end;
        end;
 
      //显示十六进制数值
      if ShowHexCheckBox.Checked=True then
        begin
          inputStr:='';
 
          //读取接收缓冲区中的数据
          tmpVar:=MSComm2.Input;
 
          if _ControlID_=1 then
            begin
              aaa:=VarArrayCreate([0,InputLen-1],VarByte);
              aaa:=tmpVar;
 
              ddd:='';
              for i:=0 to InputLen-1 do
                begin
                  bmp:=aaa[i];
                  ddd:=ddd + IntToHex(bmp,2) + ' ';
                end;
 
              inputStr:=inputStr + ddd;
            end;
 
          if _ControlID_=0 then
            begin
              ddd:=StrToHexStr(tmpvar);
              InputStr:=InputStr + ddd + ' ';
            end;
        end
      else
        //直接接收字符
        begin
          InputStr:='';
          InputStr:= MSComm2.Input;
        end;
 
    InfoMemo.Text:=InfoMemo.Text + InputStr;
    InfoMemo.SelLength:=Length(InfoMemo.Text);
  end;
 
  //加入数据显示模块
  RXNum:=RXNum + InputLen;
  ShowRX;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  i,Len:Integer;
  tmpvar:Variant;
  tmpStr,Output: string;
begin
  if Length(SendMemo.Text)=0 then
    begin
      AutoSendTimer.Enabled:=False;
      MessageBox(0,PChar('请填写需要发送的数据指令或AT命令！'), '软件提示',MB_OK+MB_ICONERROR);
      exit;
    end;
 
  if SendHexCheckBox.Checked=False then
    begin
      MSComm2.Output:=SendMemo.Text+#13#10;
    end
  else
    begin
      tmpStr:=TrimAll(SendMemo.Text);
      tmpVar:=VarArrayCreate([0,Length(tmpstr)], varByte);
 
      for i:=0 to Length(tmpStr) do
        begin
          if i=Length(tmpStr)/2 then
            break
          else
            TmpVar[i]:=$+(HexToInt32(Copy(tmpStr,i*2+1,2)));
        end;
 
      MSComm2.Output:=TmpVar;
    end;
 
  Len:=length(SendMemo.Text);
 
  TXNum:= TXNum + Len div 2;
  ShowTX;
end;
 
procedure TForm1.ShowRX;
begin
  RXLabel.Caption:='TX: '+IntToStr(RXNum);
end;
 
procedure TForm1.ShowTX;
begin
  TXLabel.Caption:='RX: '+IntToStr(TXNum);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  _ControlID_:=0;
end;
 
procedure TForm1.AutoSendTimerTimer(Sender: TObject);
begin
  Button1.Click;
end;
 
procedure TForm1.ShowHexCheckBoxClick(Sender: TObject);
begin
  MSComm2.PortOpen:=False;
 
  if ShowHexCheckBox.Checked=True then _ControlID_:=1 else _ControlID_:=0;
 
  Button2.Click;
 
end;
 
end.
Delphi MSComm 比较完整的用法例子

相关推荐

评论
