serialdebug.~pas

vb与三菱PLC通讯 实现PC与PLC之间的连接

unit SerialDebug;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, OleCtrls, MSCommLib_TLB;

type
  TMainForm = class(TForm)
    mmReceive: TMemo;
    Panel2: TPanel;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label6: TLabel;
    cmbbxComNum: TComboBox;
    cmbbxBaud: TComboBox;
    cmbbxDataNum: TComboBox;
    cmbbxStopBit: TComboBox;
    cmbbxCheckBit: TComboBox;
    btnSerial: TButton;
    shpSerial: TShape;
    mmSend: tmemo;
    chckbxHexSend: TCheckBox;
    chckbxTimer: TCheckBox;
    edtTime: TEdit;
    Label7: TLabel;
    MSComm: TMSComm;
    tmrSend: TTimer;
    chckbxHexShow: TCheckBox;
    Panel3: TPanel;
    chckbxRTS: TCheckBox;
    chckbxDTR: TCheckBox;
    Label5: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    shpDSR: TShape;
    shpCTS: TShape;
    shpCD: TShape;
    Button1: TButton;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Button4: TButton;
    Button3: TButton;
    Button5: TButton;
    Memo1: TMemo;
    Button6: TButton;
    btnSend: TButton;
    btnClear: TButton;
    Label10: TLabel;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    procedure FormCreate(Sender: TObject);
    procedure btnSerialClick(Sender: TObject);
    procedure chckbxDTRClick(Sender: TObject);
    procedure chckbxRTSClick(Sender: TObject);
    procedure chckbxTimerClick(Sender: TObject);
    procedure MSCommComm(Sender: TObject);
    procedure chckbxHexShowClick(Sender: TObject);
    procedure chckbxHexSendClick(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure tmrSendTimer(Sender: TObject);
    procedure Panel2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Label11Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
  private
    { Private declarations }
    HexShow:Boolean;
    HexSend:Boolean;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}
//该函数接收1个
//转换成功.输出字符对应的数
//转换失败.输出-1
function hex(c:char):Integer ;
var
      x:integer;
begin
     if c=' ' then
        x:=0
     else if (Ord(c)>=ord('0')) and (Ord(c)<=ord('9')) then
        x:=Ord(c)-Ord('0')
     else if (Ord(c)>=ord('a')) and (Ord(c)<=ord('f')) then
        x:=Ord(c)-Ord('a')+10
     else if (Ord(c)>=ord('A')) and (Ord(c)<=ord('F')) then
        x:=Ord(c)-Ord('A')+10
     else
        //输入错误
        x:=-1;        
      Result:=x;
end;

//该函数接收1个至2个字符
//转换成功.输出对应16进制数的值
//转换失败.输出-1。
function HexToInt(S:String): Integer;
var
    tmpInt1,tmpInt2:Integer ;
begin
   if Length(S)=1 then
   begin
      Result:=hex(S[1]);
   end
   else if Length(S)=2 then
   begin
      tmpInt1:=hex(S[1]);
      tmpInt2:=hex(S[2]);
      if (tmpInt1=-1) or (tmpInt2=-1) then
          Result:=-1
      else
          Result:= tmpInt1*16+tmpInt2;
      end
    else
        //输入错误，转换失败    
        Result:=-1;
end;

//程序的初始化
procedure TMainForm.FormCreate(Sender: TObject);
begin
    HexShow:=False;
    cmbbxComNum.ItemIndex:=0;
    shpSerial.Brush.Color:=clWhite;
    shpCD.Brush.Color:=clWhite;
    shpCTS.Brush.Color:=clWhite;
    shpDSR.Brush.Color:=clWhite;
    Panel1.Enabled:=True;
end;

//打开或者关闭串口，并变换指示灯的状态
procedure TMainForm.btnSerialClick(Sender: TObject);
var
    ComSetting:String;
    
begin
    if not MSComm.PortOpen then
    begin
        //打开串口
        MSComm.CommPort :=cmbbxComNum.ItemIndex +1;
        //默认值为 '9600,N,8,1'
        ComSetting:=cmbbxBaud.Text;
        ComSetting:=ComSetting+','+cmbbxCheckBit.Text;
        ComSetting:=ComSetting+','+cmbbxDataNum.Text;
        ComSetting:=ComSetting+','+cmbbxStopBit.Text;
        MSComm.Settings:=ComSetting;
        MSComm.PortOpen:=True;

        //变换各个组件的状态
        shpSerial.Brush.Color:=clRed; //指示灯变红
        Panel1.Enabled:=False;
        btnSerial.Caption :='关闭串口';
        chckbxHexShow.Enabled:=False;
    end
    else  begin
        //关闭串口
        //变换各个组件的状态
        MSComm.PortOpen:=False;
        shpSerial.Brush.Color:=clWhite;//指示灯变白
        Panel1.Enabled:=True;
        btnSerial.Caption :='打开串口';
        chckbxHexShow.Enabled:=True;        
    end;
end;

//设置DTR线状态
procedure TMainForm.chckbxDTRClick(Sender: TObject);
begin
        MSComm.DTREnable :=chckbxDTR.Checked
end;

//设置RTS线状态
procedure TMainForm.chckbxRTSClick(Sender: TObject);
begin
        MSComm.RTSEnable :=chckbxRTS.Checked
end;

//开启定时器，定时发送数据
procedure TMainForm.chckbxTimerClick(Sender: TObject);
begin
    if chckbxTimer.Checked then
    begin
        tmrSend.Interval:=StrToInt(edtTime.Text);
        tmrSend.Enabled:=True;        
    end
    else begin
        tmrSend.Enabled:=False;
    end;
