Plancia configurabile su Modbus RTU
Due programmi che condividono uModbusRTU e uGauge: - Console/PlanciaConsole: plancia nautica descritta da file XML, con modalita' plancia e modalita' configurazione. Comandi, spie, selettori, strumenti e allarmi sonori; il bus gira in un thread suo perche' la finestra non si fermi mai. - ProjectPlancia: il programma di prova piu' vecchio, usato per collaudare i canali. Le plance sono in Console/*.xml, la documentazione in Console/LEGGIMI.md. Esclusi dal versionamento i compilati (.exe, .dcu), i file dell'IDE e un audio da 17 MB. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
f.bittiandClaude Opus 5 committed
commit
4a01a2ec88
69 files changed
+11658
No files matched your search
+378
@@ -0,0 +1,378 @@
|
||||
unit uModbusRTU;
|
||||
|
||||
{
|
||||
Libreria Modbus RTU su RS485 per Delphi
|
||||
Compatibile con: moduli relè Waveshare Modbus RTU 32-Ch,
|
||||
moduli I/O digitali 8-Ch, moduli acquisizione analogica 8-Ch
|
||||
Usa API Win32 pura (nessuna dipendenza esterna)
|
||||
}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Winapi.Windows, system.SysUtils, system.Classes;
|
||||
|
||||
type
|
||||
TModbusException = class(Exception);
|
||||
|
||||
TModbusRTU = class
|
||||
private
|
||||
FHandle: THandle;
|
||||
FPortName: string;
|
||||
FBaudRate: Cardinal;
|
||||
FTimeoutMs: Cardinal;
|
||||
/// Quando e' finito l'ultimo scambio: fra un frame e l'altro il Modbus RTU
|
||||
/// vuole almeno 3,5 caratteri di silenzio.
|
||||
FLastFrame: UInt64;
|
||||
procedure WaitInterFrame;
|
||||
function CalcCRC16(const ABuf: array of Byte; ALen: Integer): Word;
|
||||
function SendReceive(const ARequest: array of Byte; AExpectedLen: Integer): TBytes;
|
||||
public
|
||||
constructor Create(const APortName: string; ABaudRate: Cardinal = 9600; ATimeoutMs: Cardinal = 500);
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Connect;
|
||||
procedure Disconnect;
|
||||
function IsConnected: Boolean;
|
||||
|
||||
// Function 01 - Read Coils (uscite relè)
|
||||
function ReadCoils(ASlaveAddr: Byte; AStartAddr, AQuantity: Word): TArray<Boolean>;
|
||||
// Function 02 - Read Discrete Inputs (ingressi digitali)
|
||||
function ReadDiscreteInputs(ASlaveAddr: Byte; AStartAddr, AQuantity: Word): TArray<Boolean>;
|
||||
// Function 03 - Read Holding Registers (es. ingressi analogici)
|
||||
function ReadHoldingRegisters(ASlaveAddr: Byte; AStartAddr, AQuantity: Word): TArray<Word>;
|
||||
// Function 04 - Read Input Registers
|
||||
function ReadInputRegisters(ASlaveAddr: Byte; AStartAddr, AQuantity: Word): TArray<Word>;
|
||||
// Function 05 - Write Single Coil (accende/spegne un relè)
|
||||
procedure WriteSingleCoil(ASlaveAddr: Byte; AAddr: Word; AValue: Boolean);
|
||||
// Function 06 - Write Single Register
|
||||
procedure WriteSingleRegister(ASlaveAddr: Byte; AAddr, AValue: Word);
|
||||
// Function 15 - Write Multiple Coils
|
||||
procedure WriteMultipleCoils(ASlaveAddr: Byte; AStartAddr: Word; const AValues: array of Boolean);
|
||||
|
||||
property PortName: string read FPortName;
|
||||
property BaudRate: Cardinal read FBaudRate;
|
||||
property TimeoutMs: Cardinal read FTimeoutMs write FTimeoutMs;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
INVALID_HANDLE = THandle(-1);
|
||||
|
||||
{ TModbusRTU }
|
||||
|
||||
constructor TModbusRTU.Create(const APortName: string; ABaudRate: Cardinal; ATimeoutMs: Cardinal);
|
||||
begin
|
||||
inherited Create;
|
||||
FPortName := APortName;
|
||||
FBaudRate := ABaudRate;
|
||||
FTimeoutMs := ATimeoutMs;
|
||||
FHandle := INVALID_HANDLE;
|
||||
end;
|
||||
|
||||
destructor TModbusRTU.Destroy;
|
||||
begin
|
||||
Disconnect;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TModbusRTU.IsConnected: Boolean;
|
||||
begin
|
||||
Result := FHandle <> INVALID_HANDLE;
|
||||
end;
|
||||
|
||||
procedure TModbusRTU.Connect;
|
||||
var
|
||||
DCB: TDCB;
|
||||
Timeouts: TCommTimeouts;
|
||||
FullName: string;
|
||||
begin
|
||||
if IsConnected then Exit;
|
||||
|
||||
// Prefisso \\.\ necessario per COM10+
|
||||
FullName := '\\.\' + FPortName;
|
||||
|
||||
FHandle := CreateFile(PChar(FullName), GENERIC_READ or GENERIC_WRITE,
|
||||
0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
|
||||
|
||||
if FHandle = INVALID_HANDLE then
|
||||
raise TModbusException.CreateFmt('Impossibile aprire %s (errore %d)', [FPortName, GetLastError]);
|
||||
|
||||
FillChar(DCB, SizeOf(DCB), 0);
|
||||
DCB.DCBlength := SizeOf(DCB);
|
||||
if not GetCommState(FHandle, DCB) then
|
||||
raise TModbusException.Create('GetCommState fallita');
|
||||
|
||||
DCB.BaudRate := FBaudRate;
|
||||
DCB.ByteSize := 8;
|
||||
DCB.Parity := NOPARITY;
|
||||
DCB.StopBits := ONESTOPBIT;
|
||||
DCB.Flags := 0; // no flow control
|
||||
|
||||
if not SetCommState(FHandle, DCB) then
|
||||
raise TModbusException.Create('SetCommState fallita: parametri seriali non validi');
|
||||
|
||||
Timeouts.ReadIntervalTimeout := 50;
|
||||
Timeouts.ReadTotalTimeoutMultiplier := 10;
|
||||
Timeouts.ReadTotalTimeoutConstant := FTimeoutMs;
|
||||
Timeouts.WriteTotalTimeoutMultiplier := 10;
|
||||
Timeouts.WriteTotalTimeoutConstant := FTimeoutMs;
|
||||
SetCommTimeouts(FHandle, Timeouts);
|
||||
|
||||
PurgeComm(FHandle, PURGE_RXCLEAR or PURGE_TXCLEAR);
|
||||
end;
|
||||
|
||||
procedure TModbusRTU.Disconnect;
|
||||
begin
|
||||
if IsConnected then
|
||||
begin
|
||||
CloseHandle(FHandle);
|
||||
FHandle := INVALID_HANDLE;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TModbusRTU.CalcCRC16(const ABuf: array of Byte; ALen: Integer): Word;
|
||||
var
|
||||
I, J: Integer;
|
||||
CRC: Word;
|
||||
begin
|
||||
CRC := $FFFF;
|
||||
for I := 0 to ALen - 1 do
|
||||
begin
|
||||
CRC := CRC xor ABuf[I];
|
||||
for J := 0 to 7 do
|
||||
begin
|
||||
if (CRC and $0001) <> 0 then
|
||||
CRC := (CRC shr 1) xor $A001
|
||||
else
|
||||
CRC := CRC shr 1;
|
||||
end;
|
||||
end;
|
||||
Result := CRC;
|
||||
end;
|
||||
|
||||
procedure TModbusRTU.WaitInterFrame;
|
||||
var
|
||||
Silenzio, Passato: UInt64;
|
||||
begin
|
||||
// 3,5 caratteri da 11 bit al baud in uso, mai meno di 2 ms: a 9600 sono
|
||||
// circa 4 ms. Senza questa pausa le richieste partono attaccate alla
|
||||
// risposta precedente, e il modulo ogni tanto non le sente: la lettura
|
||||
// salta, la spia si spegne e l'allarme riparte. Costa pochi millisecondi
|
||||
// per richiesta.
|
||||
if FBaudRate = 0 then
|
||||
Exit;
|
||||
Silenzio := (35 * 11 * 1000) div (FBaudRate * 10);
|
||||
if Silenzio < 2 then
|
||||
Silenzio := 2;
|
||||
if FLastFrame = 0 then
|
||||
Exit;
|
||||
Passato := GetTickCount64 - FLastFrame;
|
||||
if Passato < Silenzio then
|
||||
Sleep(Silenzio - Passato);
|
||||
end;
|
||||
|
||||
function TModbusRTU.SendReceive(const ARequest: array of Byte; AExpectedLen: Integer): TBytes;
|
||||
var
|
||||
BytesWritten, BytesRead: DWORD;
|
||||
RecvCRC: Word;
|
||||
RecvBuf: TBytes;
|
||||
begin
|
||||
if not IsConnected then
|
||||
raise TModbusException.Create('Porta non connessa: chiamare Connect prima');
|
||||
|
||||
WaitInterFrame;
|
||||
PurgeComm(FHandle, PURGE_RXCLEAR or PURGE_TXCLEAR);
|
||||
|
||||
if not WriteFile(FHandle, ARequest[0], Length(ARequest), BytesWritten, nil) then
|
||||
raise TModbusException.CreateFmt('Errore scrittura seriale (%d)', [GetLastError]);
|
||||
if Integer(BytesWritten) <> Length(ARequest) then
|
||||
raise TModbusException.Create('Scrittura seriale incompleta');
|
||||
|
||||
SetLength(RecvBuf, AExpectedLen);
|
||||
if not ReadFile(FHandle, RecvBuf[0], AExpectedLen, BytesRead, nil) then
|
||||
raise TModbusException.CreateFmt('Errore lettura seriale (%d)', [GetLastError]);
|
||||
|
||||
FLastFrame := GetTickCount64;
|
||||
|
||||
if BytesRead = 0 then
|
||||
raise TModbusException.Create('Timeout: nessuna risposta dallo slave (verificare indirizzo/cablaggio)');
|
||||
|
||||
SetLength(RecvBuf, BytesRead);
|
||||
|
||||
// Il frame piu' corto possibile e' l'eccezione: indirizzo, funzione, codice, CRC.
|
||||
if BytesRead < 5 then
|
||||
raise TModbusException.CreateFmt('Risposta troncata: %d byte', [BytesRead]);
|
||||
|
||||
// La CRC ricevuta va confrontata, non solo calcolata in trasmissione. Se due
|
||||
// nodi hanno lo stesso indirizzo rispondono insieme e i frame si sovrappongono:
|
||||
// senza questo controllo il risultato corrotto passerebbe per un dato buono.
|
||||
RecvCRC := CalcCRC16(RecvBuf, BytesRead - 2);
|
||||
if (Lo(RecvCRC) <> RecvBuf[BytesRead - 2]) or (Hi(RecvCRC) <> RecvBuf[BytesRead - 1]) then
|
||||
raise TModbusException.Create('CRC errata: risposta corrotta. Possibile collisione ' +
|
||||
'fra due slave con lo stesso indirizzo, o disturbi sulla linea');
|
||||
|
||||
// Deve rispondere lo slave interrogato, non un altro.
|
||||
if RecvBuf[0] <> ARequest[0] then
|
||||
raise TModbusException.CreateFmt('Ha risposto lo slave %d invece del %d',
|
||||
[RecvBuf[0], ARequest[0]]);
|
||||
|
||||
// Eccezione Modbus: function code con bit 0x80 settato.
|
||||
if (RecvBuf[1] and $80) <> 0 then
|
||||
raise TModbusException.CreateFmt('Eccezione Modbus dallo slave %d, codice %d',
|
||||
[RecvBuf[0], RecvBuf[2]]);
|
||||
|
||||
Result := RecvBuf;
|
||||
end;
|
||||
|
||||
function TModbusRTU.ReadCoils(ASlaveAddr: Byte; AStartAddr, AQuantity: Word): TArray<Boolean>;
|
||||
var
|
||||
Req: array[0..7] of Byte;
|
||||
CRC: Word;
|
||||
Resp: TBytes;
|
||||
I: Integer;
|
||||
ByteCount: Integer;
|
||||
begin
|
||||
Req[0] := ASlaveAddr;
|
||||
Req[1] := $01;
|
||||
Req[2] := Hi(AStartAddr); Req[3] := Lo(AStartAddr);
|
||||
Req[4] := Hi(AQuantity); Req[5] := Lo(AQuantity);
|
||||
CRC := CalcCRC16(Req, 6);
|
||||
Req[6] := Lo(CRC); Req[7] := Hi(CRC);
|
||||
|
||||
ByteCount := (AQuantity + 7) div 8;
|
||||
Resp := SendReceive(Req, 5 + ByteCount);
|
||||
|
||||
SetLength(Result, AQuantity);
|
||||
for I := 0 to AQuantity - 1 do
|
||||
Result[I] := (Resp[3 + (I div 8)] and (1 shl (I mod 8))) <> 0;
|
||||
end;
|
||||
|
||||
function TModbusRTU.ReadDiscreteInputs(ASlaveAddr: Byte; AStartAddr, AQuantity: Word): TArray<Boolean>;
|
||||
var
|
||||
Req: array[0..7] of Byte;
|
||||
CRC: Word;
|
||||
Resp: TBytes;
|
||||
I: Integer;
|
||||
ByteCount: Integer;
|
||||
begin
|
||||
Req[0] := ASlaveAddr;
|
||||
Req[1] := $02;
|
||||
Req[2] := Hi(AStartAddr); Req[3] := Lo(AStartAddr);
|
||||
Req[4] := Hi(AQuantity); Req[5] := Lo(AQuantity);
|
||||
CRC := CalcCRC16(Req, 6);
|
||||
Req[6] := Lo(CRC); Req[7] := Hi(CRC);
|
||||
|
||||
ByteCount := (AQuantity + 7) div 8;
|
||||
Resp := SendReceive(Req, 5 + ByteCount);
|
||||
|
||||
SetLength(Result, AQuantity);
|
||||
for I := 0 to AQuantity - 1 do
|
||||
Result[I] := (Resp[3 + (I div 8)] and (1 shl (I mod 8))) <> 0;
|
||||
end;
|
||||
|
||||
function TModbusRTU.ReadHoldingRegisters(ASlaveAddr: Byte; AStartAddr, AQuantity: Word): TArray<Word>;
|
||||
var
|
||||
Req: array[0..7] of Byte;
|
||||
CRC: Word;
|
||||
Resp: TBytes;
|
||||
I: Integer;
|
||||
begin
|
||||
Req[0] := ASlaveAddr;
|
||||
Req[1] := $03;
|
||||
Req[2] := Hi(AStartAddr); Req[3] := Lo(AStartAddr);
|
||||
Req[4] := Hi(AQuantity); Req[5] := Lo(AQuantity);
|
||||
CRC := CalcCRC16(Req, 6);
|
||||
Req[6] := Lo(CRC); Req[7] := Hi(CRC);
|
||||
|
||||
Resp := SendReceive(Req, 5 + AQuantity * 2);
|
||||
|
||||
SetLength(Result, AQuantity);
|
||||
for I := 0 to AQuantity - 1 do
|
||||
Result[I] := (Resp[3 + I * 2] shl 8) or Resp[4 + I * 2];
|
||||
end;
|
||||
|
||||
function TModbusRTU.ReadInputRegisters(ASlaveAddr: Byte; AStartAddr, AQuantity: Word): TArray<Word>;
|
||||
var
|
||||
Req: array[0..7] of Byte;
|
||||
CRC: Word;
|
||||
Resp: TBytes;
|
||||
I: Integer;
|
||||
begin
|
||||
Req[0] := ASlaveAddr;
|
||||
Req[1] := $04;
|
||||
Req[2] := Hi(AStartAddr); Req[3] := Lo(AStartAddr);
|
||||
Req[4] := Hi(AQuantity); Req[5] := Lo(AQuantity);
|
||||
CRC := CalcCRC16(Req, 6);
|
||||
Req[6] := Lo(CRC); Req[7] := Hi(CRC);
|
||||
|
||||
Resp := SendReceive(Req, 5 + AQuantity * 2);
|
||||
|
||||
SetLength(Result, AQuantity);
|
||||
for I := 0 to AQuantity - 1 do
|
||||
Result[I] := (Resp[3 + I * 2] shl 8) or Resp[4 + I * 2];
|
||||
end;
|
||||
|
||||
procedure TModbusRTU.WriteSingleCoil(ASlaveAddr: Byte; AAddr: Word; AValue: Boolean);
|
||||
var
|
||||
Req: array[0..7] of Byte;
|
||||
CRC: Word;
|
||||
ValWord: Word;
|
||||
begin
|
||||
if AValue then ValWord := $FF00 else ValWord := $0000;
|
||||
|
||||
Req[0] := ASlaveAddr;
|
||||
Req[1] := $05;
|
||||
Req[2] := Hi(AAddr); Req[3] := Lo(AAddr);
|
||||
Req[4] := Hi(ValWord); Req[5] := Lo(ValWord);
|
||||
CRC := CalcCRC16(Req, 6);
|
||||
Req[6] := Lo(CRC); Req[7] := Hi(CRC);
|
||||
|
||||
SendReceive(Req, 8); // risposta = eco della richiesta
|
||||
end;
|
||||
|
||||
procedure TModbusRTU.WriteSingleRegister(ASlaveAddr: Byte; AAddr, AValue: Word);
|
||||
var
|
||||
Req: array[0..7] of Byte;
|
||||
CRC: Word;
|
||||
begin
|
||||
Req[0] := ASlaveAddr;
|
||||
Req[1] := $06;
|
||||
Req[2] := Hi(AAddr); Req[3] := Lo(AAddr);
|
||||
Req[4] := Hi(AValue); Req[5] := Lo(AValue);
|
||||
CRC := CalcCRC16(Req, 6);
|
||||
Req[6] := Lo(CRC); Req[7] := Hi(CRC);
|
||||
|
||||
SendReceive(Req, 8);
|
||||
end;
|
||||
|
||||
procedure TModbusRTU.WriteMultipleCoils(ASlaveAddr: Byte; AStartAddr: Word; const AValues: array of Boolean);
|
||||
var
|
||||
Req: TBytes;
|
||||
ByteCount, Quantity, I: Integer;
|
||||
CRC: Word;
|
||||
begin
|
||||
Quantity := Length(AValues);
|
||||
ByteCount := (Quantity + 7) div 8;
|
||||
SetLength(Req, 7 + ByteCount + 2);
|
||||
|
||||
Req[0] := ASlaveAddr;
|
||||
Req[1] := $0F;
|
||||
Req[2] := Hi(AStartAddr); Req[3] := Lo(AStartAddr);
|
||||
Req[4] := Hi(Word(Quantity)); Req[5] := Lo(Word(Quantity));
|
||||
Req[6] := ByteCount;
|
||||
|
||||
FillChar(Req[7], ByteCount, 0);
|
||||
for I := 0 to Quantity - 1 do
|
||||
if AValues[I] then
|
||||
Req[7 + (I div 8)] := Req[7 + (I div 8)] or (1 shl (I mod 8));
|
||||
|
||||
CRC := CalcCRC16(Req, 7 + ByteCount);
|
||||
Req[7 + ByteCount] := Lo(CRC);
|
||||
Req[8 + ByteCount] := Hi(CRC);
|
||||
|
||||
SendReceive(Req, 8); // risposta fissa a 8 byte
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in new issue
Block a user