ucomtest.pas

此串口调试程序加入了三菱PLC通讯调试

unit UComTest;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, MSCommLib_TLB, Grids, StrGrid,Registry,
  ExtCtrls, Panel3D, Spin;

Const
   STX=$02;//开始文本
   ETX=$03;//结束文本
   EOT=$04;//传输结束
   ENQ=$05;//请求
   ACK=$06;//认可
   LF =$0A;//换行
   CL =$0C;//清除
   CR =$0D;//回车
   NAK=$15;//不认可

Type
   SanLingDat=Record
     Comm:TMSComm;//串口
     StationNo:Byte;//站点
     PC_No:Byte;//PC号
     DeviceName:String; //PLC设备名
     Len:Byte;          //设备个数
     WaitTime:Byte;     //延迟时间
     DeviceType:Byte;   //设备类型
     ProtocolType:Byte; //协议格式
     WritData:String;   //待写入数据
End;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    StrG1: TStrGrid;
    M1: TMemo;
    Panel1: TPanel;
    Panel2: TPanel;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    M2: TMemo;
    GroupBox4: TGroupBox;
    StrG2: TStrGrid;
    Panel3: TPanel;
    BOpen: TButton;
    B1: TButton;
    B3: TButton;
    B2: TButton;
    CPort: TComboBox;
    Label1: TLabel;
    Button4: TButton;
    CloseComm: TButton;
    Chb1: TCheckBox;
    MSComm1: TMSComm;
    CBps: TComboBox;
    Label2: TLabel;
    Label3: TLabel;
    CJY: TComboBox;
    FXB0: TButton;
    PanFX: TPanel;
    FXEd1: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    FXEd2: TEdit;
    Label6: TLabel;
    FxB1: TButton;
    FXB2: TButton;
    RG1: TRadioGroup;
    RG2: TRadioGroup;
    SpinE1: TSpinEdit;
    Label7: TLabel;
    Label8: TLabel;
    StrG3: TStrGrid;
    Label9: TLabel;
    FxEd3: TEdit;
    FxEd4: TEdit;
    Label10: TLabel;
    Label11: TLabel;
    CbDat: TComboBox;
    Label12: TLabel;
    CbStp: TComboBox;
    BOnLine: TButton;
    BCLR: TButton;
    procedure BOpenClick(Sender: TObject);
    procedure B3Click(Sender: TObject);
    procedure B2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure CloseCommClick(Sender: TObject);
    procedure B1Click(Sender: TObject);
    procedure M2Change(Sender: TObject);
    procedure Chb1Click(Sender: TObject);
    procedure StrG2KeyPress(Sender: TObject; var Key: Char);
    procedure MSComm1Comm(Sender: TObject);
    procedure M1Change(Sender: TObject);
    procedure CPortChange(Sender: TObject);
    procedure FXB0Click(Sender: TObject);
    procedure FXEd2KeyPress(Sender: TObject; var Key: Char);
    procedure FXEd1Change(Sender: TObject);
    procedure FxB1Click(Sender: TObject);
    procedure FXB2Click(Sender: TObject);
    procedure StrG3KeyPress(Sender: TObject; var Key: Char);
    procedure StrG3SetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: String);
    procedure FXEd2Change(Sender: TObject);
    procedure RG1Click(Sender: TObject);
    procedure StrG3DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FXEd1KeyPress(Sender: TObject; var Key: Char);
    procedure FxEd3Change(Sender: TObject);
    procedure BOnLineClick(Sender: TObject);
    procedure BCLRClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
Function CommDeviceOnLine(Comm:String):Integer;//串口设备是否已连上
{
在RS232中有4个脚位可用来回应讯号给电脑分別为:
CTS,DSR,RING,RLSD,当未接上设备时,脚位的电压皆为
低电压,讯号传回OFF,利用此四个脚位与电脑沟通,
检查脚位电压就知道改COM上是否有设备存在
MS_CTS_ON,MS_DSR_ON,MS_RING_ON,MS_RLSD_ON

此函数是检查串口第8脚的电平来判断设备是否在线，
因此设备通电时,一定使第8脚接上高电平,表示设备在线
}
var

hComm:THandle;
lS:dword;
Begin
hComm:=CreateFile(Pchar(Comm),Generic_read or Generic_write,0,nil,open_existing,0,0);
if(hComm=invalid_Handle_value) then
Begin
 Result:=-1;//串口不存在或已被占用
CloseHandle(hcomm);
 Exit;
End;
if GetCommModemStatus(hcomm,lS) then
begin
 if(ls and MS_CTS_ON)=MS_CTS_ON then //连上设备返回0，否则返回1
  Result:=0 Else Result:=1;
end Else Result:=1;
closeHandle(hcomm);
end;

procedure LoadPort(PortList:TStrings);
Var
Reg: TRegistry;
List:TStrings;
I:Integer;
begin
  Reg := TRegistry.Create;
  List:=TStringList.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('\HARDWARE\DEVICEMAP\SERIALCOMM', True) then
   begin

      Reg.GetValueNames(List);
     if List.Count>0 Then
     Begin
      PortList.Clear;
       for I:=0 To List.Count-1 do
        PortList.Add(Reg.ReadString(List.Strings[I]));//读入可用串行口
     End;
        Reg.CloseKey;
    end;
  finally
    Reg.Free;
    List.Free;
  end;
End;

Procedure ReadPLC(SLDat:SanLingDat);
Var HStr:String;
    CSum,L,I:Word;
    IsBit:Boolean;
    ProtFmt1:Boolean;
    CMD:String;
