f.bitti/Plancia
1
0 Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
74482417bc59e54905c8e1c18dc686f062a120f7
Plancia/uModbusRTU.pas
T
f.bittiandClaude Opus 5 4a01a2ec88 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>
2026-09-22 16:56:34 +02:00

379 lines
11 KiB
ObjectPascal
Raw Blame History

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 View Git Blame Copy Permalink