【Delphi】modbus-TCP 协议库

        在日常开发中，也会遇到使用modbus的部件，比如温度控制器、读卡器等等，那么使用Delphi开发，也就必须遵守modbus-TCP协议，如果自己使用TCP控件写也没有问题，不过如果有开源的三方库，别人已经调试过了，就不必要自己也造车轮了！

Delphi ModbusTCP components 下载地址

截至 2024-12-02 最新版本为：1.7.3 支持到 Delphi 12 版本。

如果上述连接无法下载，请在这里下载。

源代码如下：

一、ModbusConsts.pas

{$I ModBusCompiler.inc}

unit ModbusConsts;

interface

const
  MB_PORT = 502;
  MB_IGNORE_UNITID = 255;
  MB_PROTOCOL = 0;

// Define constants for the ModBus functions
const
  mbfReadCoils = $01;
  mbfReadInputBits = $02;
  mbfReadHoldingRegs = $03;
  mbfReadInputRegs = $04;
  mbfWriteOneCoil = $05;
  mbfWriteOneReg = $06;
  mbfWriteCoils = $0F;
  mbfWriteRegs = $10;   
  mbfReportSlaveID = $11;
  mbfReadFileRecord = $14;
  mbfWriteFileRecord = $15;
  mbfMaskWriteReg = $16;
  mbfReadWriteRegs = $17;
  mbfReadFiFoQueue = $18;

// Define constants for the ModBus exceptions
const
  mbeOk = $00;
  mbeIllegalFunction = $01;
  mbeIllegalRegister = $02;
  mbeIllegalDataValue = $03;
  mbeServerFailure = $04;
  mbeAcknowledge = $05;
  mbeServerBusy = $06;
  mbeGatewayPathNotAvailable = $0A;
  mbeGatewayNoResponseFromTarget = $0B;

const
  MaxBlockLength = 125;
  MaxCoils = 2000;

const
  DMB_VERSION = '1.7.3'; {Do not Localize}
  
const
  DefaultLogTimeFormat = 'yyyy-mm-dd hh:nn:ss.zzz';  {Do not Localize}
  
implementation

end.

二、ModbusTypes.pas

{$I ModBusCompiler.inc}

unit ModbusTypes;

interface

type
  TModBusFunction = Byte;

type
  TModBusDataBuffer = array[0..260] of Byte;

type
  TModBusHeader = packed record
    TransactionID: Word;
    ProtocolID: Word;
    RecLength: Word;
    UnitID: Byte;
  end;

type
  TModBusRequestBuffer = packed record
    Header: TModBusHeader;
    FunctionCode: TModBusFunction;
    MBPData: TModBusDataBuffer;
  end;

type
  TModBusResponseBuffer = packed record
    Header: TModBusHeader;
    FunctionCode: TModBusFunction;
    MBPData: TModBusDataBuffer;
  end;

type
  TModBusExceptionBuffer = packed record
    Header: TModBusHeader;
    ExceptionFunction: TModBusFunction;
    ExceptionCode: Byte;
  end;


implementation

end.

三、ModbusUtils.pas

{$I ModBusCompiler.inc}

unit ModbusUtils;

interface

function BufferToHex(const Buffer: array of Byte): String;
function CalculateCRC16(const Buffer: array of Byte): Word;
function CalculateLRC(const Buffer: array of Byte): Byte;

function Swap16(const DataToSwap: Word): Word;

procedure GetCoilsFromBuffer(const Buffer: PByte; const Count: Word; var Data: array of Word);
procedure PutCoilsIntoBuffer(const Buffer: PByte; const Count: Word; const Data: array of Word);

procedure GetReportFromBuffer(const Buffer: PByte; const Count: Word; var Data: array of Word);

procedure GetRegistersFromBuffer(const Buffer: PWord; const Count: Word; var Data: array of Word);
procedure PutRegistersIntoBuffer(const Buffer: PWord; const Count: Word; const Data: array of Word);

implementation

uses
  SysUtils;

const
  CRC16Table: array[0..255] of Word = (
    $0000, $C0C1, $C181, $0140, $C301, $03C0, $0280, $C241,
    $C601, $06C0, $0780, $C741, $0500, $C5C1, $C481, $0440,
    $CC01, $0CC0, $0D80, $CD41, $0F00, $CFC1, $CE81, $0E40,
    $0A00, $CAC1, $CB81, $0B40, $C901, $09C0, $0880, $C841,
    $D801, $18C0, $1980, $D941, $1B00, $DBC1, $DA81, $1A40,
    $1E00, $DEC1, $DF81, $1F40, $DD01, $1DC0, $1C80, $DC41,
    $1400, $D4C1, $D581, $1540, $D701, $17C0, $1680, $D641,
    $D201, $12C0, $1380, $D341, $1100, $D1C1, $D081, $1040,
    $F001, $30C0, $3180, $F141, $3300, $F3C1, $F281, $3240,
    $3600, $F6C1, $F781, $3740, $F501, $35C0, $3480, $F441,
    $3C00, $FCC1, $FD81, $3D40, $FF01, $3FC0, $3E80, $FE41,
    $FA01, $3AC0, $3B80, $FB41, $3900, $F9C1, $F881, $3840,
    $2800, $E8C1, $E981, $2940, $EB01, $2BC0, $2A80, $EA41,
    $EE01, $2EC0, $2F80, $EF41, $2D00, $EDC1, $EC81, $2C40,
    $E401, $24C0, $2580, $E541, $2700, $E7C1, $E681, $2640,
    $2200, $E2C1, $E381, $2340, $E101, $21C0, $2080, $E041,
    $A001, $60C0, $6180, $A141, $6300, $A3C1, $A281, $6240,
    $6600, $A6C1, $A781, $6740, $A501, $65C0, $6480, $A441,
    $6C00, $ACC1, $AD81, $6D40, $AF01, $6FC0, $6E80, $AE41,
    $AA01, $6AC0, $6B80, $AB41, $6900, $A9C1, $A881, $6840,
    $7800, $B8C1, $B981, $7940, $BB01, $7BC0, $7A80, $BA41,
    $BE01, $7EC0, $7F80, $BF41, $7D00, $BDC1, $BC81, $7C40,
    $B401, $74C0, $7580, $B541, $7700, $B7C1, $B681, $7640,
    $7200, $B2C1, $B381, $7340, $B101, $71C0, $7080, $B041,
    $5000, $90C1, $9181, $5140, $9301, $53C0, $5280, $9241,
    $9601, $56C0, $5780, $9741, $5500, $95C1, $9481, $5440,
    $9C01, $5CC0, $5D80, $9D41, $5F00, $9FC1, $9E81, $5E40,
    $5A00, $9AC1, $9B81, $5B40, $9901, $59C0, $5880, $9841,
    $8801, $48C0, $4980, $8941, $4B00, $8BC1, $8A81, $4A40,
    $4E00, $8EC1, $8F81, $4F40, $8D01, $4DC0, $4C80, $8C41,
    $4400, $84C1, $8581, $4540, $8701, $47C0, $4680, $8641,
    $8201, $42C0, $4380, $8341, $4100, $81C1, $8081, $4040
  );


