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;
    btnSend: TButton;
    chckbxHexSend: TCheckBox;
    chckbxTimer: TCheckBox;
    edtTime: TEdit;
    Label7: TLabel;
    MSComm: TMSComm;
    tmrSend: TTimer;
    btnClear: TButton;
    chckbxHexShow: TCheckBox;
    Panel3: TPanel;
    chckbxRTS: TCheckBox;
    chckbxDTR: TCheckBox;
    Label5: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    shpDSR: TShape;
    shpCTS: TShape;
    shpCD: 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);
  private
    { Private declarations }
    HexShow:Boolean;
    HexSend:Boolean;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}
//該函數(shù)接收1個(gè)
//轉(zhuǎn)換成功.輸出字符對(duì)應(yīng)的數(shù)
//轉(zhuǎn)換失敗.輸出-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
        //輸入錯(cuò)誤
        x:=-1;        
      Result:=x;
end;

//該函數(shù)接收1個(gè)至2個(gè)字符
//轉(zhuǎn)換成功.輸出對(duì)應(yīng)16進(jìn)制數(shù)的值
//轉(zhuǎn)換失敗.輸出-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
        //輸入錯(cuò)誤，轉(zhuǎn)換失敗    
        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;

//打開或者關(guān)閉串口，并變換指示燈的狀態(tài)
procedure TMainForm.btnSerialClick(Sender: TObject);
var
    ComSetting:String;
    
begin
    if not MSComm.PortOpen then
    begin
        //打開串口
        MSComm.CommPort :=cmbbxComNum.ItemIndex +1;
        //默認(rèn)值為 '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;

        //變換各個(gè)組件的狀態(tài)
        shpSerial.Brush.Color:=clRed; //指示燈變紅
        Panel1.Enabled:=False;
        btnSerial.Caption :='關(guān)閉串口';
        chckbxHexShow.Enabled:=False;
    end
    else  begin
        //關(guān)閉串口
        //變換各個(gè)組件的狀態(tài)
        MSComm.PortOpen:=False;
        shpSerial.Brush.Color:=clWhite;//指示燈變白
        Panel1.Enabled:=True;
        btnSerial.Caption :='打開串口';
        chckbxHexShow.Enabled:=True;        
    end;
end;

//設(shè)置DTR線狀態(tài)
procedure TMainForm.chckbxDTRClick(Sender: TObject);
begin
        MSComm.DTREnable :=chckbxDTR.Checked
end;

//設(shè)置RTS線狀態(tài)
procedure TMainForm.chckbxRTSClick(Sender: TObject);
begin
        MSComm.RTSEnable :=chckbxRTS.Checked
end;

//開啟定時(shí)器，定時(shí)發(fā)送數(shù)據(jù)
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;

//處理控件的該事件，獲取底層交換的數(shù)據(jù)和連線的狀態(tài)
procedure TMainForm.MSCommComm(Sender: TObject);
var
    i,InputLen:Integer;
    tmpInt:Integer;
    tmpvar:Variant;
    InputString:String;
    
begin
    if MSComm.CommEvent=ComEvReceive then
    begin
        InputLen:=MSComm.InBufferCount;

        //接收二進(jìn)制數(shù)據(jù)，轉(zhuǎn)換為十六進(jìn)制顯示
        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;
    end
    //顯示CD線的狀態(tài)
    else if MSComm.CommEvent=ComEvCD then
    begin
        if MSComm.CDHolding then
            shpCD.Brush.Color:=clRed
        else
            shpCD.Brush.Color:=clWhite;
    end
    //顯示CTS線的狀態(tài)
    else if MSComm.CommEvent=ComEvCTS then
    begin
        if MSComm.CTSHolding then
            shpCTS.Brush.Color:=clRed
        else
            shpCTS.Brush.Color:=clWhite;
    end
    //顯示DSR線的狀態(tài)
    else if MSComm.CommEvent=ComEvDSR then
    begin
        if MSComm.DSRHolding then
            shpDSR.Brush.Color:=clRed
        else
            shpDSR.Brush.Color:=clWhite;
    end;
end;

//設(shè)置MSComm控件的數(shù)據(jù)接收的方式
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;

