找传奇、传世资源到传世资源站!

通过TCP / IP与ModBus PLC通信

8.5玩家评分(1人评分)
下载后可评
介绍 评论 失效链接反馈

【例子介绍】 Delphi组件,以通过TCP / IP与ModBus PLC通信。该库提供了同时实现ModBus主站和Modbus从站的组件,并且基于Indy组件集(支持Indy 9和10)

【相关图片】

from clipboard

【源码结构】

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

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: IdModbusServer.pas,v 1.38 2014/01/14 15:21:20 plpolak Exp $

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

{$I ModBusCompiler.inc}

unit IdModBusServer;

interface

uses
  Classes
 ,SysUtils
{$IFDEF DMB_INDY10}
 ,IdContext
 ,IdCustomTCPServer
 ,IdGlobal
{$ELSE}
 ,IdTCPClient
 ,IdTCPServer
{$ENDIF}
 ,ModBusConsts
 ,ModbusTypes
 ,ModbusUtils
 ,SyncObjs;

type
  TModRegisterData = array[0..MaxBlockLength] of Word;

type
  TModCoilData = array[0..MaxCoils] of ByteBool;

{$IFDEF DMB_INDY10}
type
  TModBusCoilReadEvent = procedure(const Sender: TIdContext;
    const RegNr, Count: Integer; var Data: TModCoilData;
    const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte) of object;
  TModBusRegisterReadEvent = procedure(const Sender: TIdContext;
    const RegNr, Count: Integer; var Data: TModRegisterData;
    const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte) of object;
  TModBusCoilWriteEvent = procedure(const Sender: TIdContext;
    const RegNr, Count: Integer; const Data: TModCoilData;
    const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte) of object;
  TModBusRegisterWriteEvent = procedure(const Sender: TIdContext;
    const RegNr, Count: Integer; const Data: TModRegisterData;
    const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte) of object;
  TModBusErrorEvent = procedure(const Sender: TIdContext;
    const FunctionCode: Byte; const ErrorCode: Byte;
    const RequestBuffer: TModBusRequestBuffer) of object;
  TModBusInvalidFunctionEvent = procedure(const Sender: TIdContext;
    const FunctionCode: TModBusFunction;
    const RequestBuffer: TModBusRequestBuffer) of object;
{$ELSE}
type
  TModBusCoilReadEvent = procedure(const Sender: TIdPeerThread;
    const RegNr, Count: Integer; var Data: TModCoilData;
    const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte) of object;
  TModBusRegisterReadEvent = procedure(const Sender: TIdPeerThread;
    const RegNr, Count: Integer; var Data: TModRegisterData;
    const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte) of object;
  TModBusCoilWriteEvent = procedure(const Sender: TIdPeerThread;
    const RegNr, Count: Integer; const Data: TModCoilData;
    const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte) of object;
  TModBusRegisterWriteEvent = procedure(const Sender: TIdPeerThread;
    const RegNr, Count: Integer; const Data: TModRegisterData;
    const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte) of object;
  TModBusErrorEvent = procedure(const Sender: TIdPeerThread;
    const FunctionCode: Byte; const ErrorCode: Byte;
    const RequestBuffer: TModBusRequestBuffer) of object;
  TModBusInvalidFunctionEvent = procedure(const Sender: TIdPeerThread;
    const FunctionCode: TModBusFunction;
    const RequestBuffer: TModBusRequestBuffer) of object;
{$ENDIF}