function BufferToHex(const Buffer: array of Byte): String;
var
  i: Integer;
begin
  Result := '';
  for i := Low(Buffer) to High(Buffer) do
    Result := Result + IntToHex(Buffer[i], 2);
end;


function CalculateCRC16(const Buffer: array of Byte): Word;
var
  i: Integer;
  bTemp: Byte;
begin
  Result := 0;
  for i := Low(Buffer) to High(Buffer) do
  begin
    bTemp := Buffer[i] xor Result;
    Result := Result shr 8;
    Result := Result xor CRC16Table[bTemp];
  end;
end;


function CalculateLRC(const Buffer: array of Byte): Byte;
var
  i: Integer;
  CheckSum: Word;
begin
  CheckSum := 0;
  for i := Low(Buffer) to High(Buffer) do
    CheckSum := WordRec(CheckSum).Lo + Buffer[i];
  Result := - WordRec(CheckSum).Lo;
end;


function Swap16(const DataToSwap: Word): Word;
begin
  Result := (DataToSwap div 256) + ((DataToSwap mod 256) * 256);
end;


procedure GetCoilsFromBuffer(const Buffer: PByte; const Count: Word; var Data: array of Word);
var
  BytePtr: PByte;
  BitMask: Byte;
  i: Integer;
begin
  if (Length(Data) < ((Count div 16) - 1)) or (Length(Data) = 0) or (Count = 0) then
    raise Exception.Create('GetCoilsFromBuffer: Data array length cannot be less then Count');

  BytePtr := Buffer;
  BitMask := 1;

  for i := 0 to (Count - 1) do
  begin
    if (i < Length(Data)) then
    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;
end;


procedure PutCoilsIntoBuffer(const Buffer: PByte; const Count: Word; const Data: array of Word);
var
  BytePtr: PByte;
  BitMask: Byte;
  i: Word;
begin
  if (Length(Data) < ((Count div 16) - 1)) or (Length(Data) = 0) or (Count = 0) then
    raise Exception.Create('PutCoilsIntoBuffer: Data array length cannot be less then Count');

  BytePtr := Buffer;
  BitMask := 1;
  for i := 0 to (Count - 1) do
  begin
    if (i < Length(Data)) then
    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;
  end;
end;


procedure GetRegistersFromBuffer(const Buffer: PWord; const Count: Word; var Data: array of Word);
var
  WordPtr: PWord;
  i: Word;
begin
  if (Length(Data) < (Count - 1)) or (Length(Data) = 0) or (Count = 0) then
    raise Exception.Create('GetRegistersFromBuffer: Data array length cannot be less then Count');

  WordPtr := Buffer;
  for i := 0 to (Count - 1) do
  begin
    Data[i] := Swap16(WordPtr^);
    Inc(WordPtr);
  end;
end;

procedure GetReportFromBuffer(const Buffer: PByte; const Count: Word; var Data: array of Word);
var
  WordPtr: PByte;
  i: Word;
begin
  if (Length(Data) < (Count - 1)) or (Length(Data) = 0) or (Count = 0) then
    raise Exception.Create('GetRegistersFromBuffer: Data array length cannot be less then Count');

  WordPtr := Buffer;
  i:= 0;
  for i:= 0 to (Count - 1) do
  begin
    Data[i] := Lo(WordPtr^);
    Inc(WordPtr);
  end;
end;

procedure PutRegistersIntoBuffer(const Buffer: PWord; const Count: Word; const Data: array of Word);
var
  WordPtr: PWord;
  i: Word;
begin
  if (Length(Data) < (Count - 1)) or (Length(Data) = 0) or (Count = 0) then
    raise Exception.Create('PutRegistersIntoBuffer: Data array length cannot be less then Count');

  WordPtr := Buffer;
  for i := 0 to (Count - 1) do
  begin
    WordPtr^ := Swap16(Data[i]);
    Inc(WordPtr);
  end;
end;


end.

四、IdModBusClient.pas

{$I ModBusCompiler.inc}

unit IdModBusClient;

interface

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

type
  TModBusClientErrorEvent = procedure(const FunctionCode: Byte;
    const ErrorCode: Byte; const ResponseBuffer: TModBusResponseBuffer) of object;
  TModBusClientResponseMismatchEvent = procedure(const RequestFunctionCode: Byte;
    const ResponseFunctionCode: Byte; const ResponseBuffer: TModBusResponseBuffer) of object;

type
{$I ModBusPlatforms.inc}
  TIdModBusClient = class(TIdTCPClient)
  private
    FAutoConnect: Boolean;
    FBaseRegister: Word;
  {$IFNDEF DMB_INDY10}
    FConnectTimeOut: Integer;
  {$ENDIF}
    FOnResponseError: TModbusClientErrorEvent;
    FOnResponseMismatch: TModBusClientResponseMismatchEvent;
    FLastTransactionID: Word;
    FReadTimeout: Integer;
    FTimeOut: Cardinal;
    FUnitID: Byte;
    function GetVersion: String;
    procedure SetVersion(const Value: String);
    function GetNewTransactionID: Word;
  protected
    procedure DoResponseError(const FunctionCode: Byte; const ErrorCode: Byte;
      const ResponseBuffer: TModBusResponseBuffer);
    procedure DoResponseMismatch(const RequestFunctionCode: Byte; const ResponseFunctionCode: Byte;
      const ResponseBuffer: TModBusResponseBuffer);
  {$IFDEF DMB_INDY10}
    procedure InitComponent; override;
  {$ENDIF}
    function SendCommand(const AModBusFunction: TModBusFunction; const ARegNumber: Word;
      const ABlockLength: Word; var Data: array of Word): Boolean;
  public
    property LastTransactionID: Word read FLastTransactionID;
  {$IFNDEF DMB_INDY10}
    constructor Create(AOwner: TComponent); override;
  {$ENDIF}
  { public methods }
  {$IFDEF DMB_INDY10}
    procedure Connect; override;
  {$ELSE}
    procedure Connect(const ATimeout: Integer = IdTimeoutDefault); override;
  {$ENDIF}
    function ReadCoil(const RegNo: Word; out Value: Boolean): Boolean;
    function ReadCoils(const RegNo: Word; const Blocks: Word; out RegisterData: array of Boolean): Boolean;
    function ReadDouble(const RegNo: Word; out Value: Double): Boolean;
    function ReadDWord(const RegNo: Word; out Value: DWord): Boolean;
    function ReadHoldingRegister(const RegNo: Word; out Value: Word): Boolean;
    function ReadHoldingRegisters(const RegNo: Word; const Blocks: Word; out RegisterData: array of Word): Boolean;
    function ReadInputBits(const RegNo: Word; const Blocks: Word; out RegisterData: array of Boolean): Boolean;
    function ReadInputRegister(const RegNo: Word; out Value: Word): Boolean;
    function ReadInputRegisters(const RegNo: Word; const Blocks: Word; var RegisterData: array of Word): Boolean;
    function ReadSingle(const RegNo: Word; out Value: Single): Boolean;
    function ReadString(const RegNo: Word; const ALength: Word): String;
    function ReportSlaveID(const Blocks: Word; out RegisterData: array of Word):boolean;
    function WriteCoil(const RegNo: Word; const Value: Boolean): Boolean;
    function WriteCoils(const RegNo: Word; const Blocks: Word; const RegisterData: array of Boolean): Boolean;
    function WriteRegister(const RegNo: Word; const Value: Word): Boolean;
    function WriteRegisters(const RegNo: Word; const RegisterData: array of Word): Boolean;
    function WriteDouble(const RegNo: Word; const Value: Double): Boolean;
    function WriteDWord(const RegNo: Word; const Value: DWord): Boolean;
    function WriteSingle(const RegNo: Word; const Value: Single): Boolean;
    function WriteString(const RegNo: Word; const Text: String): Boolean;
  published
    property AutoConnect: Boolean read FAutoConnect write FAutoConnect default True;
    property BaseRegister: Word read FBaseRegister write FBaseRegister default 1; 
  {$IFNDEF DMB_INDY10}
    property ConnectTimeOut: Integer read FConnectTimeOut write FConnectTimeOut default -1;
  {$ENDIF}
    property ReadTimeout: Integer read FReadTimeout write FReadTimeout default 0;
    property Port default MB_PORT;
    property TimeOut: Cardinal read FTimeOut write FTimeout default 15000;
    property UnitID: Byte read FUnitID write FUnitID default MB_IGNORE_UNITID;
    property Version: String read GetVersion write SetVersion stored False;
  { events }
    property OnResponseError: TModbusClientErrorEvent read FOnResponseError write FOnResponseError;
    property OnResponseMismatch: TModBusClientResponseMismatchEvent read FOnResponseMismatch write FOnResponseMismatch;
  end;


