unit Pascal_Modbus_RTU;
{ ENG: Comments on Russian! Translation will be in future versions.
At the moment, I suggest to use automatic translation.}
{$mode objfpc}{$H+}
{ TODO : Добавить отчеты об ошибках }
{ TODO : Добавить функции записи одиночных катушек и регистров, мб функции 20-23 }
{ TODO : отправка сообщения об ошибках в линию при ошибках }
interface
uses
Classes, SysUtils, synaser, SynaUtil, crc16_stream;
type
// тип - обработчик сообщений ответов от контроллера
TProcedureReadModbus = procedure(Station: byte; FunctionCode: byte;
StartAddress: word; CountSended: word; size_mb: cardinal; DataStream: TMemoryStream;
NotMatch: boolean = False) of object;
// тип - обработчик ошибок ответа контроллера
TResponceError = procedure(Station: byte; ErrorCode, ExceptionCode: byte) of object;
// тип - обработчик ошибок прослушки линии
TListenError = procedure(ErrorCode: byte; DataStream: TmemoryStream) of object;
// процедура для вывода диагностических сообщений
TDiagStr = procedure(DiagStr: string) of object;
{ TSendThread }
// класс для функции фоновой отправки данных в линию
TSendThread = class(TThread)
private
protected
procedure Execute; override;
public
SendStream: TMemoryStream; // поток данных, который будет "отправлен" в линию (порт)
serial: TBlockSerial; // порт, куда будут посылаться данные
RTS: boolean; // флаг необходимости взводить RTS при отправке данных
RTS_On: word; // кол-во милисекунд от взведения RTS до отправки данных
RTS_Off: word; // кол-во милисекунд от отправки данных до выключения RTS
constructor Create(CreateSuspended: boolean);
end;
DCB = record
DCBlength : DWORD;
BaudRate : DWORD;
flags : DWORD;
wReserved : WORD;
XonLim : WORD;
XoffLim : WORD;
ByteSize : BYTE;
Parity : BYTE;
StopBits : BYTE;
XonChar : char;
XoffChar : char;
ErrorChar : char;
EofChar : char;
EvtChar : char;
wReserved1 : WORD;
end;
{ TPascal_Modbus_RTU }
TPascal_Modbus_RTU = class(TObject)
private
FConnected: boolean; // подключен к порту
FDiagStr: TDiagStr; // процедура вывода диаг. сообщений (временная)
FIsMaster: boolean; // являемся мастером
FLastErrorDesc: string; // описание последней ошибки (не использовал)
FListenError: TListenError; // процедура обработки ошибки прослушивания линии
FListenErrorCode: cardinal; // номер последней ошибки прослушивания линии
FMaxSizePDU: cardinal; // максимальный размер пакета данных ModBus
FObjectTag: integer;
FResponceBreakTime: cardinal; // время (в мс) тишины до ошибки "прерванного ответа"
FResponceError: TResponceError; // обработчик ошибки ответа контроллера
FResponceReadProcedure: TProcedureReadModbus; // обработчик нормального ответа контроллера
FRTS_Off_Delay: word; // кол-во милисекунд от отправки данных до выключения RTS
FRTS_On_Delay: word; // кол-во милисекунд от взведения RTS до отправки данных
FRTS_use: boolean; // флаг использования RTS для отправки данных
FSendErrorMessage: boolean; // флаг "посылать контроллеру сообщения об ошибких"
FSilenceCount: cardinal; // текущее время "тишины" в линии, мс
FTimeBeforeSend: cardinal; // сколько осталось "тишины" до разрешения отправлять в линию, мс
FTimeOutResponce: cardinal; // время таймаута на прием ответа, мс
FReadyForSend: boolean; // флаг "готов посылать в линию"
FirstStart: boolean; // флаг "первый запуск"
FTimeToSleepRx: cardinal; // время бездействия после окончания приема данных (?)
TimeToSleepTx: cardinal; // сколько осталось после окончания передачи данных до таймаута
InputStream: TMemoryStream; // поток с данными из линии
OutputStream: TMemoryStream; // поток для передачи данных обработчикам
InputMessageStream: TMemoryStream; // ??? похоже - рудимент (?)
SendStream: TMemoryStream; // поток данных для передачи в линию
SendedSize: word; // сколько контроллеру послали
SendedFunction: byte; // последняя функция, посланная контроллеру
SendedStation: byte; // послений контроллер, которому посылали запрос
SendedAddress: word; // регистр последнего запроса контроллеру
Serial: TBlockSerial; // COM-порт
BaudRate: cardinal; // скорость обмена
MessageFromMaster: boolean; // --- не нужно, это для когда мы слейв
SendThread: TSendThread; // процесс передачи данных
WaitingResponce: boolean; // флаг "ждем ответа"
stime: tdatetime; // когда началась тишина
procedure SendFinished(Sender: TObject);
procedure SetDiagStr(AValue: TDiagStr);
procedure SetIsMaster(AValue: boolean);
procedure SetListenError(AValue: TListenError);
procedure SetMaxSizePDU(AValue: cardinal);
procedure SetObjectTag(AValue: integer);
procedure SetResponceBreakTime(AValue: cardinal);
procedure SetResponceError(AValue: TResponceError);
procedure SetResponceReadProcedure(AValue: TProcedureReadModbus);
procedure SetRTS_Off_Delay(AValue: word);
procedure SetRTS_On_Delay(AValue: word);
procedure SetRTS_use(AValue: boolean);
procedure SetSendErrorMessage(AValue: boolean);
procedure SetTimeOutResponce(AValue: cardinal);
procedure SetTimeToSleepRx(AValue: cardinal);
protected
public
// описание последней ошибки
property LastErrorDesc: string read FLastErrorDesc ;
// номер последней ошибки прослушивания линии
property ListenErrorCode: cardinal read FListenErrorCode;
// текущее время "тишины" в линии, мс
property SilenceCount: cardinal read FSilenceCount;
// сколько осталось "тишины" до разрешения отправлять в линию, мс
property TimeBeforeSend: cardinal read FTimeBeforeSend;
// подключен к порту
property Connected: boolean read FConnected;
// флаг "готов посылать в линию"
property ReadyForSend: boolean read FReadyForSend;
constructor Create;
destructor Free;
// команда на чтение регистров (функции ... )
function Read(Station, FunctionCode: byte; StartAddress, Count: word): cardinal;
// команда на запись регистров (функции ... )
function Write(Station, FunctionCode: byte; StartAddress, Count: word;
WriteStream: Tmemorystream): cardinal;
// Подключиться к COM-порту
function ConnectCOM(ComPort: string): integer;
// отключиться от порта
procedure DisconnectCom;
// настроить параметры COM-порта (после подключения)
procedure ConfigCOM(baud, bits: integer; parity: char; stop: integer;
softflow, hardflow: boolean);
procedure ListenLine;
published
// время таймаута на прием ответа, мс
property TimeOutResponce: cardinal read FTimeOutResponce write SetTimeOutResponce;
// флаг "посылать контроллеру сообщения об ошибких"
property SendErrorMessage: boolean read FSendErrorMessage write SetSendErrorMessage;
// обработчик нормального ответа контроллера
property ResponceReadProcedure: TProcedureReadModbus
read FResponceReadProcedure write SetResponceReadProcedure;
// обработчик ошибки ответа контроллера
property ResponceError: TResponceError read FResponceError write SetResponceError;
// обработчик ошибки прослушивания линии
property ListenError: TListenError read FListenError write SetListenError;
{ TODO : удалить ObjectTag - не нужен }
property ObjectTag: integer read FObjectTag write SetObjectTag;
// мы - мастер (не нужно?)
property IsMaster: boolean read FIsMaster write SetIsMaster;
// максимальный размер пакета данных ModBus
property MaxSizePDU: cardinal read FMaxSizePDU write SetMaxSizePDU;
// время бездействия после окончания приема данных
property TimeToSleepRx: cardinal read FTimeToSleepRx write SetTimeToSleepRx;
// время (в мс) тишины до ошибки "прерванного ответа"
property ResponceBreakTime: cardinal read FResponceBreakTime write SetResponceBreakTime;
// флаг использования RTS для отправки данных
property RTS_use: boolean read FRTS_use write SetRTS_use;
// кол-во милисекунд от взведения RTS до отправки данных
property RTS_On_Delay: word read FRTS_On_Delay write SetRTS_On_Delay;
// кол-во милисекунд от отправки данных до выключения RTS
property RTS_Off_Delay: word read FRTS_Off_Delay write SetRTS_Off_Delay;
// вывод диагностических сообщений
property DiagStr: TDiagStr read FDiagStr write SetDiagStr;
end;
{ TTimerThread }
TTimerThread = class(TThread)
private
procedure Timer;
protected
procedure Execute; override;
public
StopTimer: Boolean;
mbrtu: TPascal_Modbus_RTU;
constructor Create(CreateSuspended: boolean);
end;
implementation
procedure Register;
begin
RegisterComponents('Modbus',[TPascal_Modbus_RTU]);
end;
Recent
