unit3.pas

基于MODBUSTCP协议的客户端通讯程序

unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, ActnList, StdCtrls, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    EditSend: TRichEdit;
    EditRecv: TRichEdit;
    EditIP: TLabeledEdit;
    EditAddr: TLabeledEdit;
    EditQty: TLabeledEdit;
    Splitter1: TSplitter;
    IdTCPClient1: TIdTCPClient;
    BitBtn2: TBitBtn;
    ActionList1: TActionList;
    ActConnect: TAction;
    SpeedButton1: TSpeedButton;
    ActReadCoils: TAction;
    ActReadDiscrete: TAction;
    ActReadInputRegister: TAction;
    ActReadHoldRegister: TAction;
    ActWriteCoils: TAction;
    ActWriteHoldRegister: TAction;
    BitBtn1: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    BitBtn6: TBitBtn;
    EditDeviceID: TLabeledEdit;
    BitBtn5: TBitBtn;
    procedure ActConnectExecute(Sender: TObject);
    procedure ActReadCoilsExecute(Sender: TObject);
    procedure ActReadDiscreteExecute(Sender: TObject);
    procedure ActReadHoldRegisterExecute(Sender: TObject);
    procedure ActReadInputRegisterExecute(Sender: TObject);
    procedure ActWriteHoldRegisterExecute(Sender: TObject);
    procedure ActWriteCoilsExecute(Sender: TObject);
  private
    { Private declarations }
    FID: word;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses uModBusClient;

{$R *.dfm}

procedure TForm1.ActConnectExecute(Sender: TObject);
begin
  IdTCPClient1.Host := EditiP.Text;
  if IdTCPClient1.Connected then
    IdTCPClient1.Disconnect
  else
    IdTCPClient1.Connect();
  ActConnect.Checked := IdTCPClient1.Connected;
end;

procedure TForm1.ActReadCoilsExecute(Sender: TObject);
var
  Head: Tmb_tcp_header;
  Req:  Tmb_req_pdu;
  Rsp:  Tmb_rsp_pdu;
  Addr, Qty: word;
  S, H: string;
  L:    word;
  I, P: integer;
  B:    byte;
  FDeviceID: byte;
begin
  FillChar(Head, Sizeof(Head), 0);
  FDeviceID := StrToInt(EditDeviceID.Text);
  with Req do
  begin
    fUnitID := FDeviceID;
    fFunctionCode := mbReadCoils;
    Addr    := StrToInt(EditAddr.Text)-1;
    fReadStartAddr := Swap(Addr);
    Qty     := StrToInt(EditQty.Text);
    fReadQuantity := Swap(Qty);
  end;
  Head.fRecLength     := Swap(6);
  Head.fTransactionID := Swap(FID);
  Inc(FID);

  SetLength(S, 256);
  Move(Head, S[1], 6);
  Move(Req, S[7], 6);
  IdTCPClient1.WriteBuffer(S[1], 12);
  SetLength(H, 24);
  BinToHex(PChar(S), PChar(H), 12);
  EditSend.Lines.Add(H);

  S := IdTCPClient1.CurrentReadBuffer;
  if S > '' then
  begin
    Move(S[1], Head, 6);
    L := Swap(Head.fRecLength);
    Move(S[7], Rsp, L);
    SetLength(H, (6 + L) * 2);
    BinToHex(PChar(S), PChar(H), 6 + L);
    EditRecv.Lines.Add(H);
    if (Rsp.fFunctionCode and $80) = 0 then
    begin
      L := 0;
      P := 0;
      while L < Qty do
      begin
        B := Rsp.fReadData[P];
        for I := 0 to 7 do
        begin
          H := Format('0%5.5d : %d', [Addr + L+1, B and $01]);
          EditRecv.Lines.Add(H);
          B := B shr 1;
          Inc(L);
          if L = Qty then
            break;
        end;
        Inc(P);
      end;
    end;
  end;
end;

procedure TForm1.ActReadDiscreteExecute(Sender: TObject);
var
  Head: Tmb_tcp_header;
  Req:  Tmb_req_pdu;
  Rsp:  Tmb_rsp_pdu;
  Addr, Qty: word;
  S, H: string;
  L:    word;
  I, P: integer;
  B:    byte;
  FDeviceID: byte;