//設(shè)置參數(shù)HexSend的值，以告訴程序如何發(fā)送數(shù)據(jù)
procedure TMainForm.chckbxHexSendClick(Sender: TObject);
begin
    HexSend:=chckbxHexSend.Checked;
end;


//發(fā)送數(shù)據(jù)
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('沒(méi)有打開串口！');
        Exit;
    end
    else begin
        //發(fā)送二進(jìn)制數(shù)，需要使用Variant變量矩陣，矩陣大小自動(dòng)調(diào)節(jié)
        if HexSend then
        begin
            Output:=mmSend.Text;
            Len:=Length(Output);
            if Len>0 then
            begin
               i:=1;
               count:=1;
               //創(chuàng)建一個(gè)Variant數(shù)組
               tmpVar:=VarArrayCreate([1,1],varByte);
               while(i<Len) do
               begin
                  //每3個(gè)字符串中截取2個(gè)字符，轉(zhuǎn)換為16進(jìn)制
                  tmpStr:=Copy(Output,i,2);
                  tmpStr:=LowerCase(tmpStr);
                  tmpInt:=HexToInt(tmpStr);
                  if tmpInt=-1 then
                  begin
                      showmessage('發(fā)送的數(shù)據(jù)格式有問(wèn)題！');
                      exit;
                  end
                  else begin
                      tmpVar[Count]:=tmpInt;
                      Inc(count);
                     //增大Variant數(shù)組
                      VarArrayRedim(tmpVar,count);
                  end;
                  i:=i+3;
               end;
               MSComm.Output :=tmpVar;               
            end;
        end
        else begin
            MSComm.Output :=mmSend.Text;
        end;
    end;
end;

//清空數(shù)據(jù)顯示區(qū)
procedure TMainForm.btnClearClick(Sender: TObject);
begin
    mmReceive.Text:='';
end;

//定時(shí)器在指定的事件內(nèi)觸發(fā)該事件，實(shí)現(xiàn)數(shù)據(jù)的定時(shí)發(fā)送
procedure TMainForm.tmrSendTimer(Sender: TObject);
begin
    //如果串口已經(jīng)打開，則發(fā)送數(shù)據(jù)
    if MSComm.PortOpen then
        btnSendClick(sender);
end;

function    ReadFromPLC(ReadChar:Array of char; ReadAddress:Array of Byte;
       ReadBytes :Integer): Boolean;
var
   ReadDataSum:integer;
   DataSumCheck:integer;
   tmpStr:String;
   tmpchr,chr1,chr2:char;
   tmpVar:Variant;
   Input:Variant;
   InputLen,i,tmpInt:Integer;

begin
   DataSumCheck:=0;
   tmpVar:=VarArrayCreate([1,11],varByte);
   tmpVar[1]:=$02;//STX
   tmpVar[2]:=$30;//CMDO
   DataSumCheck:=DataSumCheck+$30;   
   tmpVar[3]:=ReadAddress[0];
   DataSumCheck:=DataSumCheck+ReadAddress[0];
   tmpVar[4]:=ReadAddress[1];
   DataSumCheck:=DataSumCheck+ReadAddress[1];
   tmpVar[5]:=ReadAddress[2];
   DataSumCheck:=DataSumCheck+ReadAddress[2];
   tmpVar[6]:=ReadAddress[3];
   DataSumCheck:=DataSumCheck+ReadAddress[3];

   tmpStr:=IntToHex(ReadBytes,2);
   tmpChr:=tmpStr[1];
   tmpVar[7]:=Ord(tmpChr);
   DataSumCheck:=DataSumCheck+Ord(tmpChr);
   tmpChr:=tmpStr[2];
   tmpVar[8]:=Ord(tmpChr);
   DataSumCheck:=DataSumCheck+Ord(tmpChr);

   tmpVar[9]:=$03;//ETX
   DataSumCheck:=DataSumCheck+$03;

   tmpStr:=IntToHex(DataSumCheck,2);
   tmpChr:=tmpStr[1];
   tmpVar[10]:=Ord(tmpChr);
   tmpChr:=tmpStr[2];
   tmpVar[11]:=Ord(tmpChr);
   MainForm.MSComm.Output:=tmpVar;

   sleep(1000);

   InputLen:=MainForm.MSComm.InBufferCount;
   Input:=MainForm.MSComm.Input;
   if InputLen>0 then
   begin
      if Input[0]=$02 then//STX
      begin
        ReadDataSum:=0;
        for i:=1 to ReadBytes do
        begin
            tmpInt:=Input[i];
            ReadChar[i-1]:=chr(tmpInt);
            ReadDataSum:=ReadDataSum+Input[i];
        end;
        inc(i);
        if Input[i]=$03 then
        begin
            ReadDataSum:=ReadDataSum+$03;
            tmpStr:=IntToHex(ReadDataSum,2);
            chr1:=tmpStr[1];
            chr2:=tmpStr[2];            
            if (ord(chr1)=Input[1]) and (ord(chr1)=Input[1]) then
            begin
                Result:=True;
                ShowMessage('DataRead succeed');
            end
            else begin
                Result:=False;                
                ShowMessage('DataRead check fail');                
            end;
        end;
      end
      else
        Result:=False;
   end
   else
      Result:=False;
