umodbusform.pas

这是一个用D6实现的对LineGuard进行通信的简单例程,通过该程序

unit UModBusForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, SerialNG, StdCtrls, ComCtrls, Menus, ExtCtrls;

type
  TModbusForm = class(TForm)
    com: TSerialPortNG;
    lbStatus: TListBox;
    PageControl1: TPageControl;
    tabGetBool: TTabSheet;
    tabSetBool: TTabSheet;
    tabGetNum: TTabSheet;
    tabSetNum: TTabSheet;
    tabData: TTabSheet;
    lbReadBool: TListBox;
    btnRedBool: TButton;
    lbSetBool: TListBox;
    btnSet: TButton;
    btnClear: TButton;
    lbGetNumeric: TListBox;
    btnGetNumeric: TButton;
    edtValue: TEdit;
    Label1: TLabel;
    lbSetNumeric: TListBox;
    btnSetNumeric: TButton;
    Label2: TLabel;
    edtSetValue: TEdit;
    Button1: TButton;
    popStatus: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    WaitForResponseTimer: TTimer;
    lbLogs: TListBox;
    btnReadLogs: TButton;
    Button2: TButton;
    procedure btnRedBoolClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure comWriteDone(Sender: TObject);
    procedure comProcessError(Sender: TObject; Place, Code: Cardinal;
      Msg: String);
    procedure N3Click(Sender: TObject);
    procedure WaitForResponseTimerTimer(Sender: TObject);
    procedure comRxClusterEvent(Sender: TObject);
    procedure btnSetClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure btnGetNumericClick(Sender: TObject);
    procedure btnSetNumericClick(Sender: TObject);
    procedure btnReadLogsClick(Sender: TObject);
    procedure comLineErrorEvent(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    procedure setCom;
  public
    { Public declarations }
  end;

var
  ModbusForm: TModbusForm;
  hasResponse : Boolean = False;
  rData   : pchar;
  rlen    : integer;
  sendlength : integer;


implementation
  uses UComm, setComm, wait;

{$R *.dfm}

procedure TModbusForm.btnRedBoolClick(Sender: TObject);
var
  Msg           : Pchar;
  MsgByte       : array of byte;
  selregister   : String;
  registerno    : Word;
  tmp           : byte;
  Response      : array of byte;
  ResultStr     : String;
  I             : integer;
  WaitBox       : TForm2;
begin
  SetLength(MsgByte,6);
  if (lbReadBool.ItemIndex=-1) then
  begin
    lbStatus.Items.Add('请先选择要读的寄存器');
    Exit;
  end;
  selregister := lbReadBool.Items.Strings[lbReadBool.ItemIndex];
  selregister := Copy(selregister,1,Pos(':',selregister)-1);
  lbStatus.Items.Add('您要读' + selregister + '号寄存器');

  registerno := StrToInt(selregister);
  MsgByte[0]:=$1;
  MsgByte[1]:=$1;
  tmp := (registerno and $FF00) shr 8;
  MsgByte[2]:=tmp;
  tmp := registerno and $00FF;
  MsgByte[3]:=tmp;
  MsgByte[4]:=$0;
  MsgByte[5]:=$1;
  Msg := OrganizeMsg(MsgByte, sendlength);
  lbStatus.Items.Add('发送命令：' + Msg);
  com.SendData(Msg,Length(Msg));
  hasResponse := False;
  WaitForResponseTimer.Enabled := True;
  WaitBox := TForm2.Create(nil);
  WaitBox.Update;
  WaitBox.Show;
  Screen.Cursor := crHourGlass;
  while WaitForResponseTimer.Enabled and not hasResponse do begin
    Application.ProcessMessages;
  end;
  WaitBox.Close;
  WaitBox.Free;
  Screen.Cursor := crDefault;
  if hasResponse then begin
    SetLength(response,(rLen-3) div 2);
    ResultStr := '';
    if DeOrganizeMsg(rData,response) then
    begin
      for I := Low(response) to High(response) do
        ResultStr := ResultStr + format('%0.2x',[response[I]]);
    end else
        ResultStr := '错误响应!';
    lbStatus.Items.Add(ResultStr);
  end;
end;

procedure TModbusForm.Button1Click(Sender: TObject);
var
  res : array of Byte;
  rec : pchar;
  inLen : integer;
  ResultStr : String;
begin
  rec := ':010306140000000008DA' + chr(13) + chr(10);
  inLen := Length(rec);

  setLength(res,(inLen - 3) div 2);
  if DeOrganizeMsg(rec,res) then
  begin
    ResultStr := '';
    for inLen := Low(res) to High(res) do
      ResultStr := ResultStr + format('%0.2x',[res[inLen]]);
  end else
    ResultStr := 'Error';
  setLength(res,0);
  lbStatus.Items.Add(ResultStr);
end;

procedure TModbusForm.N1Click(Sender: TObject);
begin
  lbStatus.Items.Clear;
end;

procedure TModbusForm.N2Click(Sender: TObject);
begin
  lbStatus.Items.SaveToFile('LOG.Txt');
end;

procedure TModbusForm.comWriteDone(Sender: TObject);
begin
  if (sendlength<>com.WrittenBytes) then
  begin
    lbStatus.Items.Add('命令发送错误');
  end else
    lbStatus.Items.Add('命令发送完毕');

end;

procedure TModbusForm.comProcessError(Sender: TObject; Place,
  Code: Cardinal; Msg: String);
begin
  lbStatus.Items.Add(Msg);
end;

procedure TModbusForm.N3Click(Sender: TObject);
begin
  setCom;
end;

procedure TModbusForm.setCom;
var
  i,port,baud : integer;
  s : string;

begin
  com.Active := False;

  fmSetComm := TfmSetComm.Create(nil);
  with fmSetComm do begin
    S := trim(com.CommPort);
    port:= StrToInt(S[length(S)]);
    cbPort.ItemIndex := port-1;
    baud := com.BaudRate;
    s := IntToStr(baud);
    for i:= 0 to cbSpeed.Items.Count - 1 do
      if (cbSpeed.Items[i]=s) then begin
        cbSpeed.ItemIndex := i;
        Break;
      end;
    cbCRC.ItemIndex := com.ParityType;
    cbStop.ItemIndex := com.StopBits - 1;
    cbBit.ItemIndex := com.DataBits - 4;
    
    if (showModal=mrOK) then begin
      port:=cbPort.ItemIndex+1;
      baud:=StrToInt(cbSpeed.Items[cbSpeed.ItemIndex]);
      com.CommPort := 'COM' + inttostr(port);
      com.BaudRate := baud;
      com.DataBits := cbBit.ItemIndex + 4;
      com.StopBits := cbStop.ItemIndex + 1;
      com.ParityType := cbCRC.ItemIndex;
    end;
  end;
  fmSetComm.Free;
//  COM.DTRState := False;
//  com.RTSState := False;
  com.FlowControl := fcNone;
  com.Active := True;
//  COM.DTRState := False;
//  com.RTSState := False;
end;

procedure TModbusForm.WaitForResponseTimerTimer(Sender: TObject);
begin
  WaitForResponseTimer.Enabled := False;
  hasResponse := False;
  lbStatus.Items.Add('LineGuard无响应');
end;

procedure TModbusForm.comRxClusterEvent(Sender: TObject);
var
  error : Cardinal;
begin
  hasResponse := True;
  WaitForResponseTimer.Enabled := False;
  rLen := com.NextClusterSize;
  rData := com.ReadNextCluster(rLen,error);
  lbStatus.Items.Add('LineGuard 返回:' + rData);
end;

procedure TModbusForm.btnSetClick(Sender: TObject);
var
  Msg           : Pchar;
  MsgByte       : array of byte;
  selregister   : String;
  registerno    : Word;
  tmp           : byte;
  Response      : array of byte;
  ResultStr     : String;
  I             : integer;
  WaitBox       : TForm2;
begin
  SetLength(MsgByte,6);
  if (lbSetBool.ItemIndex=-1) then
  begin
    lbStatus.Items.Add('请先选择要读的寄存器');
    Exit;
  end;
  selregister := lbSetBool.Items.Strings[lbSetBool.ItemIndex];
  selregister := Copy(selregister,1,Pos(':',selregister)-1);
  lbStatus.Items.Add('您要设置' + selregister + '号寄存器');

  registerno := StrToInt(selregister);
  MsgByte[0]:=$1;
  MsgByte[1]:=$5;
  //寄存器号
  tmp := (registerno and $FF00) shr 8;
  MsgByte[2]:=tmp;
  tmp := registerno and $00FF;
  MsgByte[3]:=tmp;
  //数据
  MsgByte[4]:=$FF;
  MsgByte[5]:=$00;
  Msg := OrganizeMsg(MsgByte, SendLength);
  SetLength(MsgByte,0);
  
  lbStatus.Items.Add('发送命令：' + Msg);
  com.SendData(Msg,Length(Msg));
  hasResponse := False;
  WaitForResponseTimer.Enabled := True;
  WaitBox := TForm2.Create(nil);
  WaitBox.Update;
  WaitBox.Show;
  Screen.Cursor := crHourGlass;
  while WaitForResponseTimer.Enabled and not hasResponse do begin
    Application.ProcessMessages;
  end;
  WaitBox.Close;
  WaitBox.Free;
  Screen.Cursor := crDefault;
  if hasResponse then begin
    SetLength(response,(rLen-3) div 2);