implementation

uses
  ModbusUtils;


{ TIdModBusClient }

{$IFDEF DMB_INDY10}
procedure TIdModBusClient.Connect;
{$ELSE}
procedure TIdModBusClient.Connect(const ATimeout: Integer = IdTimeoutDefault);
{$ENDIF}
begin
  inherited;
  FLastTransactionID := 0;
end;


{$IFDEF DMB_INDY10}
procedure TIdModBusClient.InitComponent;
{$ELSE}
constructor TIdModBusClient.Create(AOwner: TComponent);
{$ENDIF}
begin
{$IFDEF DMB_INDY10}
  inherited;
{$ELSE}
  inherited Create(AOwner);
  FConnectTimeOut := -1;
{$ENDIF}
  FAutoConnect := True;
  FBaseRegister := 1;
  FLastTransactionID := 0;
  FReadTimeout := 0;
  FUnitID := MB_IGNORE_UNITID;
  FTimeOut := 15000;
  Port := MB_PORT;
  FOnResponseError := nil;
  FOnResponseMismatch := nil;
end;


procedure TIdModBusClient.DoResponseError(const FunctionCode: Byte; const ErrorCode: Byte;
  const ResponseBuffer: TModBusResponseBuffer);
begin
  if Assigned(FOnResponseError) then
    FOnResponseError(FunctionCode, ErrorCode, ResponseBuffer);
end;


procedure TIdModBusClient.DoResponseMismatch(const RequestFunctionCode: Byte;
  const ResponseFunctionCode: Byte; const ResponseBuffer: TModBusResponseBuffer);
begin
  if Assigned(FOnResponseMismatch) then
    FOnResponseMismatch(RequestFunctionCode, ResponseFunctionCode, ResponseBuffer);
end;


function TIdModBusClient.SendCommand(const AModBusFunction: TModBusFunction;
  const ARegNumber: Word; const ABlockLength: Word; var Data: array of Word): Boolean;