Begin
if SLDat.Len<1 Then Exit;
if SLDat.WaitTime>15 Then SLDat.WaitTime:=15;
   HStr:=IntToHex(SLDat.StationNo,2)+IntToHex(SLDat.PC_No,2);
   CSum:=0;
IsBit:=SLDat.DeviceType=0;//0=Bit,1=Word
ProtFmt1:=SLDat.ProtocolType=0;//0=Format1,1=Format4

   if IsBit Then CMD:='BR' Else CMD:='WR';
   CMD:=HStr+CMD+IntToHex(SLDat.WaitTime,1)+SLDat.DeviceName+IntToHex(SLDat.Len,2);
L:=Length(CMD);
//计算校验和
For I:=1 To L do
 CSum:=CSum+Ord(CMD[I]);
CSum:=CSum And $00FF;//取低字节
CMD:=CMD+IntToHex(CSum,2);
if ProtFmt1 Then
CMD:=Chr(ENQ)+CMD Else CMD:=Chr(ENQ)+CMD+#13#10;
//ShowMessage(CMD+','+IntToStr(Length(CMD)));
SLDat.Comm.Output:=CMD;
End;

Procedure WritePLC(SLDat:SanLingDat);
Var HStr:String;
    CMD:String;
    CSum,L,I:Word;
    IsBit:Boolean;
    ProtFmt1:Boolean;
Begin
if SLDat.WritData='' Then Exit;
if SLDat.Len<1 Then Exit;
if SLDat.WaitTime>15 Then SLDat.WaitTime:=15;

   HStr:=IntToHex(SLDat.StationNo,2)+IntToHex(SLDat.PC_No,2);
   CSum:=0;

IsBit:=SLDat.DeviceType=0;//0=Bit,1=Word
ProtFmt1:=SLDat.ProtocolType=0;//0=Format1,1=Format4

   if IsBit Then CMD:='BW' Else CMD:='WW';
   CMD:=HStr+CMD+IntToHex(SLDat.WaitTime,1)+SLDat.DeviceName+IntToHex(SLDat.Len,2)+SLDat.WritData;
L:=Length(CMD);
//计算校验和
For I:=1 To L do
 CSum:=CSum+Ord(CMD[I]);
CSum:=CSum And $00FF;//取低字节
CMD:=CMD+IntToHex(CSum,2);
if ProtFmt1 Then
SLDat.Comm.Output:=Chr(ENQ)+CMD Else SLDat.Comm.Output:=Chr(ENQ)+CMD+#13#10;
End;


procedure TForm1.BOpenClick(Sender: TObject);
Var S:String;
begin
if MSComm1.PortOpen Then MSComm1.PortOpen:=False;
S:=CPort.Text;
if S='' Then Exit;
S:=Copy(S,4,Length(S)-3);
Caption:='串口通信测试----'+CPort.Text+':已打开';
MSComm1.CommPort:=StrToInt(S);

MSComm1.Settings:=CBps.Text+','+CJY.Text[1]+','+CbDat.Text+','+CbStp.Text;
//ShowMessage(MSComm1.Settings);

MSComm1.PortOpen:=True;
BCLR.Enabled:=True;
B1.Enabled:=M2.Text<>'';
B2.Enabled:=B1.Enabled;
FXB0.Enabled:=True;
B3.Enabled:=Not Chb1.Checked;
end;

procedure TForm1.B3Click(Sender: TObject);
begin
M1.Text:=M1.Text+MSComm1.Input;
end;

procedure TForm1.B2Click(Sender: TObject);
Var S:String;
    Str:String;
    R,C:Integer;
begin
M1.Text:='';
S:=StrG2.Cells[1,1];
R:=1;C:=1;
Str:='';
While S<>'' do
Begin
 Str:=Str+Chr(StrToInt('$'+S));
    if C mod 16=0 Then
    Begin
     Inc(R);
     C:=1;
    End Else Inc(C);
 S:=StrG2.Cells[C,R];    
End;
if Str='' Then Exit;
MSComm1.Output:=Str;
end;

procedure TForm1.FormCreate(Sender: TObject);
Var I:Integer;
begin
Left:=(Screen.Width-Width)div 2;
Top:=(Screen.Height-Height) div 2;
StrG1.ColWidths[0]:=30;
StrG1.Cells[0,0]:='地址';
StrG2.ColWidths[0]:=30;
StrG2.Cells[0,0]:='地址';

 For I:=0 To StrG1.ColCount-2 do
 Begin
 StrG1.ColWidths[I+1]:=16;
 StrG1.Cells[I+1,0]:=IntToHex(I,2);
 StrG2.ColWidths[I+1]:=16;
 StrG2.Cells[I+1,0]:=IntToHex(I,2);
 End;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
LoadPort(CPort.Items);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
LoadPort(CPort.Items);
end;

procedure TForm1.CloseCommClick(Sender: TObject);
begin
if MSComm1.PortOpen Then MSComm1.PortOpen:=False;
Caption:='串口通信测试----'+CPort.Text+':已关闭';
B1.Enabled:=False;
B2.Enabled:=False;
B3.Enabled:=False;
FXB0.Enabled:=False;
PanFx.Visible:=False;
BCLR.Enabled:=False;
end;

procedure TForm1.B1Click(Sender: TObject);
begin
M1.Text:='';
MSComm1.Output:=M2.Text;
end;

procedure TForm1.M2Change(Sender: TObject);
Var
    B:Array of Byte;
    S:String;
    I,N,R,C:Integer;
begin
S:=Trim(M2.Text);
B1.Enabled:=(S<>'')and MSComm1.PortOpen;
B2.Enabled:=B1.Enabled;
if S='' Then
Begin
StrG2.RowCount:=2;
StrG2.Rows[1].Clear;