实例介绍
【实例简介】 Delphi组件,以通过TCP / IP与ModBus PLC通信。该库提供了同时实现ModBus主站和Modbus从站的组件,并且基于Indy组件集(支持Indy 9和10)
【实例截图】
【核心代码】
{=============================================================================== The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. Alternatively, the contents of this file may be used under the terms of the GNU General Public License Version 2 or later (the "GPL"), in which case the provisions of the GPL are applicable instead of those above. If you wish to allow use of your version of this file only under the terms of the GPL and not to allow others to use your version of this file under the MPL, indicate your decision by deleting the provisions above and replace them with the notice and other provisions required by the GPL. If you do not delete the provisions above, a recipient may use your version of this file under either the MPL or the GPL. $Id: IdModbusServer.pas,v 1.38 2014/01/14 15:21:20 plpolak Exp $ ===============================================================================} {$I ModBusCompiler.inc} unit IdModBusServer; interface uses Classes ,SysUtils {$IFDEF DMB_INDY10} ,IdContext ,IdCustomTCPServer ,IdGlobal {$ELSE} ,IdTCPClient ,IdTCPServer {$ENDIF} ,ModBusConsts ,ModbusTypes ,ModbusUtils ,SyncObjs; type TModRegisterData = array[0..MaxBlockLength] of Word; type TModCoilData = array[0..MaxCoils] of ByteBool; {$IFDEF DMB_INDY10} type TModBusCoilReadEvent = procedure(const Sender: TIdContext; const RegNr, Count: Integer; var Data: TModCoilData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte) of object; TModBusRegisterReadEvent = procedure(const Sender: TIdContext; const RegNr, Count: Integer; var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte) of object; TModBusCoilWriteEvent = procedure(const Sender: TIdContext; const RegNr, Count: Integer; const Data: TModCoilData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte) of object; TModBusRegisterWriteEvent = procedure(const Sender: TIdContext; const RegNr, Count: Integer; const Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte) of object; TModBusErrorEvent = procedure(const Sender: TIdContext; const FunctionCode: Byte; const ErrorCode: Byte; const RequestBuffer: TModBusRequestBuffer) of object; TModBusInvalidFunctionEvent = procedure(const Sender: TIdContext; const FunctionCode: TModBusFunction; const RequestBuffer: TModBusRequestBuffer) of object; {$ELSE} type TModBusCoilReadEvent = procedure(const Sender: TIdPeerThread; const RegNr, Count: Integer; var Data: TModCoilData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte) of object; TModBusRegisterReadEvent = procedure(const Sender: TIdPeerThread; const RegNr, Count: Integer; var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte) of object; TModBusCoilWriteEvent = procedure(const Sender: TIdPeerThread; const RegNr, Count: Integer; const Data: TModCoilData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte) of object; TModBusRegisterWriteEvent = procedure(const Sender: TIdPeerThread; const RegNr, Count: Integer; const Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte) of object; TModBusErrorEvent = procedure(const Sender: TIdPeerThread; const FunctionCode: Byte; const ErrorCode: Byte; const RequestBuffer: TModBusRequestBuffer) of object; TModBusInvalidFunctionEvent = procedure(const Sender: TIdPeerThread; const FunctionCode: TModBusFunction; const RequestBuffer: TModBusRequestBuffer) of object; {$ENDIF} type {$IFDEF DMB_DELPHIXE3} [ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidLinux32 or {$IFDEF DMB_DELPHIXE5} pidAndroid or {$ENDIF} {$IFDEF DMB_DELPHIXE4} pidiOSDevice or pidiOSSimulator or {$ENDIF} pidOSX32)] {$ENDIF} {$IFDEF DMB_INDY10} TIdModBusServer = class(TIdCustomTCPServer) {$ELSE} TIdModBusServer = class(TIdTCPServer) {$ENDIF} private FBaseRegister: Word; FOneShotConnection: Boolean; FLogCriticalSection: TCriticalSection; FLogEnabled: Boolean; FLogFile: String; FLogTimeFormat: String; FMaxRegister: Word; FMinRegister: Word; FOnError: TModBusErrorEvent; FOnInvalidFunction: TModBusInvalidFunctionEvent; FOnReadCoils: TModBusCoilReadEvent; FOnReadHoldingRegisters: TModBusRegisterReadEvent; FOnReadInputBits: TModBusCoilReadEvent; FOnReadInputRegisters: TModBusRegisterReadEvent; FOnWriteCoils: TModBusCoilWriteEvent; FOnWriteRegisters: TModBusRegisterWriteEvent; FPause: Boolean; FUnitID: Byte; function GetVersion: String; procedure SetVersion(const Value: String); function IsLogTimeFormatStored: Boolean; procedure LogByteBuffer(const LogType: String; const PeerIP: String; const ByteBuffer: array of Byte; const Size: Integer); {$IFDEF DMB_INDY10} procedure InternalReadCoils(const AContext: TIdContext; const RegNr, Count: Integer; var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); procedure InternalReadInputBits(const AContext: TIdContext; const RegNr, Count: Integer; var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); procedure InternalWriteCoils(const AContext: TIdContext; const RegNr, Count: Integer; const Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); {$ELSE} procedure InternalReadCoils(const Sender: TIdPeerThread; const RegNr, Count: Integer; var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); procedure InternalReadInputBits(const Sender: TIdPeerThread; const RegNr, Count: Integer; var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); procedure InternalWriteCoils(const Sender: TIdPeerThread; const RegNr, Count: Integer; const Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); {$ENDIF} protected {$IFDEF DMB_INDY10} procedure InitComponent; override; {$ENDIF} {$IFDEF DMB_INDY10} procedure DoError(const AContext: TIdContext; const FunctionCode: Byte; const ErrorCode: Byte; const RequestBuffer: TModBusRequestBuffer); virtual; function DoExecute(AContext: TIdContext): Boolean; override; procedure DoInvalidFunction(const AContext: TIdContext; const FunctionCode: TModBusFunction; const RequestBuffer: TModBusRequestBuffer); virtual; procedure DoReadHoldingRegisters(const AContext: TIdContext; const RegNr, Count: Integer; var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual; procedure DoReadInputRegisters(const AContext: TIdContext; const RegNr, Count: Integer; var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual; procedure DoReadCoils(const AContext: TIdContext; const RegNr, Count: Integer; var Data: TModCoilData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual; procedure DoReadInputBits(const AContext: TIdContext; const RegNr, Count: Integer; var Data: TModCoilData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual; procedure DoWriteCoils(const AContext: TIdContext; const RegNr, Count: Integer; const Data: TModCoilData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual; procedure DoWriteRegisters(const AContext: TIdContext; const RegNr, Count: Integer; const Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual; procedure LogExceptionBuffer(const AContext: TIdContext; const Buffer: TModBusExceptionBuffer); procedure LogRequestBuffer(const AContext: TIdContext; const Buffer: TModBusRequestBuffer; const Size: Integer); procedure LogResponseBuffer(const AContext: TIdContext; const Buffer: TModBusResponseBuffer; const Size: Integer); procedure ReadCommand(const AContext: TIdContext); procedure SendError(const AContext: TIdContext; const ErrorCode: Byte; const ReceiveBuffer: TModBusRequestBuffer); procedure SendResponse(const AContext: TIdContext; const ReceiveBuffer: TModBusRequestBuffer; const Data: TModRegisterData); {$ELSE} procedure DoError(const Sender: TIdPeerThread; const FunctionCode: Byte; const ErrorCode: Byte; const RequestBuffer: TModBusRequestBuffer); virtual; function DoExecute(AThread: TIdPeerThread): Boolean; override; procedure DoInvalidFunction(const Sender: TIdPeerThread; const FunctionCode: TModBusFunction; const RequestBuffer: TModBusRequestBuffer); virtual; procedure DoReadHoldingRegisters(const Sender: TIdPeerThread; const RegNr, Count: Integer; var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual; procedure DoReadInputRegisters(const Sender: TIdPeerThread; const RegNr, Count: Integer; var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual; procedure DoReadCoils(const Sender: TIdPeerThread; const RegNr, Count: Integer; var Data: TModCoilData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual; procedure DoReadInputBits(const Sender: TIdPeerThread; const RegNr, Count: Integer; var Data: TModCoilData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual; procedure DoWriteCoils(const Sender: TIdPeerThread; const RegNr, Count: Integer; const Data: TModCoilData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual; procedure DoWriteRegisters(const Sender: TIdPeerThread; const RegNr, Count: Integer; const Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); virtual; procedure LogExceptionBuffer(const AThread: TIdPeerThread; const Buffer: TModBusExceptionBuffer); procedure LogRequestBuffer(const AThread: TIdPeerThread; const Buffer: TModBusRequestBuffer; const Size: Integer); procedure LogResponseBuffer(const AThread: TIdPeerThread; const Buffer: TModBusResponseBuffer; const Size: Integer); procedure ReadCommand(const AThread: TIdPeerThread); procedure SendError(const AThread: TIdPeerThread; const ErrorCode: Byte; const ReceiveBuffer: TModBusRequestBuffer); procedure SendResponse(const AThread: TIdPeerThread; const ReceiveBuffer: TModBusRequestBuffer; const Data: TModRegisterData); {$ENDIF} public {$IFNDEF DMB_INDY10} constructor Create(AOwner: TComponent); override; {$ENDIF} { public properties } property Pause: Boolean read FPause write FPause; published property BaseRegister: Word read FBaseRegister write FBaseRegister default 1; property DefaultPort default MB_PORT; property LogEnabled: Boolean read FLogEnabled write FLogEnabled default False; property LogFile: String read FLogFile write FLogFile; property LogTimeFormat: String read FLogTimeFormat write FLogTimeFormat stored IsLogTimeFormatStored; property OneShotConnection: Boolean read FOneShotConnection write FOneShotConnection default False; property MaxRegister: Word read FMaxRegister write FMaxRegister default $FFFF; property MinRegister: Word read FMinRegister write FMinRegister default 1; property UnitID: Byte read FUnitID write FUnitID default MB_IGNORE_UNITID; property Version: String read GetVersion write SetVersion stored False; { events } property OnError: TModBusErrorEvent read FOnError write FOnError; property OnInvalidFunction: TModBusInvalidFunctionEvent read FOnInvalidFunction write FOnInvalidFunction; property OnReadCoils: TModBusCoilReadEvent read FOnReadCoils write FOnReadCoils; property OnReadHoldingRegisters: TModBusRegisterReadEvent read FOnReadHoldingRegisters write FOnReadHoldingRegisters; property OnReadInputBits: TModBusCoilReadEvent read FOnReadInputBits write FOnReadInputBits; property OnReadInputRegisters: TModBusRegisterReadEvent read FOnReadInputRegisters write FOnReadInputRegisters; property OnWriteCoils: TModBusCoilWriteEvent read FOnWriteCoils write FOnWriteCoils; property OnWriteRegisters: TModBusRegisterWriteEvent read FOnWriteRegisters write FOnWriteRegisters; end; { TIdModBusServer } implementation uses Math; { TIdModBusServer } {$IFDEF DMB_INDY10} procedure TIdModBusServer.InitComponent; {$ELSE} constructor TIdModBusServer.Create(AOwner: TComponent); {$ENDIF} begin {$IFDEF DMB_INDY10} inherited; {$ELSE} inherited Create(AOwner); {$ENDIF} FBaseRegister := 1; DefaultPort := MB_PORT; FLogCriticalSection := SyncObjs.TCriticalSection.Create; FLogEnabled := False; FLogFile := ''; FLogTimeFormat := DefaultLogTimeFormat; FMaxRegister := $FFFF; FMinRegister := 1; FOneShotConnection := False; FOnError := nil; FOnInvalidFunction := nil; FOnReadCoils := nil; FOnReadHoldingRegisters := nil; FOnReadInputBits := nil; FOnReadInputRegisters := nil; FOnWriteCoils := nil; FOnWriteRegisters := nil; FPause := False; FUnitID := MB_IGNORE_UNITID; end; procedure TIdModBusServer.LogByteBuffer(const LogType: String; const PeerIP: String; const ByteBuffer: array of Byte; const Size: Integer); var F: TextFile; begin if FLogEnabled and (FLogFile <> '') then begin FLogCriticalSection.Enter; try AssignFile(F, FLogFile); if FileExists(FLogFile) then Append(F) else Rewrite(F); try WriteLn(F, FormatDateTime(FLogTimeFormat, Now) ,'; ', LogType ,'; ', PeerIP ,'; ', IntToStr(Size) ,'; ', BufferToHex(ByteBuffer)); finally CloseFile(F); end; finally FLogCriticalSection.Leave; end; end; end; {$IFDEF DMB_INDY10} procedure TIdModBusServer.InternalReadCoils(const AContext: TIdContext; const RegNr, Count: Integer; var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); {$ELSE} procedure TIdModBusServer.InternalReadCoils(const Sender: TIdPeerThread; const RegNr, Count: Integer; var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); {$ENDIF} var CoilData: TModCoilData; i: Integer; begin FillChar(CoilData, SizeOf(CoilData), 0); {$IFDEF DMB_INDY10} DoReadCoils(AContext, RegNr, Count, CoilData, RequestBuffer, ErrorCode); {$ELSE} DoReadCoils(Sender, RegNr, Count, CoilData, RequestBuffer, ErrorCode); {$ENDIF} for i := 0 to (Count - 1) do begin if CoilData[i] then Data[i] := 1; end; end; {$IFDEF DMB_INDY10} procedure TIdModBusServer.InternalReadInputBits(const AContext: TIdContext; const RegNr, Count: Integer; var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); {$ELSE} procedure TIdModBusServer.InternalReadInputBits(const Sender: TIdPeerThread; const RegNr, Count: Integer; var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); {$ENDIF} var CoilData: TModCoilData; i: Integer; begin FillChar(CoilData, SizeOf(CoilData), 0); {$IFDEF DMB_INDY10} DoReadInputBits(AContext, RegNr, Count, CoilData, RequestBuffer, ErrorCode); {$ELSE} DoReadInputBits(Sender, RegNr, Count, CoilData, RequestBuffer, ErrorCode); {$ENDIF} for i := 0 to (Count - 1) do begin if CoilData[i] then Data[i] := 1; end; end; {$IFDEF DMB_INDY10} procedure TIdModBusServer.InternalWriteCoils(const AContext: TIdContext; const RegNr, Count: Integer; const Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); {$ELSE} procedure TIdModBusServer.InternalWriteCoils(const Sender: TIdPeerThread; const RegNr, Count: Integer; const Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); {$ENDIF} var CoilData: TModCoilData; i: Integer; begin FillChar(CoilData, SizeOf(CoilData), 0); for i := 0 to (Count - 1) do CoilData[i] := (Data[i] = 1); {$IFDEF DMB_INDY10} DoWriteCoils(AContext, RegNr, Count, CoilData, RequestBuffer, ErrorCode); {$ELSE} DoWriteCoils(Sender, RegNr, Count, CoilData, RequestBuffer, ErrorCode); {$ENDIF} end; {$IFDEF DMB_INDY10} procedure TIdModBusServer.LogExceptionBuffer(const AContext: TIdContext; const Buffer: TModBusExceptionBuffer); {$ELSE} procedure TIdModBusServer.LogExceptionBuffer(const AThread: TIdPeerThread; const Buffer: TModBusExceptionBuffer); {$ENDIF} var PeerIP: String; ByteBuffer: array of Byte; begin {$IFDEF DMB_INDY10} PeerIP := AContext.Connection.Socket.Binding.PeerIP; {$ELSE} PeerIP := AThread.Connection.Socket.Binding.PeerIP; {$ENDIF} SetLength(ByteBuffer, SizeOf(Buffer)); Move(Buffer, ByteBuffer[0], SizeOf(Buffer)); LogByteBuffer('excp', PeerIP, ByteBuffer, SizeOf(Buffer)); end; {$IFDEF DMB_INDY10} procedure TIdModBusServer.LogRequestBuffer(const AContext: TIdContext; const Buffer: TModBusRequestBuffer; const Size: Integer); {$ELSE} procedure TIdModBusServer.LogRequestBuffer(const AThread: TIdPeerThread; const Buffer: TModBusRequestBuffer; const Size: Integer); {$ENDIF} var PeerIP: String; ByteBuffer: array of Byte; begin {$IFDEF DMB_INDY10} PeerIP := AContext.Connection.Socket.Binding.PeerIP; {$ELSE} PeerIP := AThread.Connection.Socket.Binding.PeerIP; {$ENDIF} SetLength(ByteBuffer, SizeOf(Buffer)); Move(Buffer, ByteBuffer[0], SizeOf(Buffer)); LogByteBuffer('recv', PeerIP, ByteBuffer, Size); end; {$IFDEF DMB_INDY10} procedure TIdModBusServer.LogResponseBuffer(const AContext: TIdContext; const Buffer: TModBusResponseBuffer; const Size: Integer); {$ELSE} procedure TIdModBusServer.LogResponseBuffer(const AThread: TIdPeerThread; const Buffer: TModBusResponseBuffer; const Size: Integer); {$ENDIF} var PeerIP: String; ByteBuffer: array of Byte; begin {$IFDEF DMB_INDY10} PeerIP := AContext.Connection.Socket.Binding.PeerIP; {$ELSE} PeerIP := AThread.Connection.Socket.Binding.PeerIP; {$ENDIF} SetLength(ByteBuffer, SizeOf(Buffer)); Move(Buffer, ByteBuffer[0], SizeOf(Buffer)); LogByteBuffer('sent', PeerIP, ByteBuffer, Size); end; {$IFDEF DMB_INDY10} procedure TIdModBusServer.ReadCommand(const AContext: TIdContext); {$ELSE} procedure TIdModBusServer.ReadCommand(const AThread: TIdPeerThread); {$ENDIF} function GetRegNr(const RegNr: Integer): Integer; begin Result := RegNr; if (RegNr < 0) then Result := Result $FFFF else if (RegNr > $FFFF) then Result := RegNr - ($FFFF 1); Result := Result FBaseRegister; end; { GetRegNr } var iCount: Integer; iRegNr: Integer; ErrorCode: Byte; ReceiveBuffer: TModBusRequestBuffer; Data: TModRegisterData; {$IFDEF DMB_INDY10} Buffer: TIdBytes; {$ENDIF} begin { Initialize all register data to 0 } FillChar(Data[0], SizeOf(Data), 0); FillChar(ReceiveBuffer, SizeOf(ReceiveBuffer), 0); { Read the data from the peer connection } {$IFDEF DMB_INDY10} { Ensure receiving databuffer is completely empty, and filled with zeros } SetLength(Buffer, SizeOf(ReceiveBuffer)); FillChar(Buffer[0], SizeOf(ReceiveBuffer), 0); { Wait max. 250 msecs. for available data } AContext.Connection.IOHandler.CheckForDataOnSource(250); if not AContext.Connection.IOHandler.InputBufferIsEmpty then begin AContext.Connection.IOHandler.InputBuffer.ExtractToBytes(Buffer, -1, False, -1); iCount := Length(Buffer); if (iCount > 0) then begin Move(Buffer[0], ReceiveBuffer, Min(iCount, SizeOf(ReceiveBuffer))); if FLogEnabled then LogRequestBuffer(AContext, ReceiveBuffer, iCount); end else Exit; end else Exit; {$ELSE} iCount := AThread.Connection.Socket.Recv(ReceiveBuffer, SizeOf(ReceiveBuffer)); if (iCount > 0) then begin if FLogEnabled then LogRequestBuffer(AThread, ReceiveBuffer, iCount); end else Exit; {$ENDIF} { Process the data } if ((FUnitID <> MB_IGNORE_UNITID) and (ReceiveBuffer.Header.UnitID <> FUnitID)) or (ReceiveBuffer.Header.ProtocolID <> MB_PROTOCOL) then begin // When listening for a specific UnitID, only except data for that ID {$IFDEF DMB_INDY10} SendError(AContext, mbeServerFailure, ReceiveBuffer); {$ELSE} SendError(AThread, mbeServerFailure, ReceiveBuffer); {$ENDIF} end else if ((Byte(ReceiveBuffer.FunctionCode) and $80) <> 0) then begin ErrorCode := Integer(ReceiveBuffer.MBPData[0]); {$IFDEF DMB_INDY10} DoError(AContext, ReceiveBuffer.FunctionCode and not $80, ErrorCode, ReceiveBuffer); {$ELSE} DoError(AThread, ReceiveBuffer.FunctionCode and not $80, ErrorCode, ReceiveBuffer); {$ENDIF} end else begin ErrorCode := mbeOk; case ReceiveBuffer.FunctionCode of mbfReadCoils, mbfReadInputBits: begin iRegNr := GetRegNr(Swap16(Word((@ReceiveBuffer.MBPData[0])^))); iCount := Swap16(Word((@ReceiveBuffer.MBPData[2])^)); if ((iRegNr < FMinRegister) or ((iRegNr iCount) > FMaxRegister)) then {$IFDEF DMB_INDY10} SendError(AContext, mbeIllegalRegister, ReceiveBuffer) {$ELSE} SendError(AThread, mbeIllegalRegister, ReceiveBuffer) {$ENDIF} else begin { Signal the user that data is needed } {$IFDEF DMB_INDY10} if (ReceiveBuffer.FunctionCode = mbfReadCoils) then InternalReadCoils(AContext, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode) else InternalReadInputBits(AContext, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode); if (ErrorCode = mbeOk) then SendResponse(AContext, ReceiveBuffer, Data) else SendError(AContext, ErrorCode, ReceiveBuffer); {$ELSE} if (ReceiveBuffer.FunctionCode = mbfReadCoils) then InternalReadCoils(AThread, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode) else InternalReadInputBits(AThread, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode); if (ErrorCode = mbeOk) then SendResponse(AThread, ReceiveBuffer, Data) else SendError(AThread, ErrorCode, ReceiveBuffer); {$ENDIF} end; end; mbfReadInputRegs, mbfReadHoldingRegs: begin iRegNr := GetRegNr(Swap16(Word((@ReceiveBuffer.MBPData[0])^))); iCount := Swap16(Word((@ReceiveBuffer.MBPData[2])^)); if ((iRegNr < FMinRegister) or ((iRegNr iCount) > FMaxRegister)) then {$IFDEF DMB_INDY10} SendError(AContext, mbeIllegalRegister, ReceiveBuffer) {$ELSE} SendError(AThread, mbeIllegalRegister, ReceiveBuffer) {$ENDIF} else begin { Signal the user that data is needed } {$IFDEF DMB_INDY10} if (ReceiveBuffer.FunctionCode = mbfReadInputRegs) then DoReadInputRegisters(AContext, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode) else DoReadHoldingRegisters(AContext, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode); if (ErrorCode = mbeOk) then SendResponse(AContext, ReceiveBuffer, Data) else SendError(AContext, ErrorCode, ReceiveBuffer); {$ELSE} if (ReceiveBuffer.FunctionCode = mbfReadInputRegs) then DoReadInputRegisters(AThread, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode) else DoReadHoldingRegisters(AThread, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode); if (ErrorCode = mbeOk) then SendResponse(AThread, ReceiveBuffer, Data) else SendError(AThread, ErrorCode, ReceiveBuffer); {$ENDIF} end; end; mbfWriteOneCoil, mbfWriteOneReg: begin { Get the register number } iRegNr := GetRegNr(Swap16(Word((@ReceiveBuffer.MBPData[0])^))); { Get the register value } Data[0] := Swap16(Word((@ReceiveBuffer.MBPData[2])^)); { This function always writes one register } iCount := 1; if ((iRegNr < FMinRegister) or ((iRegNr iCount) > FMaxRegister)) then {$IFDEF DMB_INDY10} SendError(AContext, mbeIllegalRegister, ReceiveBuffer) {$ELSE} SendError(AThread, mbeIllegalRegister, ReceiveBuffer) {$ENDIF} else begin { Send back the response to the master } {$IFDEF DMB_INDY10} DoWriteRegisters(AContext, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode); if (ErrorCode = mbeOk) then SendResponse(AContext, ReceiveBuffer, Data) else SendError(AContext, ErrorCode, ReceiveBuffer); {$ELSE} DoWriteRegisters(AThread, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode); if (ErrorCode = mbeOk) then SendResponse(AThread, ReceiveBuffer, Data) else SendError(AThread, ErrorCode, ReceiveBuffer); {$ENDIF} end; end; mbfWriteRegs: begin iRegNr := GetRegNr(Swap16(Word((@ReceiveBuffer.MBPData[0])^))); iCount := Swap16(Word((@ReceiveBuffer.MBPData[2])^)); if ((iRegNr < FMinRegister) or ((iRegNr iCount) > FMaxRegister)) then {$IFDEF DMB_INDY10} SendError(AContext, mbeIllegalRegister, ReceiveBuffer) {$ELSE} SendError(AThread, mbeIllegalRegister, ReceiveBuffer) {$ENDIF} else begin { Decode the contents of the Registers } GetRegistersFromBuffer(@ReceiveBuffer.MbpData[5], iCount, Data); { Send back the response to the master } {$IFDEF DMB_INDY10} DoWriteRegisters(AContext, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode); if (ErrorCode = mbeOk) then SendResponse(AContext, ReceiveBuffer, Data) else SendError(AContext, ErrorCode, ReceiveBuffer); {$ELSE} DoWriteRegisters(AThread, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode); if (ErrorCode = mbeOk) then SendResponse(AThread, ReceiveBuffer, Data) else SendError(AThread, ErrorCode, ReceiveBuffer); {$ENDIF} end; end; mbfWriteCoils: begin iRegNr := GetRegNr(Swap16(Word((@ReceiveBuffer.MBPData[0])^))); iCount := Swap16(Word((@ReceiveBuffer.MBPData[2])^)); if ((iRegNr < FMinRegister) or ((iRegNr iCount) > FMaxRegister)) then {$IFDEF DMB_INDY10} SendError(AContext, mbeIllegalRegister, ReceiveBuffer) {$ELSE} SendError(AThread, mbeIllegalRegister, ReceiveBuffer) {$ENDIF} else begin { Decode the contents of the Registers } GetCoilsFromBuffer(@ReceiveBuffer.MbpData[5], iCount, Data); { Send back the response to the master } {$IFDEF DMB_INDY10} InternalWriteCoils(AContext, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode); if (ErrorCode = mbeOk) then SendResponse(AContext, ReceiveBuffer, Data) else SendError(AContext, ErrorCode, ReceiveBuffer); {$ELSE} InternalWriteCoils(AThread, iRegNr, iCount, Data, ReceiveBuffer, ErrorCode); if (ErrorCode = mbeOk) then SendResponse(AThread, ReceiveBuffer, Data) else SendError(AThread, ErrorCode, ReceiveBuffer); {$ENDIF} end; end; else if (ReceiveBuffer.FunctionCode <> 0) then begin { Illegal or unsupported function code } {$IFDEF DMB_INDY10} SendError(AContext, mbeIllegalFunction, ReceiveBuffer); DoInvalidFunction(AContext, ReceiveBuffer.FunctionCode, ReceiveBuffer); {$ELSE} SendError(AThread, mbeIllegalFunction, ReceiveBuffer); DoInvalidFunction(AThread, ReceiveBuffer.FunctionCode, ReceiveBuffer); {$ENDIF} end; end; end; { If needed: the server terminates the connection, after the request has been handled } if FOneShotConnection then {$IFDEF DMB_INDY10} AContext.Connection.Disconnect; {$ELSE} AThread.Connection.Disconnect; {$ENDIF} end; {$IFDEF DMB_INDY10} procedure TIdModBusServer.DoError(const AContext: TIdContext; const FunctionCode: Byte; const ErrorCode: Byte; const RequestBuffer: TModBusRequestBuffer); {$ELSE} procedure TIdModBusServer.DoError(const Sender: TIdPeerThread; const FunctionCode: Byte; const ErrorCode: Byte; const RequestBuffer: TModBusRequestBuffer); {$ENDIF} begin if Assigned(FOnError) then {$IFDEF DMB_INDY10} FOnError(AContext, FunctionCode, ErrorCode, RequestBuffer); {$ELSE} FOnError(Sender, FunctionCode, ErrorCode, RequestBuffer); {$ENDIF} end; {$IFDEF DMB_INDY10} function TIdModBusServer.DoExecute(AContext: TIdContext): Boolean; {$ELSE} function TIdModBusServer.DoExecute(AThread: TIdPeerThread): Boolean; {$ENDIF} begin Result := False; if not FPause then begin {$IFDEF DMB_INDY10} ReadCommand(AContext); Result := inherited DoExecute(AContext); {$ELSE} ReadCommand(AThread); Result := inherited DoExecute(AThread); {$ENDIF} end; end; {$IFDEF DMB_INDY10} procedure TIdModBusServer.DoInvalidFunction(const AContext: TIdContext; const FunctionCode: TModBusFunction; const RequestBuffer: TModBusRequestBuffer); {$ELSE} procedure TIdModBusServer.DoInvalidFunction(const Sender: TIdPeerThread; const FunctionCode: TModBusFunction; const RequestBuffer: TModBusRequestBuffer); {$ENDIF} begin if Assigned(FOnInvalidFunction) then {$IFDEF DMB_INDY10} FOnInvalidFunction(AContext, FunctionCode, RequestBuffer); {$ELSE} FOnInvalidFunction(Sender, FunctionCode, RequestBuffer); {$ENDIF} end; {$IFDEF DMB_INDY10} procedure TIdModBusServer.DoReadCoils(const AContext: TIdContext; const RegNr, Count: Integer; var Data: TModCoilData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); {$ELSE} procedure TIdModBusServer.DoReadCoils(const Sender: TIdPeerThread; const RegNr, Count: Integer; var Data: TModCoilData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); {$ENDIF} begin if Assigned(FOnReadCoils) then {$IFDEF DMB_INDY10} FOnReadCoils(AContext, RegNr, Count, Data, RequestBuffer, ErrorCode); {$ELSE} FOnReadCoils(Sender, RegNr, Count, Data, RequestBuffer, ErrorCode); {$ENDIF} end; {$IFDEF DMB_INDY10} procedure TIdModBusServer.DoReadInputBits(const AContext: TIdContext; const RegNr, Count: Integer; var Data: TModCoilData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); {$ELSE} procedure TIdModBusServer.DoReadInputBits(const Sender: TIdPeerThread; const RegNr, Count: Integer; var Data: TModCoilData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); {$ENDIF} begin if Assigned(FOnReadInputBits) then {$IFDEF DMB_INDY10} FOnReadInputBits(AContext, RegNr, Count, Data, RequestBuffer, ErrorCode); {$ELSE} FOnReadInputBits(Sender, RegNr, Count, Data, RequestBuffer, ErrorCode); {$ENDIF} end; {$IFDEF DMB_INDY10} procedure TIdModBusServer.DoReadHoldingRegisters(const AContext: TIdContext; const RegNr, Count: Integer; var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); {$ELSE} procedure TIdModBusServer.DoReadHoldingRegisters(const Sender: TIdPeerThread; const RegNr, Count: Integer; var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); {$ENDIF} begin if Assigned(FOnReadHoldingRegisters) then {$IFDEF DMB_INDY10} FOnReadHoldingRegisters(AContext, RegNr, Count, Data, RequestBuffer, ErrorCode); {$ELSE} FOnReadHoldingRegisters(Sender, RegNr, Count, Data, RequestBuffer, ErrorCode); {$ENDIF} end; {$IFDEF DMB_INDY10} procedure TIdModBusServer.DoReadInputRegisters(const AContext: TIdContext; const RegNr, Count: Integer; var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); {$ELSE} procedure TIdModBusServer.DoReadInputRegisters(const Sender: TIdPeerThread; const RegNr, Count: Integer; var Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); {$ENDIF} begin if Assigned(FOnReadInputRegisters) then {$IFDEF DMB_INDY10} FOnReadInputRegisters(AContext, RegNr, Count, Data, RequestBuffer, ErrorCode); {$ELSE} FOnReadInputRegisters(Sender, RegNr, Count, Data, RequestBuffer, ErrorCode); {$ENDIF} end; {$IFDEF DMB_INDY10} procedure TIdModBusServer.DoWriteCoils(const AContext: TIdContext; const RegNr, Count: Integer; const Data: TModCoilData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); {$ELSE} procedure TIdModBusServer.DoWriteCoils(const Sender: TIdPeerThread; const RegNr, Count: Integer; const Data: TModCoilData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); {$ENDIF} begin if Assigned(FOnWriteCoils) then {$IFDEF DMB_INDY10} FOnWriteCoils(AContext, RegNr, Count, Data, RequestBuffer, ErrorCode); {$ELSE} FOnWriteCoils(Sender, RegNr, Count, Data, RequestBuffer, ErrorCode); {$ENDIF} end; {$IFDEF DMB_INDY10} procedure TIdModBusServer.DoWriteRegisters(const AContext: TIdContext; const RegNr, Count: Integer; const Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); {$ELSE} procedure TIdModBusServer.DoWriteRegisters(const Sender: TIdPeerThread; const RegNr, Count: Integer; const Data: TModRegisterData; const RequestBuffer: TModBusRequestBuffer; var ErrorCode: Byte); {$ENDIF} begin if Assigned(FOnWriteRegisters) then {$IFDEF DMB_INDY10} FOnWriteRegisters(AContext, RegNr, Count, Data, RequestBuffer, ErrorCode); {$ELSE} FOnWriteRegisters(Sender, RegNr, Count, Data, RequestBuffer, ErrorCode); {$ENDIF} end; {$IFDEF DMB_INDY10} procedure TIdModBusServer.SendError(const AContext: TIdContext; const ErrorCode: Byte; const ReceiveBuffer: TModBusRequestBuffer); {$ELSE} procedure TIdModBusServer.SendError(const AThread: TIdPeerThread; const ErrorCode: Byte; const ReceiveBuffer: TModBusRequestBuffer); {$ENDIF} var SendBuffer: TModBusExceptionBuffer; {$IFDEF DMB_INDY10} Buffer: TIdBytes; {$ENDIF} begin if Active then begin SendBuffer.Header := ReceiveBuffer.Header; SendBuffer.ExceptionFunction := ReceiveBuffer.FunctionCode or $80; SendBuffer.ExceptionCode := ErrorCode; SendBuffer.Header.RecLength := Swap16(3); {$IFDEF DMB_INDY10} Buffer := RawToBytes(SendBuffer, SizeOf(SendBuffer)); AContext.Connection.Socket.WriteDirect(Buffer); if FLogEnabled then LogExceptionBuffer(AContext, SendBuffer); {$ELSE} AThread.Connection.Socket.Send(SendBuffer, SizeOf(SendBuffer)); if FLogEnabled then LogExceptionBuffer(AThread, SendBuffer); {$ENDIF} end; end; {$IFDEF DMB_INDY10} procedure TIdModBusServer.SendResponse(const AContext: TIdContext; const ReceiveBuffer: TModBusRequestBuffer; const Data: TModRegisterData); {$ELSE} procedure TIdModBusServer.SendResponse(const AThread: TIdPeerThread; const ReceiveBuffer: TModBusRequestBuffer; const Data: TModRegisterData); {$ENDIF} var SendBuffer: TModBusResponseBuffer; L: Integer; {$IFDEF DMB_INDY10} Buffer: TIdBytes; {$ENDIF} begin if Active then begin FillChar(SendBuffer, SizeOf(SendBuffer), 0); SendBuffer.Header.TransactionID := ReceiveBuffer.Header.TransactionID; SendBuffer.Header.ProtocolID := ReceiveBuffer.Header.ProtocolID; SendBuffer.Header.UnitID := ReceiveBuffer.Header.UnitID; SendBuffer.FunctionCode := ReceiveBuffer.FunctionCode; SendBuffer.Header.RecLength := Swap16(0); case ReceiveBuffer.FunctionCode of mbfReadCoils, mbfReadInputBits: begin L := Swap16(Word((@ReceiveBuffer.MBPData[2])^)); if (L <= MaxBlockLength) then begin SendBuffer.MBPData[0] := Byte(L shl 1); PutCoilsIntoBuffer(@SendBuffer.MBPData[1], L, Data); SendBuffer.Header.RecLength := Swap16(3 SendBuffer.MBPData[0]); end; end; mbfReadInputRegs, mbfReadHoldingRegs: begin L := Swap16(Word((@ReceiveBuffer.MBPData[2])^)); if (L <= MaxBlockLength) then begin SendBuffer.MBPData[0] := Byte(L shl 1); PutRegistersIntoBuffer(@SendBuffer.MBPData[1], L, Data); SendBuffer.Header.RecLength := Swap16(3 SendBuffer.MBPData[0]); end; end; else begin SendBuffer.MBPData[0] := ReceiveBuffer.MBPData[0]; SendBuffer.MBPData[1] := ReceiveBuffer.MBPData[1]; SendBuffer.MBPData[2] := ReceiveBuffer.MBPData[2]; SendBuffer.MBPData[3] := ReceiveBuffer.MBPData[3]; SendBuffer.Header.RecLength := Swap16(6); end; end; {$IFDEF DMB_INDY10} Buffer := RawToBytes(SendBuffer, Swap16(SendBuffer.Header.RecLength) 6); AContext.Connection.Socket.WriteDirect(Buffer); if FLogEnabled then LogResponseBuffer(AContext, SendBuffer, Swap16(SendBuffer.Header.RecLength) 6); {$ELSE} AThread.Connection.Socket.Send(SendBuffer, Swap16(SendBuffer.Header.RecLength) 6); if FLogEnabled then LogResponseBuffer(AThread, SendBuffer, Swap16(SendBuffer.Header.RecLength) 6); {$ENDIF} end; end; function TIdModBusServer.GetVersion: String; begin Result := DMB_VERSION; end; function TIdModBusServer.IsLogTimeFormatStored: Boolean; begin Result := (FLogTimeFormat <> DefaultLogTimeFormat); end; procedure TIdModBusServer.SetVersion(const Value: String); begin { This intentionally is a readonly property } end; end.
好例子网口号:伸出你的我的手 — 分享!
小贴士
感谢您为本站写下的评论,您的评论对其它用户来说具有重要的参考价值,所以请认真填写。
- 类似“顶”、“沙发”之类没有营养的文字,对勤劳贡献的楼主来说是令人沮丧的反馈信息。
- 相信您也不想看到一排文字/表情墙,所以请不要反馈意义不大的重复字符,也请尽量不要纯表情的回复。
- 提问之前请再仔细看一遍楼主的说明,或许是您遗漏了。
- 请勿到处挖坑绊人、招贴广告。既占空间让人厌烦,又没人会搭理,于人于己都无利。
关于好例子网
本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享,对搜索内容的合法性不具有预见性、识别性、控制性,仅供学习研究,请务必在下载后24小时内给予删除,不得用于其他任何用途,否则后果自负。基于互联网的特殊性,平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查;无论平台是否已进行审查,用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场,基于网友分享,根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定,若资源存在侵权或相关问题请联系本站客服人员,点此联系我们。关于更多版权及免责申明参见 版权及免责申明
网友评论
我要评论