var
  SendBuffer: TModBusRequestBuffer;
  ReceiveBuffer: TModBusResponseBuffer;
  BlockLength: Word;
  RegNumber: Word;
  dtTimeOut: TDateTime;
{$IFDEF DMB_INDY10}
  Buffer: TIdBytes;
  RecBuffer: TIdBytes;
  iSize: Integer;
{$ENDIF}
begin
{$IFDEF DMB_INDY10}
  CheckForGracefulDisconnect(True);
{$ELSE}
  CheckForDisconnect(True, True);
{$ENDIF}
  SendBuffer.Header.TransactionID := GetNewTransactionID;
  SendBuffer.Header.ProtocolID := MB_PROTOCOL;
{ Initialise data related variables }
  RegNumber := ARegNumber - FBaseRegister;
{ Perform function code specific operations }
  case AModBusFunction of
    mbfReadCoils,
    mbfReadInputBits:
      begin
        BlockLength := ABlockLength;
      { Don't exceed max length }
        if (BlockLength > 2000) then
          BlockLength := 2000;
      { Initialise the data part }
        SendBuffer.FunctionCode := Byte(AModBusFunction); { Write appropriate function code }
        SendBuffer.Header.UnitID := FUnitID;
        SendBuffer.MBPData[0] := Hi(RegNumber);
        SendBuffer.MBPData[1] := Lo(RegNumber);
        SendBuffer.MBPData[2] := Hi(BlockLength);
        SendBuffer.MBPData[3] := Lo(BlockLength);
        SendBuffer.Header.RecLength := Swap16(6); { This includes UnitID/FuntionCode }
      end;
    mbfReadHoldingRegs,
    mbfReadInputRegs:
      begin
        BlockLength := ABlockLength;
        if (BlockLength > 125) then
          BlockLength := 125; { Don't exceed max length }
      { Initialise the data part }
        SendBuffer.FunctionCode := Byte(AModBusFunction); { Write appropriate function code }
        SendBuffer.Header.UnitID := FUnitID;
        SendBuffer.MBPData[0] := Hi(RegNumber);
        SendBuffer.MBPData[1] := Lo(RegNumber);
        SendBuffer.MBPData[2] := Hi(BlockLength);
        SendBuffer.MBPData[3] := Lo(BlockLength);
        SendBuffer.Header.RecLength := Swap16(6); { This includes UnitID/FuntionCode }
      end;
    mbfReportSlaveID:
      begin
        BlockLength := ABlockLength;
        if (BlockLength > 125) then
          BlockLength := 125; { Don't exceed max length }
      { Initialise the data part }
        SendBuffer.FunctionCode := Byte(AModBusFunction); { Write appropriate function code }
        SendBuffer.Header.UnitID := FUnitID;
        SendBuffer.Header.RecLength := Swap16(2); { This includes UnitID/FuntionCode }
      end;
    mbfWriteOneCoil:
      begin
      { Initialise the data part }
        SendBuffer.FunctionCode := Byte(AModBusFunction); { Write appropriate function code }
        SendBuffer.Header.UnitID := FUnitID;
        SendBuffer.MBPData[0] := Hi(RegNumber);
        SendBuffer.MBPData[1] := Lo(RegNumber);
        if (Data[0] <> 0) then
          SendBuffer.MBPData[2] := 255
        else
          SendBuffer.MBPData[2] := 0;
        SendBuffer.MBPData[3] := 0;
        SendBuffer.Header.RecLength := Swap16(6); { This includes UnitID/FuntionCode }
      end;
    mbfWriteOneReg:
      begin
      { Initialise the data part }
        SendBuffer.FunctionCode := Byte(AModBusFunction); { Write appropriate function code }
        SendBuffer.Header.UnitID := FUnitID;
        SendBuffer.MBPData[0] := Hi(RegNumber);
        SendBuffer.MBPData[1] := Lo(RegNumber);
        SendBuffer.MBPData[2] := Hi(Data[0]);
        SendBuffer.MBPData[3] := Lo(Data[0]);
        SendBuffer.Header.RecLength := Swap16(6); { This includes UnitID/FuntionCode }
      end;
    mbfWriteCoils:
      begin
        BlockLength := ABlockLength;
      { Don't exceed max length }
        if (BlockLength > 1968) then
          BlockLength := 1968;
      { Initialise the data part }
        SendBuffer.FunctionCode := Byte(AModBusFunction); { Write appropriate function code }
        SendBuffer.Header.UnitID := FUnitID;
        SendBuffer.MBPData[0] := Hi(RegNumber);
        SendBuffer.MBPData[1] := Lo(RegNumber);
        SendBuffer.MBPData[2] := Hi(BlockLength);
        SendBuffer.MBPData[3] := Lo(BlockLength);
        SendBuffer.MBPData[4] := Byte((BlockLength + 7) div 8);
        PutCoilsIntoBuffer(@SendBuffer.MBPData[5], BlockLength, Data);
        SendBuffer.Header.RecLength := Swap16(7 + SendBuffer.MBPData[4]);
      end;
    mbfWriteRegs:
      begin
        BlockLength := ABlockLength;
      { Don't exceed max length }
        if (BlockLength > 120) then
          BlockLength := 120;
      { Initialise the data part }
        SendBuffer.FunctionCode := Byte(AModBusFunction); { Write appropriate function code }
        SendBuffer.Header.UnitID := FUnitID;
        SendBuffer.MBPData[0] := Hi(RegNumber);
        SendBuffer.MBPData[1] := Lo(RegNumber);
        SendBuffer.MBPData[2] := Hi(BlockLength);
        SendBuffer.MBPData[3] := Lo(BlockLength);
        SendBuffer.MbpData[4] := Byte(BlockLength shl 1);
        PutRegistersIntoBuffer(@SendBuffer.MBPData[5], BlockLength, Data);
        SendBuffer.Header.RecLength := Swap16(7 + SendBuffer.MbpData[4]);
      end;
  end;
{ Writeout the data to the connection }
{$IFDEF DMB_INDY10}
  Buffer := RawToBytes(SendBuffer, Swap16(SendBuffer.Header.RecLength) + 6);
  IOHandler.WriteDirect(Buffer);
{$ELSE}
  WriteBuffer(SendBuffer, Swap16(SendBuffer.Header.RecLength) + 6);
{$ENDIF}

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

  Result := True;
{$IFDEF DMB_INDY10}
  iSize := IOHandler.InputBuffer.Size;
  IOHandler.ReadBytes(RecBuffer, iSize);
  Move(RecBuffer[0], ReceiveBuffer, iSize);
{$ELSE}
  ReadBuffer(ReceiveBuffer, InputBuffer.Size);
{$ENDIF}
{ Check if the result has the same function code as the request }
  if (AModBusFunction = ReceiveBuffer.FunctionCode) then
  begin
    case AModBusFunction of
      mbfReadCoils,
      mbfReadInputBits:
        begin
          BlockLength := ReceiveBuffer.MBPData[0] * 8;
          if (BlockLength > 2000) then
            BlockLength := 2000;
          GetCoilsFromBuffer(@ReceiveBuffer.MBPData[1], BlockLength, Data);
        end;
      mbfReportSlaveID:
        begin
          BlockLength := Swap16(ReceiveBuffer.Header.RecLength) - 2;
          GetReportFromBuffer(@ReceiveBuffer.MBPData[0], BlockLength, Data);
        end;
      mbfReadHoldingRegs,
      mbfReadInputRegs:
        begin
          BlockLength := (ReceiveBuffer.MBPData[0] shr 1);
          if (BlockLength > 125) then
            BlockLength := 125;
          GetRegistersFromBuffer(@ReceiveBuffer.MBPData[1], BlockLength, Data);
        end;
    end;
  end
  else
  begin
    if ((AModBusFunction or $80) = ReceiveBuffer.FunctionCode) then
      DoResponseError(AModBusFunction, ReceiveBuffer.MBPData[0], ReceiveBuffer)
    else
      DoResponseMismatch(AModBusFunction, ReceiveBuffer.FunctionCode, ReceiveBuffer);
    Result := False;
  end;
end;


function TIdModBusClient.GetNewTransactionID: Word;
begin
  if (FLastTransactionID = $FFFF) then
    FLastTransactionID := 0
  else
    Inc(FLastTransactionID);
  Result := FLastTransactionID;
end;


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


function TIdModBusClient.ReadHoldingRegisters(const RegNo, Blocks: Word;
  out RegisterData: array of Word): Boolean;
var
  i: Integer;
  Data: array of Word;
  bNewConnection: Boolean;
begin
  bNewConnection := False;
  if FAutoConnect and not Connected then
  begin
  {$IFDEF DMB_INDY10}
    Connect;
  {$ELSE}
    Connect(FConnectTimeOut);
  {$ENDIF}
    bNewConnection := True;
  end;

  try
    SetLength(Data, Blocks);
    FillChar(Data[0], Length(Data), 0);
    Result := SendCommand(mbfReadHoldingRegs, RegNo, Blocks, Data);
    for i := Low(Data) to High(Data) do
      RegisterData[i] := Data[i];
  finally
    if bNewConnection then
      DisConnect;
  end;
end;


function TIdModBusClient.ReadInputBits(const RegNo, Blocks: Word;
  out RegisterData: array of Boolean): Boolean;
var
  i: Integer;
  Data: array of Word;
  bNewConnection: Boolean;
begin
  bNewConnection := False;
  if FAutoConnect and not Connected then
  begin
  {$IFDEF DMB_INDY10}
    Connect;
  {$ELSE}
    Connect(FConnectTimeOut);
  {$ENDIF}
    bNewConnection := True;
  end;

  SetLength(Data, Blocks);
  FillChar(Data[0], Length(Data), 0);
  try
    Result := SendCommand(mbfReadInputBits, RegNo, Blocks, Data);
    for i := 0 to (Blocks - 1) do
      RegisterData[i] := (Data[i] = 1);
  finally
    if bNewConnection then
      DisConnect;
  end;
end;

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


function TIdModBusClient.ReadInputRegisters(const RegNo, Blocks: Word;
  var RegisterData: array of Word): Boolean;
var
  bNewConnection: Boolean;
begin
  bNewConnection := False;
  if FAutoConnect and not Connected then
  begin
  {$IFDEF DMB_INDY10}
    Connect;
  {$ELSE}
    Connect(FConnectTimeOut);
  {$ENDIF}
    bNewConnection := True;
  end;

  FillChar(RegisterData[0], Length(RegisterData), 0);
  try
    Result := SendCommand(mbfReadInputRegs, RegNo, Blocks, RegisterData);
  finally
    if bNewConnection then
      DisConnect;
  end;
end;


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


function TIdModBusClient.ReadCoils(const RegNo, Blocks: Word; out RegisterData: array of Boolean): Boolean;
var
  i: Integer;
  Data: array of Word;
  bNewConnection: Boolean;
begin
  bNewConnection := False;
  if FAutoConnect and not Connected then
  begin
  {$IFDEF DMB_INDY10}
    Connect;
  {$ELSE}
    Connect(FConnectTimeOut);
  {$ENDIF}
    bNewConnection := True;
  end;

  SetLength(Data, Blocks);
  FillChar(Data[0], Length(Data), 0);
  try
    Result := SendCommand(mbfReadCoils, RegNo, Blocks, Data);
    for i := 0 to (Blocks - 1) do
      RegisterData[i] := (Data[i] = 1);
  finally
    if bNewConnection then
      DisConnect;
  end;
end;


function TIdModbusClient.ReadDouble(const RegNo: Word; out Value: Double): Boolean;
var
  Buffer: array[0..3] of Word;
begin
  Result := ReadHoldingRegisters(RegNo, 4, Buffer);
  if Result then
    Move(Buffer, Value, SizeOf(Value))
  else
    Value := 0.0;
end;


function TIdModbusClient.ReadDWord(const RegNo: Word; out Value: DWord): Boolean;
var
  Buffer: array[0..1] of Word;
begin
  Result := ReadHoldingRegisters(RegNo, 2, Buffer);
  if Result then
  begin
    LongRec(Value).Hi := Buffer[0];
    LongRec(Value).Lo := Buffer[1];
  end
  else
    Value := 0;
end;


function TIdModbusClient.ReadSingle(const RegNo: Word; out Value: Single): Boolean;
var
  Buffer: array[0..1] of Word;
begin
  Result := ReadHoldingRegisters(RegNo, 2, Buffer);
  if Result then
    Move(Buffer, Value, SizeOf(Value))
  else
    Value := 0.0;
end;


function TIdModbusClient.ReadString(const RegNo: Word; const ALength: Word): String;
var
  BlockCount: Word;
  Data: array of Word;
  i: Integer;
begin
  Result := '';
  BlockCount := Round((ALength / 2) + 0.1);
  SetLength(Data, BlockCount);
  FillChar(Data[0], BlockCount, 0);

  if ReadHoldingRegisters(RegNo, BlockCount, Data) then
  begin
    for i := 0 to (BlockCount - 1) do
    begin
      Result := Result + Chr(WordRec(Data[i]).Hi);
      if (Length(Result) < ALength) then
        Result := Result + Chr(WordRec(Data[i]).Lo);
    end;
  end;
end;

function TIdModbusClient.ReportSlaveID(const Blocks: Word; out RegisterData: array of Word): Boolean;
var
  bNewConnection: Boolean;
  i: integer;
begin
  bNewConnection := False;
  if FAutoConnect and not Connected then
  begin
  {$IFDEF DMB_INDY10}
    Connect;
  {$ELSE}
    Connect(FConnectTimeOut);
  {$ENDIF}
    bNewConnection := True;
  end;
  FillChar(RegisterData[0], Length(RegisterData), 0);
  try
    Result := SendCommand(mbfReportSlaveID, 1, 2, RegisterData);
  finally
    if bNewConnection then
      DisConnect;
  end;
end;

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


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


function TIdModBusClient.WriteDouble(const RegNo: Word; const Value: Double): Boolean;
var
  Buffer: array[0..3] of Word;
begin
  Move(Value, Buffer, SizeOf(Value));
  Result := WriteRegisters(RegNo, Buffer);
end;


function TIdModBusClient.WriteDWord(const RegNo: Word; const Value: DWord): Boolean;
var
  Buffer: array[0..1] of Word;
begin
  Buffer[0] := LongRec(Value).Hi;
  Buffer[1] := LongRec(Value).Lo;
  Result := WriteRegisters(RegNo, Buffer);
end;


function TIdModBusClient.WriteSingle(const RegNo: Word; const Value: Single): Boolean;
var
  Buffer: array[0..1] of Word;
begin
  Move(Value, Buffer, SizeOf(Value));
  Result := WriteRegisters(RegNo, Buffer);
end;



function TIdModBusClient.WriteString(const RegNo: Word; const Text: String): Boolean;
var
  Buffer: array of Word;
  i: Integer;
  iIndex: Integer;
begin
  if (Text <> '') then
  begin
    SetLength(Buffer, Round((Length(Text) / 2) + 0.1));
    FillChar(Buffer[0], Length(Buffer), 0);
    for i := 0 to Length(Buffer) do
    begin
      iIndex := (i * 2) + 1;
      if (iIndex <= Length(Text)) then
        WordRec(Buffer[i]).Hi := Ord(Text[iIndex]);
      if ((iIndex + 1) <= Length(Text)) then
        WordRec(Buffer[i]).Lo := Ord(Text[iIndex + 1]);
    end;
    Result := WriteRegisters(RegNo, Buffer);
  end
  else
    Result := False;
end;


function TIdModBusClient.WriteRegister(const RegNo, Value: Word): Boolean;
var
  Data: array[0..0] of Word;
  bNewConnection: Boolean;
begin
  bNewConnection := False;
  Data[0] := Value;
  if FAutoConnect and not Connected then
  begin
  {$IFDEF DMB_INDY10}
    Connect;
  {$ELSE}
    Connect(FConnectTimeOut);
  {$ENDIF}
    bNewConnection := True;
  end;

  try
    Result := SendCommand(mbfWriteOneReg, RegNo, 0, Data);
  finally
    if bNewConnection then
      DisConnect;
  end;
end;


function TIdModBusClient.WriteRegisters(const RegNo: Word;
  const RegisterData: array of Word): Boolean;
var
  i: Integer;
  iBlockLength: Integer;
  Data: array of Word;
  bNewConnection: Boolean;
begin
  bNewConnection := False;
  iBlockLength := High(RegisterData) - Low(RegisterData) + 1;
  if FAutoConnect and not Connected then
  begin
  {$IFDEF DMB_INDY10}
    Connect;
  {$ELSE}
    Connect(FConnectTimeOut);
  {$ENDIF}
    bNewConnection := True;
  end;

  try
    SetLength(Data, Length(RegisterData));
    for i := Low(RegisterData) to High(RegisterData) do
      Data[i] := RegisterData[i];
    Result := SendCommand(mbfWriteRegs, RegNo, iBlockLength, Data);
  finally
    if bNewConnection then
      DisConnect;
  end;
end;


function TIdModBusClient.WriteCoil(const RegNo: Word; const Value: Boolean): Boolean;
var
  Data: array[0..0] of Word;
  bNewConnection: Boolean;
begin
  bNewConnection := False;
  if Value then
    Data[0] := 1
  else
    Data[0] := 0;

  if FAutoConnect and not Connected then
  begin
  {$IFDEF DMB_INDY10}
    Connect;
  {$ELSE}
    Connect(FConnectTimeOut);
  {$ENDIF}
    bNewConnection := True;
  end;

  try
    Result := SendCommand(mbfWriteOneCoil, RegNo, 0, Data);
  finally
    if bNewConnection then
      DisConnect;
  end;
end;


function TIdModBusClient.WriteCoils(const RegNo, Blocks: Word; const RegisterData: array of Boolean): Boolean;
var
  i: Integer;
  iBlockLength: Integer;
  Data: array of Word;
  bNewConnection: Boolean;
begin
  bNewConnection := False;
  iBlockLength := High(RegisterData) - Low(RegisterData) + 1;
  if FAutoConnect and not Connected then
  begin
  {$IFDEF DMB_INDY10}
    Connect;
  {$ELSE}
    Connect(FConnectTimeOut);
  {$ENDIF}
    bNewConnection := True;
  end;

  try
    SetLength(Data, Length(RegisterData));
    for i := Low(RegisterData) to High(RegisterData) do
    begin
      if RegisterData[i] then
        Data[i] := 1
      else
        Data[i] := 0;
    end;
    Result := SendCommand(mbfWriteCoils, RegNo, iBlockLength, Data);
  finally
    if bNewConnection then
      DisConnect;
  end;
end;


end.

五、IdModBusServer.pas

{$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
{$I ModBusPlatforms.inc}
{$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}
    destructor Destroy(); override;
  { 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;


destructor TIdModBusServer.Destroy();
begin
  inherited;
  // freed AFTER inherited destructor because this will first stop the server
  FLogCriticalSection.Free();
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 - 1) > 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 - 1) > 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:
        begin
          iRegNr := GetRegNr(Swap16(Word((@ReceiveBuffer.MBPData[0])^)));
          iCount := 1;
          if ((iRegNr < FMinRegister) or ((iRegNr + iCount - 1) > 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[2], 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;
      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 - 1) > 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 - 1) > 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 - 1) > 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;
  ValidRequest : Boolean;
{$IFDEF DMB_INDY10}
  Buffer: TIdBytes;
{$ENDIF}
begin
  if Active then
  begin

    {Check Valid }
    ValidRequest  := false;
    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 > 0) and (L <= MaxCoils) then
          begin
            SendBuffer.MBPData[0] := Byte((L + 7) div 8);
            PutCoilsIntoBuffer(@SendBuffer.MBPData[1], L, Data);
            SendBuffer.Header.RecLength := Swap16(3 + SendBuffer.MBPData[0]);
            ValidRequest  := true;
          end;
        end;
      mbfReadInputRegs,
      mbfReadHoldingRegs:
        begin
          L := Swap16(Word((@ReceiveBuffer.MBPData[2])^));
          if (L > 0) and (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]);
            ValidRequest  := true;
          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);
        ValidRequest  := true;
      end;
    end;
    {Send buffer if Request is Valid}
    if ValidRequest then
    begin
    {$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
    else
    begin
      {Send error for invalid request}
    {$IFDEF DMB_INDY10}
      SendError(AContext, mbeServerFailure, ReceiveBuffer);
    {$ELSE}
      SendError(AThread, mbeServerFailure, ReceiveBuffer);
    {$ENDIF}
       exit;
    end;
  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.

六、ModBusCompiler.inc

{ Logic to detect the used Delphi compiler version: }
{$IFDEF VER120}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI4_ONLY}
{$ENDIF}
{$IFDEF VER130}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI5}
  {$DEFINE DMB_DELPHI5_ONLY}
{$ENDIF}
{$IFDEF VER140}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI5}
  {$DEFINE DMB_DELPHI6}
  {$DEFINE DMB_DELPHI6_ONLY}
{$ENDIF}
{$IFDEF VER150}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI5}
  {$DEFINE DMB_DELPHI6}
  {$DEFINE DMB_DELPHI7}
  {$DEFINE DMB_DELPHI7_ONLY}
{$ENDIF}
{$IFDEF VER170}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI5}
  {$DEFINE DMB_DELPHI6}
  {$DEFINE DMB_DELPHI7}
  {$DEFINE DMB_DELPHI2005}
  {$DEFINE DMB_DELPHI2005_ONLY}
{$ENDIF}
{$IFDEF VER180}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI5}
  {$DEFINE DMB_DELPHI6}
  {$DEFINE DMB_DELPHI7}
  {$DEFINE DMB_DELPHI2005}
  {$DEFINE DMB_DELPHI2006}
  {$IFNDEF VER185}
    {$DEFINE DMB_DELPHI2006_ONLY}
  {$ENDIF}
{$ENDIF}
{$IFDEF VER185}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI5}
  {$DEFINE DMB_DELPHI6}
  {$DEFINE DMB_DELPHI7}
  {$DEFINE DMB_DELPHI2005}
  {$DEFINE DMB_DELPHI2006}
  {$DEFINE DMB_DELPHI2007}
  {$DEFINE DMB_DELPHI2007_ONLY}
{$ENDIF}
{$IFDEF VER200}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI5}
  {$DEFINE DMB_DELPHI6}
  {$DEFINE DMB_DELPHI7}
  {$DEFINE DMB_DELPHI2005}
  {$DEFINE DMB_DELPHI2006}
  {$DEFINE DMB_DELPHI2007}
  {$DEFINE DMB_DELPHI2009}
  {$DEFINE DMB_DELPHI2009_ONLY}
{$ENDIF}
{$IFDEF VER210}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI5}
  {$DEFINE DMB_DELPHI6}
  {$DEFINE DMB_DELPHI7}
  {$DEFINE DMB_DELPHI2005}
  {$DEFINE DMB_DELPHI2006}
  {$DEFINE DMB_DELPHI2007}
  {$DEFINE DMB_DELPHI2009}
  {$DEFINE DMB_DELPHI2010}
  {$DEFINE DMB_DELPHI2010_ONLY}
{$ENDIF}
{$IFDEF VER220}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI5}
  {$DEFINE DMB_DELPHI6}
  {$DEFINE DMB_DELPHI7}
  {$DEFINE DMB_DELPHI2005}
  {$DEFINE DMB_DELPHI2006}
  {$DEFINE DMB_DELPHI2007}
  {$DEFINE DMB_DELPHI2009}
  {$DEFINE DMB_DELPHI2010}
  {$DEFINE DMB_DELPHIXE}
  {$DEFINE DMB_DELPHIXE_ONLY}
{$ENDIF}
{$IFDEF VER230}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI5}
  {$DEFINE DMB_DELPHI6}
  {$DEFINE DMB_DELPHI7}
  {$DEFINE DMB_DELPHI2005}
  {$DEFINE DMB_DELPHI2006}
  {$DEFINE DMB_DELPHI2007}
  {$DEFINE DMB_DELPHI2009}
  {$DEFINE DMB_DELPHI2010}
  {$DEFINE DMB_DELPHIXE}
  {$DEFINE DMB_DELPHIXE2}
  {$DEFINE DMB_DELPHIXE2_ONLY}
{$ENDIF}
{$IFDEF VER240}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI5}
  {$DEFINE DMB_DELPHI6}
  {$DEFINE DMB_DELPHI7}
  {$DEFINE DMB_DELPHI2005}
  {$DEFINE DMB_DELPHI2006}
  {$DEFINE DMB_DELPHI2007}
  {$DEFINE DMB_DELPHI2009}
  {$DEFINE DMB_DELPHI2010}
  {$DEFINE DMB_DELPHIXE}
  {$DEFINE DMB_DELPHIXE2}
  {$DEFINE DMB_DELPHIXE3}
  {$DEFINE DMB_DELPHIXE3_ONLY}
{$ENDIF}
{$IFDEF VER250}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI5}
  {$DEFINE DMB_DELPHI6}
  {$DEFINE DMB_DELPHI7}
  {$DEFINE DMB_DELPHI2005}
  {$DEFINE DMB_DELPHI2006}
  {$DEFINE DMB_DELPHI2007}
  {$DEFINE DMB_DELPHI2009}
  {$DEFINE DMB_DELPHI2010}
  {$DEFINE DMB_DELPHIXE}
  {$DEFINE DMB_DELPHIXE2}
  {$DEFINE DMB_DELPHIXE3}
  {$DEFINE DMB_DELPHIXE4}
  {$DEFINE DMB_DELPHIXE4_ONLY}
{$ENDIF}
{$IFDEF VER260}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI5}
  {$DEFINE DMB_DELPHI6}
  {$DEFINE DMB_DELPHI7}
  {$DEFINE DMB_DELPHI2005}
  {$DEFINE DMB_DELPHI2006}
  {$DEFINE DMB_DELPHI2007}
  {$DEFINE DMB_DELPHI2009}
  {$DEFINE DMB_DELPHI2010}
  {$DEFINE DMB_DELPHIXE}
  {$DEFINE DMB_DELPHIXE2}
  {$DEFINE DMB_DELPHIXE3}
  {$DEFINE DMB_DELPHIXE4}
  {$DEFINE DMB_DELPHIXE5}
  {$DEFINE DMB_DELPHIXE5_ONLY}
{$ENDIF}
{$IFDEF VER270}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI5}
  {$DEFINE DMB_DELPHI6}
  {$DEFINE DMB_DELPHI7}
  {$DEFINE DMB_DELPHI2005}
  {$DEFINE DMB_DELPHI2006}
  {$DEFINE DMB_DELPHI2007}
  {$DEFINE DMB_DELPHI2009}
  {$DEFINE DMB_DELPHI2010}
  {$DEFINE DMB_DELPHIXE}
  {$DEFINE DMB_DELPHIXE2}
  {$DEFINE DMB_DELPHIXE3}
  {$DEFINE DMB_DELPHIXE4}
  {$DEFINE DMB_DELPHIXE5}
  {$DEFINE DMB_DELPHIXE6}
  {$DEFINE DMB_DELPHIXE6_ONLY}
{$ENDIF}
{$IFDEF VER280}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI5}
  {$DEFINE DMB_DELPHI6}
  {$DEFINE DMB_DELPHI7}
  {$DEFINE DMB_DELPHI2005}
  {$DEFINE DMB_DELPHI2006}
  {$DEFINE DMB_DELPHI2007}
  {$DEFINE DMB_DELPHI2009}
  {$DEFINE DMB_DELPHI2010}
  {$DEFINE DMB_DELPHIXE}
  {$DEFINE DMB_DELPHIXE2}
  {$DEFINE DMB_DELPHIXE3}
  {$DEFINE DMB_DELPHIXE4}
  {$DEFINE DMB_DELPHIXE5}
  {$DEFINE DMB_DELPHIXE6}
  {$DEFINE DMB_DELPHIXE7}
  {$DEFINE DMB_DELPHIXE7_ONLY}
{$ENDIF}
{$IFDEF VER290}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI5}
  {$DEFINE DMB_DELPHI6}
  {$DEFINE DMB_DELPHI7}
  {$DEFINE DMB_DELPHI2005}
  {$DEFINE DMB_DELPHI2006}
  {$DEFINE DMB_DELPHI2007}
  {$DEFINE DMB_DELPHI2009}
  {$DEFINE DMB_DELPHI2010}
  {$DEFINE DMB_DELPHIXE}
  {$DEFINE DMB_DELPHIXE2}
  {$DEFINE DMB_DELPHIXE3}
  {$DEFINE DMB_DELPHIXE4}
  {$DEFINE DMB_DELPHIXE5}
  {$DEFINE DMB_DELPHIXE6}
  {$DEFINE DMB_DELPHIXE7}
  {$DEFINE DMB_DELPHIXE8}
  {$DEFINE DMB_DELPHIXE8_ONLY}
{$ENDIF}
{$IFDEF VER300}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI5}
  {$DEFINE DMB_DELPHI6}
  {$DEFINE DMB_DELPHI7}
  {$DEFINE DMB_DELPHI2005}
  {$DEFINE DMB_DELPHI2006}
  {$DEFINE DMB_DELPHI2007}
  {$DEFINE DMB_DELPHI2009}
  {$DEFINE DMB_DELPHI2010}
  {$DEFINE DMB_DELPHIXE}
  {$DEFINE DMB_DELPHIXE2}
  {$DEFINE DMB_DELPHIXE3}
  {$DEFINE DMB_DELPHIXE4}
  {$DEFINE DMB_DELPHIXE5}
  {$DEFINE DMB_DELPHIXE6}
  {$DEFINE DMB_DELPHIXE7}
  {$DEFINE DMB_DELPHIXE8}
  {$DEFINE DMB_DELPHI10_SEATTLE}
  {$DEFINE DMB_DELPHI10_SEATTLE_ONLY}
{$ENDIF}
{$IFDEF VER310}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI5}
  {$DEFINE DMB_DELPHI6}
  {$DEFINE DMB_DELPHI7}
  {$DEFINE DMB_DELPHI2005}
  {$DEFINE DMB_DELPHI2006}
  {$DEFINE DMB_DELPHI2007}
  {$DEFINE DMB_DELPHI2009}
  {$DEFINE DMB_DELPHI2010}
  {$DEFINE DMB_DELPHIXE}
  {$DEFINE DMB_DELPHIXE2}
  {$DEFINE DMB_DELPHIXE3}
  {$DEFINE DMB_DELPHIXE4}
  {$DEFINE DMB_DELPHIXE5}
  {$DEFINE DMB_DELPHIXE6}
  {$DEFINE DMB_DELPHIXE7}
  {$DEFINE DMB_DELPHIXE8}
  {$DEFINE DMB_DELPHI10_SEATTLE}
  {$DEFINE DMB_DELPHI10_1_BERLIN}
  {$DEFINE DMB_DELPHI10_1_BERLIN_ONLY}
{$ENDIF}