begin
  FillChar(Head, Sizeof(Head), 0);
  FDeviceID := StrToInt(EditDeviceID.Text);
  with Req do
  begin
    fUnitID := FDeviceID;
    fFunctionCode := mbReadDiscreteInputs;
    Addr    := StrToInt(EditAddr.Text)-1;
    fReadStartAddr := Swap(Addr);
    Qty     := StrToInt(EditQty.Text);
    fReadQuantity := Swap(Qty);
  end;
  Head.fRecLength     := Swap(6);
  Head.fTransactionID := Swap(FID);
  Inc(FID);

  SetLength(S, 256);
  Move(Head, S[1], 6);
  Move(Req, S[7], 6);
  IdTCPClient1.WriteBuffer(S[1], 12);
  SetLength(H, 24);
  BinToHex(PChar(S), PChar(H), 12);
  EditSend.Lines.Add(H);

  S := IdTCPClient1.CurrentReadBuffer;
  if S > '' then
  begin
    Move(S[1], Head, 6);
    L := Swap(Head.fRecLength);
    Move(S[7], Rsp, L);
    SetLength(H, (6 + L) * 2);
    BinToHex(PChar(S), PChar(H), 6 + L);
    EditRecv.Lines.Add(H);

    if (Rsp.fFunctionCode and $80) = 0 then
    begin
      L := 0;
      P := 0;
      while L < Qty do
      begin
        B := Rsp.fReadData[P];
        for I := 0 to 7 do
        begin
          H := Format('1%5.5d : %d', [Addr + L+1, B and $01]);
          EditRecv.Lines.Add(H);
          B := B shr 1;
          Inc(L);
          if L = Qty then
            break;
        end;
        Inc(P);
      end;
    end;
  end;
end;

procedure TForm1.ActReadHoldRegisterExecute(Sender: TObject);
var
  Head: Tmb_tcp_header;
  Req:  Tmb_req_pdu;
  Rsp:  Tmb_rsp_pdu;
  Addr, Qty: word;
  S, H: string;
  L:    word;
  I:    integer;
  W:    word;
  FDeviceID: byte;
begin
  FillChar(Head, Sizeof(Head), 0);
  FDeviceID := StrToInt(EditDeviceID.Text);
  with Req do
  begin
    fUnitID := FDeviceID;
    fFunctionCode := mbReadHoldingRegisters;
    Addr    := StrToInt(EditAddr.Text)-1;
    fReadStartAddr := Swap(Addr);
    Qty     := StrToInt(EditQty.Text);
    fReadQuantity := Swap(Qty);
  end;
  Head.fRecLength     := Swap(6);
  Head.fTransactionID := Swap(FID);
  Inc(FID);

  SetLength(S, 256);
  Move(Head, S[1], 6);
  Move(Req, S[7], 6);
  IdTCPClient1.WriteBuffer(S[1], 12);
  SetLength(H, 24);
  BinToHex(PChar(S), PChar(H), 12);
  EditSend.Lines.Add(H);

  S := IdTCPClient1.CurrentReadBuffer;
  if S > '' then
  begin
    Move(S[1], Head, 6);
    L := Swap(Head.fRecLength);
    Move(S[7], Rsp, L);
    SetLength(H, (6 + L) * 2);
    BinToHex(PChar(S), PChar(H), 6 + L);
    EditRecv.Lines.Add(H);

    if (Rsp.fFunctionCode and $80) = 0 then
      for I := 0 to Rsp.fCount div 2 - 1 do
      begin
        Move(Rsp.fReadData[I * 2], W, 2);
        H := Format('4%5.5d : %d', [Addr + I+1, Swap(W)]);
        EditRecv.Lines.Add(H);
      end;
  end;
end;

procedure TForm1.ActReadInputRegisterExecute(Sender: TObject);
var
  Head: Tmb_tcp_header;
  Req:  Tmb_req_pdu;
  Rsp:  Tmb_rsp_pdu;
  Addr, Qty: word;
  S, H: string;
  L:    word;
  I:    integer;
  W:    word;
  FDeviceID: byte;