end;


function    WritePLC(WriteChar:Array of char; WriteAddress:Array of Byte;
       WriteBytesCount :Integer): Boolean;
var
   ReadDataSum:integer;
   DataSumCheck:integer;
   tmpStr:String;
   tmpchr,chr1,chr2:char;
   tmpVar:Variant;
   Input:Variant;
   InputLen,i,tmpInt:Integer;

begin
   DataSumCheck:=0;
   tmpInt:=11+WriteBytesCount;
   tmpVar:=VarArrayCreate([1,tmpInt],varByte);
   tmpVar[1]:=$02;//STX
   tmpVar[2]:=$31;//CMDO
   DataSumCheck:=DataSumCheck+$31;   
   tmpVar[3]:=WriteAddress[0];
   DataSumCheck:=DataSumCheck+WriteAddress[0];
   tmpVar[4]:=WriteAddress[1];
   DataSumCheck:=DataSumCheck+WriteAddress[1];
   tmpVar[5]:=WriteAddress[2];
   DataSumCheck:=DataSumCheck+WriteAddress[2];
   tmpVar[6]:=WriteAddress[3];
   DataSumCheck:=DataSumCheck+WriteAddress[3];

   tmpStr:=IntToHex(WriteBytesCount,2);
   tmpChr:=tmpStr[1];
   tmpVar[7]:=Ord(tmpChr);
   DataSumCheck:=DataSumCheck+Ord(tmpChr);
   tmpChr:=tmpStr[2];
   tmpVar[8]:=Ord(tmpChr);
   DataSumCheck:=DataSumCheck+Ord(tmpChr);
   tmpVar[9]:=$03;//ETX
   DataSumCheck:=DataSumCheck+$03;

   for i:=0 to WriteBytesCount-1 do
   begin
      tmpVar[10+i]:=ord(WriteChar[i]);
      DataSumCheck:=DataSumCheck+ord(WriteChar[i]);
   end;

   tmpStr:=IntToHex(DataSumCheck,2);
   tmpChr:=tmpStr[1];
   tmpVar[10+WriteBytesCount]:=Ord(tmpChr);
   tmpChr:=tmpStr[2];
   tmpVar[11+WriteBytesCount]:=Ord(tmpChr);

   MainForm.MSComm.Output:=tmpVar;

   sleep(1000);

   InputLen:=MainForm.MSComm.InBufferCount;
   Input:=MainForm.MSComm.Input;
   if InputLen>0 then
   begin
      if Input[0]=$06 then//STX
      begin
         Result:=True;
         ShowMessage('DataWrite succeed');
      end
      else begin
         Result:=False;
         ShowMessage('DataWrite check fail');                
      end;
   end
   else
      Result:=False;
end;

procedure TMainForm.Panel2Click(Sender: TObject);
var
  tmpWord:Word;
  str:string;
  ch:char;
begin
  tmpWord:=3;
  str:=IntToHex(3,2);
  ch:=str[1];
  Caption:=ch;
end;

end.