{$IFDEF VER320}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI5}
  {$DEFINE DMB_DELPHI6}
  {$DEFINE DMB_DELPHI7}
  {$DEFINE DMB_DELPHI2005}
  {$DEFINE DMB_DELPHI2006}
  {$DEFINE DMB_DELPHI2007}
  {$DEFINE DMB_DELPHI2009}
  {$DEFINE DMB_DELPHI2010}
  {$DEFINE DMB_DELPHIXE}
  {$DEFINE DMB_DELPHIXE2}
  {$DEFINE DMB_DELPHIXE3}
  {$DEFINE DMB_DELPHIXE4}
  {$DEFINE DMB_DELPHIXE5}
  {$DEFINE DMB_DELPHIXE6}
  {$DEFINE DMB_DELPHIXE7}
  {$DEFINE DMB_DELPHIXE8}
  {$DEFINE DMB_DELPHI10_SEATTLE}
  {$DEFINE DMB_DELPHI10_1_BERLIN}
  {$DEFINE DMB_DELPHI10_2_TOKYO}
  {$DEFINE DMB_DELPHI10_2_TOKYO_ONLY}
{$ENDIF}

{$IFDEF VER330}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI5}
  {$DEFINE DMB_DELPHI6}
  {$DEFINE DMB_DELPHI7}
  {$DEFINE DMB_DELPHI2005}
  {$DEFINE DMB_DELPHI2006}
  {$DEFINE DMB_DELPHI2007}
  {$DEFINE DMB_DELPHI2009}
  {$DEFINE DMB_DELPHI2010}
  {$DEFINE DMB_DELPHIXE}
  {$DEFINE DMB_DELPHIXE2}
  {$DEFINE DMB_DELPHIXE3}
  {$DEFINE DMB_DELPHIXE4}
  {$DEFINE DMB_DELPHIXE5}
  {$DEFINE DMB_DELPHIXE6}
  {$DEFINE DMB_DELPHIXE7}
  {$DEFINE DMB_DELPHIXE8}
  {$DEFINE DMB_DELPHI10_SEATTLE}
  {$DEFINE DMB_DELPHI10_1_BERLIN}
  {$DEFINE DMB_DELPHI10_2_TOKYO}
  {$DEFINE DMB_DELPHI10_3_RIO}
  {$DEFINE DMB_DELPHI10_3_RIO_ONLY}
{$ENDIF}

