idmodbusclient.pas

Modbus 协议是应用于电子控制器上的一种通用语言。通过此协议

{===============================================================================

The contents of this file are subject to the Mozilla Public License Version 1.1
(the "License"); you may not use this file except in compliance with the
License. You may obtain a copy of the License at http://www.mozilla.org/MPL/

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.

Alternatively, the contents of this file may be used under the terms of the
GNU General Public License Version 2 or later (the "GPL"), in which case
the provisions of the GPL are applicable instead of those above. If you wish to
allow use of your version of this file only under the terms of the GPL and not
to allow others to use your version of this file under the MPL, indicate your
decision by deleting the provisions above and replace them with the notice and
other provisions required by the GPL. If you do not delete the provisions
above, a recipient may use your version of this file under either the MPL or
the GPL.

$Id: IdModbusClient.pas,v 1.5 2004/02/04 14:25:37 plpolak Exp $

===============================================================================}

{$I compiler.inc}

unit IdModBusClient;

interface

uses
  Classes
 ,SysUtils
 ,ModBusConsts
 ,ModbusTypes
{$IFDEF DMB_DELPHI6}
 ,Types
{$ENDIF}
 ,IdTCPClient;

type
  TIdModBusClient = class(TIdTCPClient)
  private
    FBlockLength: Word;
    FConnectTimeOut: Integer;
    FModBusFunction: TModBusFunction;
    FRegNumber: Word;
    FTimeOut: Cardinal;
    FUnitID: Byte;
    procedure SetBlockLength(const Value: Word);
    procedure SetModBusFunction(const Value: TModBusFunction);
    procedure SetRegNumber(const Value: Word);
    function GetVersion: String;
    procedure SetVersion(const Value: String);
  protected
    procedure GetBits(Buffer: TCommsBuffer);
    procedure GetRegisters(Buffer: TCommsBuffer);
  public
    Data: array[0..255] of Word;
    constructor Create(AOwner: TComponent); override;
  { public methods }
    procedure ClearData;
    function Execute: Boolean;
    function ReadRegister(const RegNo: Word; out Value: Word): Boolean;
    function ReadRegisters(const RegNo: Word; const Blocks: Word; var RegisterData: array of Word): Boolean;
    function WriteRegister(const RegNo: Word; const Value: Word): Boolean;
    function WriteRegisters(const RegNo: Word; const RegisterData: array of Word): Boolean;
  published
    property BlockLength: Word read FBLockLength write SetBlockLength default 0;
    property ConnectTimeOut: Integer read FConnectTimeOut write FConnectTimeOut default -1;
    property RegNumber: Word read FRegNumber write SetRegNumber default 0;
    property ModBusFunction: TModBusFunction read FModBusFunction write SetModBusFunction default 0;
    property Port default MB_PORT;
    property TimeOut: Cardinal read FTimeOut write FTimeout default 15000;
    property UnitID: Byte read FUnitID write FUnitID default 1;
    property Version: String read GetVersion write SetVersion stored False;
  end; { TIdModBusClient }


implementation

{ TIdModBusClient }

procedure TIdModBusClient.ClearData;
begin
  FillChar(Data, SizeOf(Data), 0);
end; { ClearData }


constructor TIdModBusClient.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FillChar(Data, SizeOf(Data), 0);
  FBlockLength := 0;
  FConnectTimeOut := -1;
  FModBusFunction := 0; 
  FRegNumber := 0;
  FUnitID := 1;
  FTimeOut := 15000;
  Port := MB_PORT;
end; { Create }


function TIdModBusClient.Execute: Boolean;
var
  SendBuffer: TCommsBuffer;
  ReceiveBuffer: TCommsBuffer;
  wBlockLength: Word;
  wRegNumber: Word;
  dtTimeOut: TDateTime;
  i: Integer;
  WordPtr: ^Word;
  BytePtr: ^Byte;
  BitMask: Byte;
  BytesToWrite: Byte;
