在日常开发中，也会遇到使用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}
![[计算机网络] HTTP/HTTPS](https://i-blog.csdnimg.cn/direct/32110f5eeba34e60967c1bdcb5201830.png)