{$IFDEF VER340}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI5}
  {$DEFINE DMB_DELPHI6}
  {$DEFINE DMB_DELPHI7}
  {$DEFINE DMB_DELPHI2005}
  {$DEFINE DMB_DELPHI2006}
  {$DEFINE DMB_DELPHI2007}
  {$DEFINE DMB_DELPHI2009}
  {$DEFINE DMB_DELPHI2010}
  {$DEFINE DMB_DELPHIXE}
  {$DEFINE DMB_DELPHIXE2}
  {$DEFINE DMB_DELPHIXE3}
  {$DEFINE DMB_DELPHIXE4}
  {$DEFINE DMB_DELPHIXE5}
  {$DEFINE DMB_DELPHIXE6}
  {$DEFINE DMB_DELPHIXE7}
  {$DEFINE DMB_DELPHIXE8}
  {$DEFINE DMB_DELPHI10_SEATTLE}
  {$DEFINE DMB_DELPHI10_1_BERLIN}
  {$DEFINE DMB_DELPHI10_2_TOKYO}
  {$DEFINE DMB_DELPHI10_3_RIO}
  {$DEFINE DMB_DELPHI10_4_SYDNEY}
  {$DEFINE DMB_DELPHI10_4_SYDNEY_ONLY}
{$ENDIF}