type
{$IFDEF DMB_DELPHIXE3}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64 or
                               pidLinux32 or
  {$IFDEF DMB_DELPHIXE5}
                               pidAndroid or
  {$ENDIF}
  {$IFDEF DMB_DELPHIXE4}
                               pidiOSDevice or pidiOSSimulator or
  {$ENDIF}
                               pidOSX32)]
{$ENDIF}
{$IFDEF DMB_INDY10}
  TIdModBusServer = class(TIdCustomTCPServer)
{$ELSE}
  TIdModBusServer = class(TIdTCPServer)
{$ENDIF}
  private
    FBaseRegister: Word;
    FOneShotConnection: Boolean;
    FLogCriticalSection: TCriticalSection;
    FLogEnabled: Boolean;
    FLogFile: String;
    FLogTimeFormat: String;
    FMaxRegister: Word;
    FMinRegister: Word;
    FOnError: TModBusErrorEvent;
    FOnInvalidFunction: TModBusInvalidFunctionEvent;
    FOnReadCoils: TModBusCoilReadEvent;
    FOnReadHoldingRegisters: TModBusRegisterReadEvent;
    FOnReadInputBits: TModBusCoilReadEvent;
    FOnReadInputRegisters: TModBusRegisterReadEvent;
    FOnWriteCoils: TModBusCoilWriteEvent;
    FOnWriteRegisters: TModBusRegisterWriteEvent;
    FPause: Boolean;
    FUnitID: Byte;
    function GetVersion: String;
    procedure SetVersion(const Value: String);
    function IsLogTimeFormatStored: Boolean;
    procedure LogByteBuffer(const LogType: String; const PeerIP: String; const ByteBuffer: array of Byte; const Size: Integer);
  {$IFDEF DMB_INDY10}
    procedure InternalReadCoils(const AContext: TIdContext; const RegNr, Count: Integer;
      var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
    procedure InternalReadInputBits(const AContext: TIdContext; const RegNr, Count: Integer;
      var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
    procedure InternalWriteCoils(const AContext: TIdContext; const RegNr, Count: Integer;
      const Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
  {$ELSE}
    procedure InternalReadCoils(const Sender: TIdPeerThread; const RegNr, Count: Integer;
      var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
    procedure InternalReadInputBits(const Sender: TIdPeerThread; const RegNr, Count: Integer;
      var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
    procedure InternalWriteCoils(const Sender: TIdPeerThread; const RegNr, Count: Integer;
      const Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
  {$ENDIF}
  protected
  {$IFDEF DMB_INDY10}
    procedure InitComponent; override;
  {$ENDIF}
  {$IFDEF DMB_INDY10}
    procedure DoError(const AContext: TIdContext; const FunctionCode: Byte;
      const ErrorCode: Byte; const RequestBuffer: TModBusRequestBuffer); virtual;
    function DoExecute(AContext: TIdContext): Boolean; override;
    procedure DoInvalidFunction(const AContext: TIdContext;
      const FunctionCode: TModBusFunction; const RequestBuffer: TModBusRequestBuffer); virtual;
    procedure DoReadHoldingRegisters(const AContext: TIdContext; const RegNr, Count: Integer;
      var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual;
    procedure DoReadInputRegisters(const AContext: TIdContext; const RegNr, Count: Integer;
      var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual;
    procedure DoReadCoils(const AContext: TIdContext; const RegNr, Count: Integer;
      var Data: TModCoilData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual;
    procedure DoReadInputBits(const AContext: TIdContext; const RegNr, Count: Integer;
      var Data: TModCoilData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual;
    procedure DoWriteCoils(const AContext: TIdContext; const RegNr, Count: Integer;
      const Data: TModCoilData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual;
    procedure DoWriteRegisters(const AContext: TIdContext; const RegNr, Count: Integer;
      const Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual;
    procedure LogExceptionBuffer(const AContext: TIdContext; const Buffer: TModBusExceptionBuffer);
    procedure LogRequestBuffer(const AContext: TIdContext; const Buffer: TModBusRequestBuffer; const Size: Integer);
    procedure LogResponseBuffer(const AContext: TIdContext; const Buffer: TModBusResponseBuffer; const Size: Integer);
    procedure ReadCommand(const AContext: TIdContext);
    procedure SendError(const AContext: TIdContext; const ErrorCode: Byte;
      const ReceiveBuffer: TModBusRequestBuffer);
    procedure SendResponse(const AContext: TIdContext; const ReceiveBuffer: TModBusRequestBuffer;
      const Data: TModRegisterData);
  {$ELSE}
    procedure DoError(const Sender: TIdPeerThread; const FunctionCode: Byte;
      const ErrorCode: Byte; const RequestBuffer: TModBusRequestBuffer); virtual;
    function DoExecute(AThread: TIdPeerThread): Boolean; override;
    procedure DoInvalidFunction(const Sender: TIdPeerThread; const FunctionCode: TModBusFunction;
      const RequestBuffer: TModBusRequestBuffer); virtual;
    procedure DoReadHoldingRegisters(const Sender: TIdPeerThread; const RegNr, Count: Integer;
      var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual;
    procedure DoReadInputRegisters(const Sender: TIdPeerThread; const RegNr, Count: Integer;
      var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual;
    procedure DoReadCoils(const Sender: TIdPeerThread; const RegNr, Count: Integer;
      var Data: TModCoilData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual;
    procedure DoReadInputBits(const Sender: TIdPeerThread; const RegNr, Count: Integer;
      var Data: TModCoilData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual;
    procedure DoWriteCoils(const Sender: TIdPeerThread; const RegNr, Count: Integer;
      const Data: TModCoilData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual;
    procedure DoWriteRegisters(const Sender: TIdPeerThread; const RegNr, Count: Integer;
      const Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual;
    procedure LogExceptionBuffer(const AThread: TIdPeerThread; const Buffer: TModBusExceptionBuffer);
    procedure LogRequestBuffer(const AThread: TIdPeerThread; const Buffer: TModBusRequestBuffer; const Size: Integer);
    procedure LogResponseBuffer(const AThread: TIdPeerThread; const Buffer: TModBusResponseBuffer; const Size: Integer);
    procedure ReadCommand(const AThread: TIdPeerThread);
    procedure SendError(const AThread: TIdPeerThread; const ErrorCode: Byte;
      const ReceiveBuffer: TModBusRequestBuffer);
    procedure SendResponse(const AThread: TIdPeerThread; const ReceiveBuffer: TModBusRequestBuffer;
      const Data: TModRegisterData);
  {$ENDIF}
  public
  {$IFNDEF DMB_INDY10}
    constructor Create(AOwner: TComponent); override;
  {$ENDIF}
  { public properties }
    property Pause: Boolean read FPause write FPause;
  published
    property BaseRegister: Word read FBaseRegister write FBaseRegister default 1; 
    property DefaultPort default MB_PORT;
    property LogEnabled: Boolean read FLogEnabled write FLogEnabled default False;
    property LogFile: String read FLogFile write FLogFile;
    property LogTimeFormat: String read FLogTimeFormat write FLogTimeFormat stored IsLogTimeFormatStored;
    property OneShotConnection: Boolean read FOneShotConnection write FOneShotConnection default False;
    property MaxRegister: Word read FMaxRegister write FMaxRegister default $FFFF;
    property MinRegister: Word read FMinRegister write FMinRegister default 1;
    property UnitID: Byte read FUnitID write FUnitID default MB_IGNORE_UNITID;
    property Version: String read GetVersion write SetVersion stored False;
  { events }
    property OnError: TModBusErrorEvent read FOnError write FOnError;
    property OnInvalidFunction: TModBusInvalidFunctionEvent read FOnInvalidFunction write FOnInvalidFunction;
    property OnReadCoils: TModBusCoilReadEvent read FOnReadCoils write FOnReadCoils;
    property OnReadHoldingRegisters: TModBusRegisterReadEvent read FOnReadHoldingRegisters write FOnReadHoldingRegisters;
    property OnReadInputBits: TModBusCoilReadEvent read FOnReadInputBits write FOnReadInputBits;
    property OnReadInputRegisters: TModBusRegisterReadEvent read FOnReadInputRegisters write FOnReadInputRegisters;
    property OnWriteCoils: TModBusCoilWriteEvent read FOnWriteCoils write FOnWriteCoils;
    property OnWriteRegisters: TModBusRegisterWriteEvent read FOnWriteRegisters write FOnWriteRegisters;
  end; { TIdModBusServer }


implementation

uses
  Math;

{ TIdModBusServer }

{$IFDEF DMB_INDY10}
procedure TIdModBusServer.InitComponent;
{$ELSE}
constructor TIdModBusServer.Create(AOwner: TComponent);
{$ENDIF}
begin
{$IFDEF DMB_INDY10}
  inherited;
{$ELSE}
  inherited Create(AOwner);
{$ENDIF}
  FBaseRegister := 1;
  DefaultPort := MB_PORT;
  FLogCriticalSection := SyncObjs.TCriticalSection.Create;
  FLogEnabled := False;
  FLogFile := '';
  FLogTimeFormat := DefaultLogTimeFormat;
  FMaxRegister := $FFFF;
  FMinRegister := 1;
  FOneShotConnection := False;
  FOnError := nil;
  FOnInvalidFunction := nil;
  FOnReadCoils := nil;
  FOnReadHoldingRegisters := nil;
  FOnReadInputBits := nil;
  FOnReadInputRegisters := nil;
  FOnWriteCoils := nil;
  FOnWriteRegisters := nil;
  FPause := False;
  FUnitID := MB_IGNORE_UNITID;
end;


procedure TIdModBusServer.LogByteBuffer(const LogType: String;
  const PeerIP: String; const ByteBuffer: array of Byte; const Size: Integer);
var
  F: TextFile;
begin
  if FLogEnabled and (FLogFile <> '') then
  begin
    FLogCriticalSection.Enter;
    try
      AssignFile(F, FLogFile);
      if FileExists(FLogFile) then
        Append(F)
      else
        Rewrite(F);
      try
        WriteLn(F, FormatDateTime(FLogTimeFormat, Now)
                  ,'; ', LogType
                  ,'; ', PeerIP
                  ,'; ', IntToStr(Size)
                  ,'; ', BufferToHex(ByteBuffer));
      finally
        CloseFile(F);
      end;
    finally
      FLogCriticalSection.Leave;
    end;
  end;
end;


{$IFDEF DMB_INDY10}
procedure TIdModBusServer.InternalReadCoils(const AContext: TIdContext;
  const RegNr, Count: Integer; var Data: TModRegisterData;
    const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
{$ELSE}
procedure TIdModBusServer.InternalReadCoils(const Sender: TIdPeerThread;
  const RegNr, Count: Integer; var Data: TModRegisterData;
    const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
{$ENDIF}
var
  CoilData: TModCoilData;
  i: Integer;
begin
  FillChar(CoilData, SizeOf(CoilData), 0);
{$IFDEF DMB_INDY10}
  DoReadCoils(AContext, RegNr, Count, CoilData, RequestBuffer, ErrorCode);
{$ELSE}
  DoReadCoils(Sender, RegNr, Count, CoilData, RequestBuffer, ErrorCode);
{$ENDIF}
  for i := 0 to (Count - 1) do
  begin
    if CoilData[i] then
      Data[i] := 1;
  end;
end;


{$IFDEF DMB_INDY10}
procedure TIdModBusServer.InternalReadInputBits(const AContext: TIdContext;
  const RegNr, Count: Integer; var Data: TModRegisterData;
  const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
{$ELSE}
procedure TIdModBusServer.InternalReadInputBits(const Sender: TIdPeerThread;
  const RegNr, Count: Integer; var Data: TModRegisterData;
  const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
{$ENDIF}
var
  CoilData: TModCoilData;
  i: Integer;
begin
  FillChar(CoilData, SizeOf(CoilData), 0);
{$IFDEF DMB_INDY10}
  DoReadInputBits(AContext, RegNr, Count, CoilData, RequestBuffer, ErrorCode);
{$ELSE}
  DoReadInputBits(Sender, RegNr, Count, CoilData, RequestBuffer, ErrorCode);
{$ENDIF}
  for i := 0 to (Count - 1) do
  begin
    if CoilData[i] then
      Data[i] := 1;
  end;

end;


{$IFDEF DMB_INDY10}
procedure TIdModBusServer.InternalWriteCoils(const AContext: TIdContext;
  const RegNr, Count: Integer; const Data: TModRegisterData;
  const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
{$ELSE}
procedure TIdModBusServer.InternalWriteCoils(const Sender: TIdPeerThread;
  const RegNr, Count: Integer; const Data: TModRegisterData;
  const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
{$ENDIF}
var
  CoilData: TModCoilData;
  i: Integer;
begin
  FillChar(CoilData, SizeOf(CoilData), 0);
  for i := 0 to (Count - 1) do
    CoilData[i] := (Data[i] = 1);
{$IFDEF DMB_INDY10}
  DoWriteCoils(AContext, RegNr, Count, CoilData, RequestBuffer, ErrorCode);
{$ELSE}
  DoWriteCoils(Sender, RegNr, Count, CoilData, RequestBuffer, ErrorCode);
{$ENDIF}
end;


{$IFDEF DMB_INDY10}
procedure TIdModBusServer.LogExceptionBuffer(const AContext: TIdContext;
  const Buffer: TModBusExceptionBuffer);
{$ELSE}
procedure TIdModBusServer.LogExceptionBuffer(const AThread: TIdPeerThread;
  const Buffer: TModBusExceptionBuffer);
{$ENDIF}
var
  PeerIP: String;
  ByteBuffer: array of Byte;
begin
{$IFDEF DMB_INDY10}
  PeerIP := AContext.Connection.Socket.Binding.PeerIP;
{$ELSE}
  PeerIP := AThread.Connection.Socket.Binding.PeerIP;
{$ENDIF}
  SetLength(ByteBuffer, SizeOf(Buffer));
  Move(Buffer, ByteBuffer[0], SizeOf(Buffer));
  LogByteBuffer('excp', PeerIP, ByteBuffer, SizeOf(Buffer));
end;


{$IFDEF DMB_INDY10}
procedure TIdModBusServer.LogRequestBuffer(const AContext: TIdContext;
  const Buffer: TModBusRequestBuffer; const Size: Integer);
{$ELSE}
procedure TIdModBusServer.LogRequestBuffer(const AThread: TIdPeerThread;
  const Buffer: TModBusRequestBuffer; const Size: Integer);
{$ENDIF}
var
  PeerIP: String;
  ByteBuffer: array of Byte;
begin
{$IFDEF DMB_INDY10}
  PeerIP := AContext.Connection.Socket.Binding.PeerIP;
{$ELSE}
  PeerIP := AThread.Connection.Socket.Binding.PeerIP;
{$ENDIF}
  SetLength(ByteBuffer, SizeOf(Buffer));
  Move(Buffer, ByteBuffer[0], SizeOf(Buffer));
  LogByteBuffer('recv', PeerIP, ByteBuffer, Size);
end;


{$IFDEF DMB_INDY10}
procedure TIdModBusServer.LogResponseBuffer(const AContext: TIdContext;
  const Buffer: TModBusResponseBuffer; const Size: Integer);
{$ELSE}
procedure TIdModBusServer.LogResponseBuffer(const AThread: TIdPeerThread;
  const Buffer: TModBusResponseBuffer; const Size: Integer);
{$ENDIF}
var
  PeerIP: String;
  ByteBuffer: array of Byte;
begin
{$IFDEF DMB_INDY10}
  PeerIP := AContext.Connection.Socket.Binding.PeerIP;
{$ELSE}
  PeerIP := AThread.Connection.Socket.Binding.PeerIP;
{$ENDIF}
  SetLength(ByteBuffer, SizeOf(Buffer));
  Move(Buffer, ByteBuffer[0], SizeOf(Buffer));
  LogByteBuffer('sent', PeerIP, ByteBuffer, Size);
end;


{$IFDEF DMB_INDY10}
procedure TIdModBusServer.ReadCommand(const AContext: TIdContext);
{$ELSE}
procedure TIdModBusServer.ReadCommand(const AThread: TIdPeerThread);
{$ENDIF}

  function GetRegNr(const RegNr: Integer): Integer;
  begin
    Result := RegNr;
    if (RegNr < 0) then
      Result := Result   $FFFF
    else if (RegNr > $FFFF) then
      Result := RegNr - ($FFFF   1);
    Result := Result   FBaseRegister;
  end; { GetRegNr }
  
var
  iCount: Integer;
  iRegNr: Integer;
  ErrorCode: Byte;
  ReceiveBuffer: TModBusRequestBuffer;
  Data: TModRegisterData;
{$IFDEF DMB_INDY10}
  Buffer: TIdBytes;
{$ENDIF}
begin
{ Initialize all register data to 0 }
  FillChar(Data[0], SizeOf(Data), 0);
  FillChar(ReceiveBuffer, SizeOf(ReceiveBuffer), 0);
{ Read the data from the peer connection }
{$IFDEF DMB_INDY10}
{ Ensure receiving databuffer is completely empty, and filled with zeros }
  SetLength(Buffer, SizeOf(ReceiveBuffer));
  FillChar(Buffer[0], SizeOf(ReceiveBuffer), 0);
{ Wait max. 250 msecs. for available data }
  AContext.Connection.IOHandler.CheckForDataOnSource(250);
  if not AContext.Connection.IOHandler.InputBufferIsEmpty then
  begin
    AContext.Connection.IOHandler.InputBuffer.ExtractToBytes(Buffer, -1, False, -1);
    iCount := Length(Buffer);
    if (iCount > 0) then
    begin
      Move(Buffer[0], ReceiveBuffer, Min(iCount, SizeOf(ReceiveBuffer)));
      if FLogEnabled then
        LogRequestBuffer(AContext, ReceiveBuffer, iCount);
    end
    else
      Exit;
  end
  else
    Exit;
{$ELSE}
  iCount := AThread.Connection.Socket.Recv(ReceiveBuffer, SizeOf(ReceiveBuffer));
  if (iCount > 0) then
  begin
    if FLogEnabled then
      LogRequestBuffer(AThread, ReceiveBuffer, iCount);
  end
  else
    Exit;
{$ENDIF}
{ Process the data }
  if ((FUnitID <> MB_IGNORE_UNITID) and (ReceiveBuffer.Header.UnitID <> FUnitID)) or
     (ReceiveBuffer.Header.ProtocolID <> MB_PROTOCOL)
  then
  begin
  // When listening for a specific UnitID, only except data for that ID
  {$IFDEF DMB_INDY10}
    SendError(AContext, mbeServerFailure, ReceiveBuffer);
  {$ELSE}
    SendError(AThread, mbeServerFailure, ReceiveBuffer);
  {$ENDIF}
  end
  else if ((Byte(ReceiveBuffer.FunctionCode) and $80) <> 0) then
  begin
    ErrorCode := Integer(ReceiveBuffer.MBPData[0]);
  {$IFDEF DMB_INDY10}
    DoError(AContext, ReceiveBuffer.FunctionCode and not $80, ErrorCode, ReceiveBuffer);
  {$ELSE}
    DoError(AThread, ReceiveBuffer.FunctionCode and not $80, ErrorCode, ReceiveBuffer);
  {$ENDIF}
  end
  else
  begin
    ErrorCode := mbeOk;
    case ReceiveBuffer.FunctionCode of
      mbfReadCoils,
      mbfReadInputBits:
        begin
          iRegNr := GetRegNr(Swap16(Word((@ReceiveBuffer.MBPData[0])^)));
          iCount := Swap16(Word((@ReceiveBuffer.MBPData[2])^));
          if ((iRegNr < FMinRegister) or ((iRegNr   iCount) > FMaxRegister)) then
          {$IFDEF DMB_INDY10}
            SendError(AContext, mbeIllegalRegister, ReceiveBuffer)
          {$ELSE}
            SendError(AThread, mbeIllegalRegister, ReceiveBuffer)
          {$ENDIF}
          else
          begin
          { Signal the user that data is needed }
          {$IFDEF DMB_INDY10}
            if (ReceiveBuffer.FunctionCode = mbfReadCoils) then
              InternalReadCoils(AContext, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode)
            else
              InternalReadInputBits(AContext, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode);
            if (ErrorCode = mbeOk) then
              SendResponse(AContext, ReceiveBuffer, Data)
            else
              SendError(AContext, ErrorCode, ReceiveBuffer);
          {$ELSE}
            if (ReceiveBuffer.FunctionCode = mbfReadCoils) then
              InternalReadCoils(AThread, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode)
            else
              InternalReadInputBits(AThread, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode);
            if (ErrorCode = mbeOk) then
              SendResponse(AThread, ReceiveBuffer, Data)
            else
              SendError(AThread, ErrorCode, ReceiveBuffer);
          {$ENDIF}
          end;
        end;
      mbfReadInputRegs,
      mbfReadHoldingRegs:
        begin
          iRegNr := GetRegNr(Swap16(Word((@ReceiveBuffer.MBPData[0])^)));
          iCount := Swap16(Word((@ReceiveBuffer.MBPData[2])^));
          if ((iRegNr < FMinRegister) or ((iRegNr   iCount) > FMaxRegister)) then
          {$IFDEF DMB_INDY10}
            SendError(AContext, mbeIllegalRegister, ReceiveBuffer)
          {$ELSE}
            SendError(AThread, mbeIllegalRegister, ReceiveBuffer)
          {$ENDIF}
          else
          begin
          { Signal the user that data is needed }
          {$IFDEF DMB_INDY10}
            if (ReceiveBuffer.FunctionCode = mbfReadInputRegs) then
              DoReadInputRegisters(AContext, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode)
            else
              DoReadHoldingRegisters(AContext, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode);
            if (ErrorCode = mbeOk) then
              SendResponse(AContext, ReceiveBuffer, Data)
            else
              SendError(AContext, ErrorCode, ReceiveBuffer);
          {$ELSE}
            if (ReceiveBuffer.FunctionCode = mbfReadInputRegs) then
              DoReadInputRegisters(AThread, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode)
            else
              DoReadHoldingRegisters(AThread, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode);
            if (ErrorCode = mbeOk) then
              SendResponse(AThread, ReceiveBuffer, Data)
            else
              SendError(AThread, ErrorCode, ReceiveBuffer);
          {$ENDIF}
          end;
        end;
      mbfWriteOneCoil,
      mbfWriteOneReg:
        begin
        { Get the register number }
          iRegNr := GetRegNr(Swap16(Word((@ReceiveBuffer.MBPData[0])^)));
        { Get the register value }
          Data[0] := Swap16(Word((@ReceiveBuffer.MBPData[2])^));
        { This function always writes one register }
          iCount := 1;

          if ((iRegNr < FMinRegister) or ((iRegNr   iCount) > FMaxRegister)) then
          {$IFDEF DMB_INDY10}
            SendError(AContext, mbeIllegalRegister, ReceiveBuffer)
          {$ELSE}
            SendError(AThread, mbeIllegalRegister, ReceiveBuffer)
          {$ENDIF}
          else
          begin
          { Send back the response to the master }
          {$IFDEF DMB_INDY10}
            DoWriteRegisters(AContext, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode);
            if (ErrorCode = mbeOk) then
              SendResponse(AContext, ReceiveBuffer, Data)
            else
              SendError(AContext, ErrorCode, ReceiveBuffer);
          {$ELSE}
            DoWriteRegisters(AThread, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode);
            if (ErrorCode = mbeOk) then
              SendResponse(AThread, ReceiveBuffer, Data)
            else
              SendError(AThread, ErrorCode, ReceiveBuffer);
          {$ENDIF}
          end;
        end;
      mbfWriteRegs:
        begin
          iRegNr := GetRegNr(Swap16(Word((@ReceiveBuffer.MBPData[0])^)));
          iCount := Swap16(Word((@ReceiveBuffer.MBPData[2])^));
          if ((iRegNr < FMinRegister) or ((iRegNr   iCount) > FMaxRegister)) then
          {$IFDEF DMB_INDY10}
            SendError(AContext, mbeIllegalRegister, ReceiveBuffer)
          {$ELSE}
            SendError(AThread, mbeIllegalRegister, ReceiveBuffer)
          {$ENDIF}
          else
          begin
          { Decode the contents of the Registers }
            GetRegistersFromBuffer(@ReceiveBuffer.MbpData[5], iCount, Data);
          { Send back the response to the master }
          {$IFDEF DMB_INDY10}
            DoWriteRegisters(AContext, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode);
            if (ErrorCode = mbeOk) then
              SendResponse(AContext, ReceiveBuffer, Data)
            else
              SendError(AContext, ErrorCode, ReceiveBuffer);
          {$ELSE}
            DoWriteRegisters(AThread, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode);
            if (ErrorCode = mbeOk) then
              SendResponse(AThread, ReceiveBuffer, Data)
            else
              SendError(AThread, ErrorCode, ReceiveBuffer);
          {$ENDIF}
          end;
        end;
      mbfWriteCoils:
        begin
          iRegNr := GetRegNr(Swap16(Word((@ReceiveBuffer.MBPData[0])^)));
          iCount := Swap16(Word((@ReceiveBuffer.MBPData[2])^));
          if ((iRegNr < FMinRegister) or ((iRegNr   iCount) > FMaxRegister)) then
          {$IFDEF DMB_INDY10}
            SendError(AContext, mbeIllegalRegister, ReceiveBuffer)
          {$ELSE}
            SendError(AThread, mbeIllegalRegister, ReceiveBuffer)
          {$ENDIF}
          else
          begin
          { Decode the contents of the Registers }
            GetCoilsFromBuffer(@ReceiveBuffer.MbpData[5], iCount, Data);
          { Send back the response to the master }
          {$IFDEF DMB_INDY10}
            InternalWriteCoils(AContext, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode);
            if (ErrorCode = mbeOk) then
              SendResponse(AContext, ReceiveBuffer, Data)
            else
              SendError(AContext, ErrorCode, ReceiveBuffer);
          {$ELSE}
            InternalWriteCoils(AThread, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode);
            if (ErrorCode = mbeOk) then
              SendResponse(AThread, ReceiveBuffer, Data)
            else
              SendError(AThread, ErrorCode, ReceiveBuffer);
          {$ENDIF}
          end;
        end;
    else
      if (ReceiveBuffer.FunctionCode <> 0) then
      begin
      { Illegal or unsupported function code }
      {$IFDEF DMB_INDY10}
        SendError(AContext, mbeIllegalFunction, ReceiveBuffer);
        DoInvalidFunction(AContext, ReceiveBuffer.FunctionCode, ReceiveBuffer);
      {$ELSE}
        SendError(AThread, mbeIllegalFunction, ReceiveBuffer);
        DoInvalidFunction(AThread, ReceiveBuffer.FunctionCode, ReceiveBuffer);
      {$ENDIF}
      end;
    end;
  end;
{ If needed: the server terminates the connection, after the request has been handled }
  if FOneShotConnection then
  {$IFDEF DMB_INDY10}
    AContext.Connection.Disconnect;
  {$ELSE}
    AThread.Connection.Disconnect;
  {$ENDIF}
end;


{$IFDEF DMB_INDY10}
procedure TIdModBusServer.DoError(const AContext: TIdContext;
  const FunctionCode: Byte; const ErrorCode: Byte; const RequestBuffer: TModBusRequestBuffer);
{$ELSE}
procedure TIdModBusServer.DoError(const Sender: TIdPeerThread;
  const FunctionCode: Byte; const ErrorCode: Byte; const RequestBuffer: TModBusRequestBuffer);
{$ENDIF}
begin
  if Assigned(FOnError) then
  {$IFDEF DMB_INDY10}
    FOnError(AContext, FunctionCode, ErrorCode, RequestBuffer);
  {$ELSE}
    FOnError(Sender, FunctionCode, ErrorCode, RequestBuffer);
  {$ENDIF}
end;


{$IFDEF DMB_INDY10}
function TIdModBusServer.DoExecute(AContext: TIdContext): Boolean;
{$ELSE}
function TIdModBusServer.DoExecute(AThread: TIdPeerThread): Boolean;
{$ENDIF}
begin
  Result := False;
  if not FPause then
  begin
  {$IFDEF DMB_INDY10}
    ReadCommand(AContext);
    Result := inherited DoExecute(AContext);
  {$ELSE}
    ReadCommand(AThread);
    Result := inherited DoExecute(AThread);
  {$ENDIF}
  end;
end;


{$IFDEF DMB_INDY10}
procedure TIdModBusServer.DoInvalidFunction(const AContext: TIdContext;
  const FunctionCode: TModBusFunction; const RequestBuffer: TModBusRequestBuffer);
{$ELSE}
procedure TIdModBusServer.DoInvalidFunction(const Sender: TIdPeerThread;
  const FunctionCode: TModBusFunction; const RequestBuffer: TModBusRequestBuffer);
{$ENDIF}
begin
  if Assigned(FOnInvalidFunction) then
  {$IFDEF DMB_INDY10}
    FOnInvalidFunction(AContext, FunctionCode, RequestBuffer);
  {$ELSE}
    FOnInvalidFunction(Sender, FunctionCode, RequestBuffer);
  {$ENDIF}
end;


{$IFDEF DMB_INDY10}
procedure TIdModBusServer.DoReadCoils(const AContext: TIdContext;
  const RegNr, Count: Integer; var Data: TModCoilData;
  const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
{$ELSE}
procedure TIdModBusServer.DoReadCoils(const Sender: TIdPeerThread;
  const RegNr, Count: Integer; var Data: TModCoilData;
  const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
{$ENDIF}
begin
  if Assigned(FOnReadCoils) then
  {$IFDEF DMB_INDY10}
    FOnReadCoils(AContext, RegNr, Count, Data, RequestBuffer, ErrorCode);
  {$ELSE}
    FOnReadCoils(Sender, RegNr, Count, Data, RequestBuffer, ErrorCode);
  {$ENDIF}
end;


{$IFDEF DMB_INDY10}
procedure TIdModBusServer.DoReadInputBits(const AContext: TIdContext;
  const RegNr, Count: Integer; var Data: TModCoilData;
  const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
{$ELSE}
procedure TIdModBusServer.DoReadInputBits(const Sender: TIdPeerThread;
  const RegNr, Count: Integer; var Data: TModCoilData;
  const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
{$ENDIF}
begin
  if Assigned(FOnReadInputBits) then
  {$IFDEF DMB_INDY10}
    FOnReadInputBits(AContext, RegNr, Count, Data, RequestBuffer, ErrorCode);
  {$ELSE}
    FOnReadInputBits(Sender, RegNr, Count, Data, RequestBuffer, ErrorCode);
  {$ENDIF}
end;


{$IFDEF DMB_INDY10}
procedure TIdModBusServer.DoReadHoldingRegisters(const AContext: TIdContext;
  const RegNr, Count: Integer; var Data: TModRegisterData;
  const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
{$ELSE}
procedure TIdModBusServer.DoReadHoldingRegisters(const Sender: TIdPeerThread;
  const RegNr, Count: Integer; var Data: TModRegisterData;
  const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
{$ENDIF}
begin
  if Assigned(FOnReadHoldingRegisters) then
  {$IFDEF DMB_INDY10}
    FOnReadHoldingRegisters(AContext, RegNr, Count, Data, RequestBuffer, ErrorCode);
  {$ELSE}
    FOnReadHoldingRegisters(Sender, RegNr, Count, Data, RequestBuffer, ErrorCode);
  {$ENDIF}
end;


{$IFDEF DMB_INDY10}
procedure TIdModBusServer.DoReadInputRegisters(const AContext: TIdContext;
  const RegNr, Count: Integer; var Data: TModRegisterData;
  const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
{$ELSE}
procedure TIdModBusServer.DoReadInputRegisters(const Sender: TIdPeerThread;
  const RegNr, Count: Integer; var Data: TModRegisterData;
  const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
{$ENDIF}
begin
  if Assigned(FOnReadInputRegisters) then
  {$IFDEF DMB_INDY10}
    FOnReadInputRegisters(AContext, RegNr, Count, Data, RequestBuffer, ErrorCode);
  {$ELSE}
    FOnReadInputRegisters(Sender, RegNr, Count, Data, RequestBuffer, ErrorCode);
  {$ENDIF}
end;


{$IFDEF DMB_INDY10}
procedure TIdModBusServer.DoWriteCoils(const AContext: TIdContext;
  const RegNr, Count: Integer; const Data: TModCoilData;
  const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
{$ELSE}
procedure TIdModBusServer.DoWriteCoils(const Sender: TIdPeerThread;
  const RegNr, Count: Integer; const Data: TModCoilData;
  const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
{$ENDIF}
begin
  if Assigned(FOnWriteCoils) then
  {$IFDEF DMB_INDY10}
    FOnWriteCoils(AContext, RegNr, Count, Data, RequestBuffer, ErrorCode);
  {$ELSE}
    FOnWriteCoils(Sender, RegNr, Count, Data, RequestBuffer, ErrorCode);
  {$ENDIF}
end;


{$IFDEF DMB_INDY10}
procedure TIdModBusServer.DoWriteRegisters(const AContext: TIdContext;
  const RegNr, Count: Integer; const Data: TModRegisterData;
  const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
{$ELSE}
procedure TIdModBusServer.DoWriteRegisters(const Sender: TIdPeerThread;
const RegNr, Count: Integer; const Data: TModRegisterData;
const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte);
{$ENDIF}
begin
  if Assigned(FOnWriteRegisters) then
  {$IFDEF DMB_INDY10}
    FOnWriteRegisters(AContext, RegNr, Count, Data, RequestBuffer, ErrorCode);
  {$ELSE}
    FOnWriteRegisters(Sender, RegNr, Count, Data, RequestBuffer, ErrorCode);
  {$ENDIF}
end;


{$IFDEF DMB_INDY10}
procedure TIdModBusServer.SendError(const AContext: TIdContext;
  const ErrorCode: Byte; const ReceiveBuffer: TModBusRequestBuffer);
{$ELSE}
procedure TIdModBusServer.SendError(const AThread: TIdPeerThread;
  const ErrorCode: Byte; const ReceiveBuffer: TModBusRequestBuffer);
{$ENDIF}
var
  SendBuffer: TModBusExceptionBuffer;
{$IFDEF DMB_INDY10}
  Buffer: TIdBytes;
{$ENDIF}
begin
  if Active then
  begin
    SendBuffer.Header := ReceiveBuffer.Header;
    SendBuffer.ExceptionFunction := ReceiveBuffer.FunctionCode or $80;
    SendBuffer.ExceptionCode := ErrorCode;
    SendBuffer.Header.RecLength := Swap16(3);

  {$IFDEF DMB_INDY10}
    Buffer := RawToBytes(SendBuffer, SizeOf(SendBuffer));
    AContext.Connection.Socket.WriteDirect(Buffer);
    if FLogEnabled then
      LogExceptionBuffer(AContext, SendBuffer);
  {$ELSE}
    AThread.Connection.Socket.Send(SendBuffer, SizeOf(SendBuffer));
    if FLogEnabled then
      LogExceptionBuffer(AThread, SendBuffer);
  {$ENDIF}
  end;
end;


{$IFDEF DMB_INDY10}
procedure TIdModBusServer.SendResponse(const AContext: TIdContext;
  const ReceiveBuffer: TModBusRequestBuffer; const Data: TModRegisterData);
{$ELSE}
procedure TIdModBusServer.SendResponse(const AThread: TIdPeerThread;
  const ReceiveBuffer: TModBusRequestBuffer; const Data: TModRegisterData);
{$ENDIF}
var
  SendBuffer: TModBusResponseBuffer;
  L: Integer;
{$IFDEF DMB_INDY10}
  Buffer: TIdBytes;
{$ENDIF}
begin
  if Active then
  begin
    FillChar(SendBuffer, SizeOf(SendBuffer), 0);
    SendBuffer.Header.TransactionID := ReceiveBuffer.Header.TransactionID;
    SendBuffer.Header.ProtocolID := ReceiveBuffer.Header.ProtocolID;
    SendBuffer.Header.UnitID := ReceiveBuffer.Header.UnitID;
    SendBuffer.FunctionCode := ReceiveBuffer.FunctionCode;
    SendBuffer.Header.RecLength := Swap16(0);

    case ReceiveBuffer.FunctionCode of
      mbfReadCoils,
      mbfReadInputBits:
        begin
          L := Swap16(Word((@ReceiveBuffer.MBPData[2])^));
          if (L <= MaxBlockLength) then
          begin
            SendBuffer.MBPData[0] := Byte(L shl 1);
            PutCoilsIntoBuffer(@SendBuffer.MBPData[1], L, Data);
            SendBuffer.Header.RecLength := Swap16(3   SendBuffer.MBPData[0]);
          end;
        end;
      mbfReadInputRegs,
      mbfReadHoldingRegs:
        begin
          L := Swap16(Word((@ReceiveBuffer.MBPData[2])^));
          if (L <= MaxBlockLength) then
          begin
            SendBuffer.MBPData[0] := Byte(L shl 1);
            PutRegistersIntoBuffer(@SendBuffer.MBPData[1], L, Data);
            SendBuffer.Header.RecLength := Swap16(3   SendBuffer.MBPData[0]);
          end;
        end;
    else
      begin
        SendBuffer.MBPData[0] := ReceiveBuffer.MBPData[0];
        SendBuffer.MBPData[1] := ReceiveBuffer.MBPData[1];
        SendBuffer.MBPData[2] := ReceiveBuffer.MBPData[2];
        SendBuffer.MBPData[3] := ReceiveBuffer.MBPData[3];
        SendBuffer.Header.RecLength := Swap16(6);
      end;
    end;
  {$IFDEF DMB_INDY10}
    Buffer := RawToBytes(SendBuffer, Swap16(SendBuffer.Header.RecLength)   6);
    AContext.Connection.Socket.WriteDirect(Buffer);
    if FLogEnabled then
      LogResponseBuffer(AContext, SendBuffer, Swap16(SendBuffer.Header.RecLength)   6);
  {$ELSE}
    AThread.Connection.Socket.Send(SendBuffer, Swap16(SendBuffer.Header.RecLength)   6);
    if FLogEnabled then
      LogResponseBuffer(AThread, SendBuffer, Swap16(SendBuffer.Header.RecLength)   6);
  {$ENDIF}
  end;
end;


function TIdModBusServer.GetVersion: String;
begin
  Result := DMB_VERSION;
end;


function TIdModBusServer.IsLogTimeFormatStored: Boolean;
begin
  Result := (FLogTimeFormat <> DefaultLogTimeFormat);
end;


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


end.

评论

发表评论必须先登陆, 您可以 登陆 或者 注册新账号 !


在线咨询: 问题反馈
客服QQ:174666394

有问题请留言,看到后及时答复