begin
  FillChar(Head, Sizeof(Head), 0);
  FDeviceID := StrToInt(EditDeviceID.Text);
  with Req do
  begin
    fUnitID := FDeviceID;
    fFunctionCode := mbReadInputRegisters;
    Addr    := StrToInt(EditAddr.Text)-1;
    fReadStartAddr := Swap(Addr);
    Qty     := StrToInt(EditQty.Text);
    fReadQuantity := Swap(Qty);
  end;
  Head.fRecLength     := Swap(6);
  Head.fTransactionID := Swap(FID);
  Inc(FID);

  SetLength(S, 256);
  Move(Head, S[1], 6);
  Move(Req, S[7], 6);
  IdTCPClient1.WriteBuffer(S[1], 12);
  SetLength(H, 24);
  BinToHex(PChar(S), PChar(H), 12);
  EditSend.Lines.Add(H);

  S := IdTCPClient1.CurrentReadBuffer;
  if S > '' then
  begin
    Move(S[1], Head, 6);
    L := Swap(Head.fRecLength);
    Move(S[7], Rsp, L);
    SetLength(H, (6 + L) * 2);
    BinToHex(PChar(S), PChar(H), 6 + L);
    EditRecv.Lines.Add(H);

    if (Rsp.fFunctionCode and $80) = 0 then
      for I := 0 to Rsp.fCount div 2 - 1 do
      begin
        Move(Rsp.fReadData[I * 2], W, 2);
        H := Format('3%5.5d : %d', [Addr + I+1, Swap(W)]);
        EditRecv.Lines.Add(H);
      end;
  end;
end;

procedure TForm1.ActWriteHoldRegisterExecute(Sender: TObject);
var
  Head: Tmb_tcp_header;
  Req:  Tmb_req_pdu;
  Rsp:  Tmb_rsp_pdu;
  Addr, Qty: word;
  S, H: string;
  L:    word;
  I:    integer;
  W:    word;
begin
  FillChar(Head, Sizeof(Head), 0);
  with Req do
  begin
    fUnitID := 0;
    fFunctionCode := mbWriteMultipleRegisters;
    Addr    := StrToInt(EditAddr.Text)-1;
    fHoldStartAddr := Swap(Addr);
    Qty     := StrToInt(EditQty.Text);
    fRegisterQuantity := Swap(Qty);
    fCount2 := Qty * 2;
    for I := 0 to Qty - 1 do
      fOutRegisterValues[I] := Random(65536);
  end;
  L := Req.fCount2 + 7;
  Head.fRecLength := Swap(L);

  SetLength(S, 256);
  Move(Head, S[1], 6);
  Move(Req, S[7], L);
  IdTCPClient1.WriteBuffer(S[1], L + 6);
  SetLength(H, (L + 6) * 2);
  BinToHex(PChar(S), PChar(H), L + 6);
  EditSend.Lines.Add(H);

  S := IdTCPClient1.CurrentReadBuffer;
  if S > '' then
  begin
    Move(S[1], Head, 6);
    L := Swap(Head.fRecLength);
    Move(S[7], Rsp, L);
    SetLength(H, (6 + L) * 2);
    BinToHex(PChar(S), PChar(H), 6 + L);
    EditRecv.Lines.Add(H);
  end;
end;

procedure TForm1.ActWriteCoilsExecute(Sender: TObject);
var
  Head: Tmb_tcp_header;
  Req:  Tmb_req_pdu;
  Rsp:  Tmb_rsp_pdu;
  Addr, Qty: word;
  S, H: string;
  L:    word;
  I:    integer;
  W:    word;
begin
  FillChar(Head, Sizeof(Head), 0);
  with Req do
  begin
    fUnitID := 0;
    fFunctionCode := mbWriteMultipleCoils;
    Addr    := StrToInt(EditAddr.Text)-1;
    fCoilsStartAddr := Swap(Addr);
    Qty     := StrToInt(EditQty.Text);
    L := Qty div 8;
    if Qty mod 8 >0 then
      L := L+1;
    fCoilQuantity := Swap(Qty);
    fCount1 := L;
    for I := 0 to L-1 do
      fOutCoilValues[I] := Random(256);
    if Qty mod 8 > 0 then  
    fOutCoilValues[L-1] := fOutCoilValues[L-1] shr ( 8 - Qty mod 8);
  end;
  L := Req.fCount1 + 7;
  Head.fRecLength := Swap(L);

  SetLength(S, 256);
  Move(Head, S[1], 6);
  Move(Req, S[7], L);
  IdTCPClient1.WriteBuffer(S[1], L + 6);
  SetLength(H, (L + 6) * 2);
  BinToHex(PChar(S), PChar(H), L + 6);
  EditSend.Lines.Add(H);

  S := IdTCPClient1.CurrentReadBuffer;
  if S > '' then
  begin
    Move(S[1], Head, 6);
    L := Swap(Head.fRecLength);
    Move(S[7], Rsp, L);
    SetLength(H, (6 + L) * 2);
    BinToHex(PChar(S), PChar(H), 6 + L);
    EditRecv.Lines.Add(H);
  end;
end;

end.