begin
  try
    SendBuffer.TransactionID := 0;
    SendBuffer.ProtocolID := 0;
  { Initialise data related variables }
    wRegNumber := FRegNumber - 1;
  { Perform function code specific operations }
    case FModBusFunction of
      mbfReadCoils,
      mbfReadInputBits:
        begin
          wBlockLength := FBlockLength;
        { Don't exceed max length }
          if (wBlockLength > 250) then
            wBlockLength := 250;
        { Initialise the data part }
          SendBuffer.FunctionCode := Byte(FModBusFunction); { Write appropriate function code }
          SendBuffer.UnitID := FUnitID;
          SendBuffer.MBPData[0] := Hi(wRegNumber);
          SendBuffer.MBPData[1] := Lo(wRegNumber);
          SendBuffer.MBPData[2] := Hi(wBlockLength);
          SendBuffer.MBPData[3] := Lo(wBlockLength);
          SendBuffer.RecLength := Swap(6); { This includes UnitID/FuntionCode }
        end;
      mbfReadRegs,
      mbfReadInputRegs:
        begin
          wBlockLength := FBlockLength;
          if (wBlockLength > 125) then
            wBlockLength := 125; { Don't exceed max length }
        { Initialise the data part }
          SendBuffer.FunctionCode := Byte(FModBusFunction); { Write appropriate function code }
          SendBuffer.UnitID := FUnitID;
          SendBuffer.MBPData[0] := Hi(wRegNumber);
          SendBuffer.MBPData[1] := Lo(wRegNumber);
          SendBuffer.MBPData[2] := Hi(wBlockLength);
          SendBuffer.MBPData[3] := Lo(wBlockLength);
          SendBuffer.RecLength := Swap(6); { This includes UnitID/FuntionCode }
        end;
      mbfWriteOneCoil:
        begin
        { Initialise the data part }
          SendBuffer.FunctionCode := Byte(FModBusFunction); { Write appropriate function code }
          SendBuffer.UnitID := FUnitID;
          SendBuffer.MBPData[0] := Hi(wRegNumber);
          SendBuffer.MBPData[1] := Lo(wRegNumber);
          if (Data[0] <> 0) then
            SendBuffer.MBPData[2] := 255
          else
            SendBuffer.MBPData[2] := 0;
          SendBuffer.MBPData[3] := 0;
          SendBuffer.RecLength := Swap(6); { This includes UnitID/FuntionCode }
        end;
      mbfWriteOneReg:
        begin
        { Initialise the data part }
          SendBuffer.FunctionCode := Byte(FModBusFunction); { Write appropriate function code }
          SendBuffer.UnitID := FUnitID;
          SendBuffer.MBPData[0] := Hi(wRegNumber);
          SendBuffer.MBPData[1] := Lo(wRegNumber);
          SendBuffer.MBPData[2] := Hi(Data[0]);
          SendBuffer.MBPData[3] := Lo(Data[0]);
          SendBuffer.RecLength := Swap(6); { This includes UnitID/FuntionCode }
        end;
      mbfWriteCoils:
        begin
          wBlockLength := FBlockLength;
        { Don't exceed max length }
          if (wBlockLength > 250) then
            wBlockLength := 250;
        { Initialise the data part }
          SendBuffer.FunctionCode := Byte(FModBusFunction); { Write appropriate function code }
          SendBuffer.UnitID := FUnitID;
          SendBuffer.MBPData[0] := Hi(wRegNumber);
          SendBuffer.MBPData[1] := Lo(wRegNumber);
          SendBuffer.MBPData[2] := Hi(wBlockLength);
          SendBuffer.MBPData[3] := Lo(wBlockLength);

          BytesToWrite := Byte((wBlockLength + 7) div 8);
          SendBuffer.MBPData[4] := BytesToWrite;
          BytePtr := @SendBuffer.MBPData[5];
          BitMask := 1;
          for i := 0 to (BlockLength - 1) do
          begin
            if (BitMask = 1) then
              BytePtr^ := 0;
            if (Data[i] <> 0) then
              BytePtr^ := BytePtr^ or BitMask;
            if (BitMask = $80) then
            begin
              BitMask := 1;
              Inc(BytePtr);
            end
            else
              BitMask := (Bitmask shl 1);
          end;
          SendBuffer.RecLength := Swap(7 + BytesToWrite);
        end;
      mbfWriteRegs:
        begin
          wBlockLength := FBlockLength;
        { Don't exceed max length }
          if (wBlockLength > 250) then
            wBlockLength := 250;
        { Initialise the data part }
          SendBuffer.FunctionCode := Byte(FModBusFunction); { Write appropriate function code }
          SendBuffer.UnitID := FUnitID;
          SendBuffer.MBPData[0] := Hi(wRegNumber);
          SendBuffer.MBPData[1] := Lo(wRegNumber);
          SendBuffer.MBPData[2] := Hi(wBlockLength);
          SendBuffer.MBPData[3] := Lo(wBlockLength);

          BytesToWrite := Byte(wBlockLength shl 1);
          SendBuffer.MbpData[4] := BytesToWrite;
          WordPtr := @SendBuffer.MbpData[5];
          for i := 0 to (wBlockLength - 1) do
          begin
            WordPtr^ := Swap(Data[i]);
            Inc(WordPtr);
          end;
          SendBuffer.RecLength := Swap(7 + BytesToWrite);
        end;
    end;
  { Writeout the data to the connection }
    WriteBuffer(SendBuffer, Swap(SendBuffer.RecLength) + 6);

  {*** Wait for data from the PLC ***}
    if (FTimeOut > 0) then
    begin
      dtTimeOut := Now + (FTimeOut / 86400000);
      while (InputBuffer.Size = 0) do
      begin
        if Socket.Binding.Readable(0) then
          ReadFromStack;
        if (Now > dtTimeOut) then
        begin
          Result := False;
          Exit;
        end;
      end;
    end;

    Result := True;
    ReadBuffer(ReceiveBuffer, InputBuffer.Size);
  { Check if the result has the same function code as the request }
    if (Byte(FModBusFunction) = Byte(ReceiveBuffer.FunctionCode)) then
    begin
      case FModBusFunction of
        mbfReadCoils,
        mbfReadInputBits: GetBits(ReceiveBuffer);
        mbfReadRegs,
        mbfReadInputRegs: GetRegisters(ReceiveBuffer);
      end;
    end
    else
      Result := False;
  except
    Disconnect;
    raise;
  end;
end; { Execute }


procedure TIdModBusClient.GetBits(Buffer: TCommsBuffer);
var
  BitMask: Byte;
  BytePtr: ^Byte;
  n, i: Integer;
begin
  BytePtr := @Buffer.MBPData[1];
  n := Buffer.MBPData[0] * 8;
  if (n > 250) then
    n := 250;
  BitMask := 1;
  for i := 0 to (n - 1) do
  begin
    if ((BytePtr^ and BitMask) <> 0) then
      Data[i] := 1
    else
      Data[i] := 0;
    if (BitMask = $80) then
    begin
      BitMask := 1;
      Inc(BytePtr);
    end
    else
      BitMask := (Bitmask shl 1);
  end;
end; { GetBits }


procedure TIdModBusClient.GetRegisters(Buffer: TCommsBuffer);
var
  WPtr: ^Word;
  n, i: integer;
begin
  WPtr := @Buffer.MbpData[1];
  n := (Buffer.MbpData[0] shr 1);
  if (n > 125) then
    n := 125;
  for i := 0 to (n - 1) do
  begin
    Data[i] := Swap(WPtr^);
    Inc(WPtr);
  end;
end; { GetRegisters }


function TIdModBusClient.ReadRegister(const RegNo: Word;
  out Value: Word): Boolean;
var
  Data: array[0..0] of Word;  
begin
  Result := ReadRegisters(RegNo, 1, Data);
  Value := Data[0];
end; { ReadRegister }


function TIdModBusClient.ReadRegisters(const RegNo, Blocks: Word;
  var RegisterData: array of Word): Boolean;
var
  i: Integer;
begin
  ModBusFunction := mbfReadRegs;
  BlockLength := Blocks;
  RegNumber := RegNo;
  Connect(FConnectTimeOut);
  if Connected then
  begin
    ClearData;
    try
      Result := Execute;
      for i := 0 to Blocks do
        RegisterData[i] := Data[i];
    finally
      DisConnect;
    end;
  end
  else
    Result := False;
end; { ReadRegisters }


procedure TIdModBusClient.SetBlockLength(const Value: Word);
begin
  FBLockLength := Value;
end; { SetBlockLength }


procedure TIdModBusClient.SetModBusFunction(const Value: TModBusFunction);
begin
  FModBusFunction := Value;
end; { SetModBusFunction }


procedure TIdModBusClient.SetRegNumber(const Value: Word);
begin
  FRegNumber := Value;
end; { SetRegNumber }


function TIdModBusClient.GetVersion: String;
begin
  Result := DMB_VERSION;
end; { GetVersion }


procedure TIdModBusClient.SetVersion(const Value: String);
begin
{ This is a readonly property }
end; { SetVersion }


function TIdModBusClient.WriteRegister(const RegNo, Value: Word): Boolean;
begin
  ModBusFunction := mbfWriteOneReg;
  RegNumber := RegNo;
  Data[0] := Value;
  Connect(FConnectTimeOut);
  if Connected then
  begin
    try
      Result := Execute;
    finally
      DisConnect;
    end;
  end
  else
    Result := False;
end; { WriteRegister }


function TIdModBusClient.WriteRegisters(const RegNo: Word;
  const RegisterData: array of Word): Boolean;
var
  i, j: Integer;
begin
  ModBusFunction := mbfWriteRegs;
  BlockLength := High(RegisterData) - Low(RegisterData) + 1;
  RegNumber := RegNo;
  Connect(FConnectTimeOut);
  if Connected then
  begin
    try
      j := 0;
      for i := Low(RegisterData) to High(RegisterData) do
      begin
        Data[j] := RegisterData[i];
        Inc(j);
      end;
      Result := Execute;
    finally
      DisConnect;
    end;
  end
  else
    Result := False;
end; { WriteRegisters }


end.