end;

//处理控件的该事件，获取底层交换的数据和连线的状态
procedure TMainForm.MSCommComm(Sender: TObject);
var
    i,InputLen:Integer;
    tmpInt:Integer;
    tmpvar:Variant;
    InputString,s:String;
    m, x,x1,x2,z,z1,z2,z3,z4,z5,z6,z7:string;y,y1,y2:integer;
begin
    if MSComm.CommEvent=ComEvReceive then
    begin
        InputLen:=MSComm.InBufferCount;

        //接收二进制数据，转换为十六进制显示
        if HexShow then
        begin
          tmpvar:=MSComm.Input;
          InputString:='';
          for i:= 0 to InputLen-1 do
          begin
            tmpInt:=tmpvar[i];
            InputString:=InputString+''+LowerCase(IntToHex(tmpInt,2));
          end;
        end
        //直接接收字符
        else begin
            InputString:=MSComm.Input;
        end;
        MainForm.mmReceive.Text :=MainForm.mmReceive.Text+inputstring;

          s:=mainform.mmReceive.Text;


       if length(s) >1  then  m:=copy(s,1,18);
        x1:=copy( m,2,1); x2:=copy(m,3,1);
       trystrtoint(x1,y1); trystrtoint(x2,y2);
y:=y1*16+y2;
z:=chr(y);
         x1:=copy( m,4,1); x2:=copy(m,5,1);
       trystrtoint(x1,y1); trystrtoint(x2,y2);
y:=y1*16+y2;
z1:=chr(y);
          x1:=copy( m,6,1); x2:=copy(m,7,1);
       trystrtoint(x1,y1); trystrtoint(x2,y2);
y:=y1*16+y2;
z2:=chr(y);
          x1:=copy( m,8,1); x2:=copy(m,9,1);
       trystrtoint(x1,y1); trystrtoint(x2,y2);
y:=y1*16+y2;
z3:=chr(y);
          x1:=copy( m,10,1); x2:=copy(m,11,1);
       trystrtoint(x1,y1); trystrtoint(x2,y2);
y:=y1*16+y2;
z4:=chr(y);
         x1:=copy( m,12,1); x2:=copy(m,13,1);
       trystrtoint(x1,y1); trystrtoint(x2,y2);
y:=y1*16+y2;
z5:=chr(y);
          x1:=copy( m,14,1); x2:=copy(m,15,1);
       trystrtoint(x1,y1); trystrtoint(x2,y2);
y:=y1*16+y2;
z6:=chr(y);
          x1:=copy( m,16,1); x2:=copy(m,17,1);
       trystrtoint(x1,y1); trystrtoint(x2,y2);
y:=y1*16+y2;
z7:=chr(y);
      memo1.text:=z+z1+z2+z3+z4+z5+z6+z7;
  end
    //显示CD线的状态
    else if MSComm.CommEvent=ComEvCD then
    begin
        if MSComm.CDHolding then
            shpCD.Brush.Color:=clRed
        else
            shpCD.Brush.Color:=clWhite;
    end
    //显示CTS线的状态
    else if MSComm.CommEvent=ComEvCTS then
    begin
        if MSComm.CTSHolding then
            shpCTS.Brush.Color:=clRed
        else
            shpCTS.Brush.Color:=clWhite;
    end
    //显示DSR线的状态
    else if MSComm.CommEvent=ComEvDSR then
    begin
        if MSComm.DSRHolding then
            shpDSR.Brush.Color:=clRed
        else
            shpDSR.Brush.Color:=clWhite;
    end;
end;

//设置MSComm控件的数据接收的方式
procedure TMainForm.chckbxHexShowClick(Sender: TObject);
begin
    if chckbxHexShow.Checked then
    begin
        MSComm.InputMode:=1;
        HexShow:=True;
    end
    else begin
        MSComm.InputMode:=0;
        HexShow:=False;
    end;
end;

//设置参数HexSend的值，以告诉程序如何发送数据
procedure TMainForm.chckbxHexSendClick(Sender: TObject);
begin
    HexSend:=chckbxHexSend.Checked;
end;


//发送数据
procedure TMainForm.btnSendClick(Sender: TObject);
var
    Len:Integer;
    i,count,tmpInt:Integer;
    tmpVar:Variant;
    tmpStr,Output:String;

begin
    if not MSComm.PortOpen then
    begin
        showmessage('没有打开串口！');
        Exit;
    end
    else begin
        //发送二进制数，需要使用Variant变量矩阵，矩阵大小自动调节
        if HexSend then
        begin
            Output:=mmSend.Text;
            Len:=Length(Output);
            if Len>0 then
            begin
               i:=1;
               count:=1;
               //创建一个Variant数组
               tmpVar:=VarArrayCreate([1,1],varByte);
               while(i<Len) do
               begin
                  //每3个字符串中截取2个字符，转换为16进制
                  tmpStr:=Copy(Output,i,2);
                  tmpStr:=LowerCase(tmpStr);
                  tmpInt:=HexToInt(tmpStr);
                  if tmpInt=-1 then
                  begin
                      showmessage('发送的数据格式有问题！');
                      exit;
                  end
                  else begin
                      tmpVar[Count]:=tmpInt;
                      Inc(count);
                     //增大Variant数组
                      VarArrayRedim(tmpVar,count);
                  end;
                  i:=i+3;
               end;
               MSComm.Output :=tmpVar;
            end;
        end
        else begin
            MSComm.Output :=mmSend.Text;