{$IFDEF VER350}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI5}
  {$DEFINE DMB_DELPHI6}
  {$DEFINE DMB_DELPHI7}
  {$DEFINE DMB_DELPHI2005}
  {$DEFINE DMB_DELPHI2006}
  {$DEFINE DMB_DELPHI2007}
  {$DEFINE DMB_DELPHI2009}
  {$DEFINE DMB_DELPHI2010}
  {$DEFINE DMB_DELPHIXE}
  {$DEFINE DMB_DELPHIXE2}
  {$DEFINE DMB_DELPHIXE3}
  {$DEFINE DMB_DELPHIXE4}
  {$DEFINE DMB_DELPHIXE5}
  {$DEFINE DMB_DELPHIXE6}
  {$DEFINE DMB_DELPHIXE7}
  {$DEFINE DMB_DELPHIXE8}
  {$DEFINE DMB_DELPHI10_SEATTLE}
  {$DEFINE DMB_DELPHI10_1_BERLIN}
  {$DEFINE DMB_DELPHI10_2_TOKYO}
  {$DEFINE DMB_DELPHI10_3_RIO}
  {$DEFINE DMB_DELPHI10_4_SYDNEY}
  {$DEFINE DMB_DELPHI11_ALEXANDRIA}
{$ENDIF}

{$IFDEF VER360}
  {$DEFINE DMB_DELPHI1}
  {$DEFINE DMB_DELPHI2}
  {$DEFINE DMB_DELPHI3}
  {$DEFINE DMB_DELPHI4}
  {$DEFINE DMB_DELPHI5}
  {$DEFINE DMB_DELPHI6}
  {$DEFINE DMB_DELPHI7}
  {$DEFINE DMB_DELPHI2005}
  {$DEFINE DMB_DELPHI2006}
  {$DEFINE DMB_DELPHI2007}
  {$DEFINE DMB_DELPHI2009}
  {$DEFINE DMB_DELPHI2010}
  {$DEFINE DMB_DELPHIXE}
  {$DEFINE DMB_DELPHIXE2}
  {$DEFINE DMB_DELPHIXE3}
  {$DEFINE DMB_DELPHIXE4}
  {$DEFINE DMB_DELPHIXE5}
  {$DEFINE DMB_DELPHIXE6}
  {$DEFINE DMB_DELPHIXE7}
  {$DEFINE DMB_DELPHIXE8}
  {$DEFINE DMB_DELPHI10_SEATTLE}
  {$DEFINE DMB_DELPHI10_1_BERLIN}
  {$DEFINE DMB_DELPHI10_2_TOKYO}
  {$DEFINE DMB_DELPHI10_3_RIO}
  {$DEFINE DMB_DELPHI10_4_SYDNEY}
  {$DEFINE DMB_DELPHI11_ALEXANDRIA}
  {$DEFINE DMB_DELPHI12_ATHENS}
  {$DEFINE DMB_DELPHI12_ATHENS_ONLY}
{$ENDIF}

{$IFDEF DMB_DELPHI2005}
{ By default use Indy 10 starting from Delphi 2005 }
  {$DEFINE DMB_INDY10}
{$ELSE}
{ Older Delphi versions use Indy 9 }
  {$DEFINE DMB_INDY9}
{$ENDIF}
  
{$IFDEF FPC}
{ Force the Free Pascal Compiler in Delphi mode, and use Indy 10 }
  {$MODE DELPHI}
  {$UNDEF DMB_INDY9}
  {$DEFINE DMB_INDY10}
{$ENDIF}

{ Allow user defines to overrule the Indy version being used }
{$IFDEF FORCE_INDY9}
  {$UNDEF DMB_INDY10}
  {$DEFINE DMB_INDY9}
{$ELSE}
  {$IFDEF FORCE_INDY10}
    {$UNDEF DMB_INDY9}
    {$DEFINE DMB_INDY10}
  {$ENDIF}
{$ENDIF}