819 lines
26 KiB
Plaintext
819 lines
26 KiB
Plaintext
unit uMain;
|
||
|
||
interface
|
||
|
||
uses
|
||
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
|
||
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, CPort, Vcl.Menus, Vcl.ExtCtrls,
|
||
Vcl.ComCtrls, Vcl.Grids, Vcl.StdCtrls, System.IniFiles,
|
||
System.JSON, IdTCPClient, IdGlobal, IdComponent, UMQTTClient;
|
||
|
||
const
|
||
slvID = $01;
|
||
cmdRCR = $01;
|
||
cmdRHR = $03;
|
||
cmdFSC = $05;
|
||
cmdPSR = $06;
|
||
|
||
const
|
||
comm_shm_addr = 0;
|
||
commOK = 1;
|
||
commDisconnect = 0;
|
||
commError = 2;
|
||
manual_shm_addr = 10;
|
||
auto_shm_addr = 11;
|
||
rsON = 1;
|
||
rsOFF = 0;
|
||
valve01_ctrl_shm_addr = 35;
|
||
valve01_ctrlSts_shm_addr = 24;
|
||
vsOpen = 1;
|
||
vsClose = 0;
|
||
pulse_reset_shm_addr = 40;
|
||
SHM_SCHEDULE_OPERATING_AUTO = 50;
|
||
SHM_CTRL_SCHEDULE_OPERATING_AUTO = 51;
|
||
|
||
// Simplified shared memory class
|
||
type
|
||
TSharedMemory = class
|
||
private
|
||
FData: array[0..255] of Byte;
|
||
public
|
||
procedure Open;
|
||
procedure Close;
|
||
procedure SetB(address: Integer; value: Byte);
|
||
procedure SetR(address: Integer; value: Word);
|
||
function GetB(address: Integer): Byte;
|
||
function GetR(address: Integer): Word;
|
||
end;
|
||
|
||
type
|
||
TfMain = class(TForm)
|
||
Label1: TLabel;
|
||
Label2: TLabel;
|
||
Label3: TLabel;
|
||
Label4: TLabel;
|
||
Label5: TLabel;
|
||
Label6: TLabel;
|
||
Label7: TLabel;
|
||
Memo1: TMemo;
|
||
grid_di01: TStringGrid;
|
||
grid_di02: TStringGrid;
|
||
grid_do01: TStringGrid;
|
||
grid_do02: TStringGrid;
|
||
grid_pulse: TStringGrid;
|
||
grid_doCmd: TStringGrid;
|
||
StatusBar1: TStatusBar;
|
||
ReadTimer: TTimer;
|
||
initTimer: TTimer;
|
||
CtrlTimer: TTimer;
|
||
MainMenu1: TMainMenu;
|
||
File1: TMenuItem;
|
||
Exit1: TMenuItem;
|
||
Comm1: TMenuItem;
|
||
Open1: TMenuItem;
|
||
Close1: TMenuItem;
|
||
N1: TMenuItem;
|
||
AutoRun1: TMenuItem;
|
||
N3: TMenuItem;
|
||
AutoHide: TMenuItem;
|
||
PopupMenu1: TPopupMenu;
|
||
SHOW1: TMenuItem;
|
||
HIDE1: TMenuItem;
|
||
N2: TMenuItem;
|
||
EXIT2: TMenuItem;
|
||
ComPort1: TComPort;
|
||
Edit1: TEdit;
|
||
Edit2: TEdit;
|
||
Label8: TLabel;
|
||
Label9: TLabel;
|
||
procedure ComPort1AfterClose(Sender: TObject);
|
||
procedure ComPort1AfterOpen(Sender: TObject);
|
||
procedure ComPort1RxChar(Sender: TObject; Count: Integer);
|
||
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
||
procedure FormCreate(Sender: TObject);
|
||
procedure FormDestroy(Sender: TObject);
|
||
procedure grid_di01DrawCell(Sender: TObject; ACol, ARow: Integer;
|
||
Rect: TRect; State: TGridDrawState);
|
||
procedure grid_di02DrawCell(Sender: TObject; ACol, ARow: Integer;
|
||
Rect: TRect; State: TGridDrawState);
|
||
procedure grid_do01DrawCell(Sender: TObject; ACol, ARow: Integer;
|
||
Rect: TRect; State: TGridDrawState);
|
||
procedure grid_do02DrawCell(Sender: TObject; ACol, ARow: Integer;
|
||
Rect: TRect; State: TGridDrawState);
|
||
procedure grid_doCmdDrawCell(Sender: TObject; ACol, ARow: Integer;
|
||
Rect: TRect; State: TGridDrawState);
|
||
procedure Exit1Click(Sender: TObject);
|
||
procedure Open1Click(Sender: TObject);
|
||
procedure Close1Click(Sender: TObject);
|
||
procedure initTimerTimer(Sender: TObject);
|
||
procedure AutoRun1Click(Sender: TObject);
|
||
procedure CtrlTimerTimer(Sender: TObject);
|
||
procedure AutoHideClick(Sender: TObject);
|
||
procedure EXIT2Click(Sender: TObject);
|
||
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
||
procedure ReadTimerTimer(Sender: TObject);
|
||
private
|
||
{ Private declarations }
|
||
appPath, c_Port, db_ip, db_user, db_pw, ctrlID: string;
|
||
db_port: integer;
|
||
wrtList: TStrings;
|
||
req_flag, exit_flag: Boolean;
|
||
dPacket: array [1..255] of Byte;
|
||
com_step, packet_count, read_No, timeout_count: integer;
|
||
// MQTT
|
||
FMQTTClient: TMQTTClient;
|
||
// MQTT_Client: TIdTCPClient;
|
||
MQTT_Timer: TTimer;
|
||
mqtt_ip, mqtt_topicH, mqtt_topicT, mqtt_GtwyID: string;
|
||
mqtt_port: Integer;
|
||
prev_pulse: array[1..4] of Integer;
|
||
procedure MQTT_TimerTimer(Sender: TObject);
|
||
procedure SendMQTTData;
|
||
function CalculateCRC(data: array of Byte; length: Integer): Word;
|
||
procedure SendModbusRequest(slaveID, functionCode: Byte; startAddr, count: Word);
|
||
procedure SendModbusRTUCommand(DeviceID, FunctionCode: Byte; RegisterAddress, Value: Word);
|
||
procedure SendModbusRTUCoilCommand(DeviceID: Byte; CoilAddress: Word; CoilOn: Boolean);
|
||
procedure SendModbus(DeviceID, cmd: Byte; Address, Value: Word);
|
||
function GetBit(value: Byte; bitIndex: Integer): Byte;
|
||
procedure OnMQTTMessage(const ATopic, APayload: string);
|
||
procedure OnMQTTStatus(AConnected: Boolean);
|
||
public
|
||
{ Public declarations }
|
||
procedure printlog(_msg: string);
|
||
end;
|
||
|
||
var
|
||
fMain: TfMain;
|
||
SharedMem: TSharedMemory;
|
||
|
||
implementation
|
||
|
||
{$R *.dfm}
|
||
|
||
procedure TSharedMemory.Open;
|
||
begin
|
||
FillChar(FData, SizeOf(FData), 0);
|
||
end;
|
||
|
||
procedure TSharedMemory.Close;
|
||
begin
|
||
// Cleanup
|
||
end;
|
||
|
||
procedure TSharedMemory.SetB(address: Integer; value: Byte);
|
||
begin
|
||
if (address >= 0) and (address < 256) then
|
||
FData[address] := value;
|
||
end;
|
||
|
||
function TSharedMemory.GetB(address: Integer): Byte;
|
||
begin
|
||
if (address >= 0) and (address < 256) then
|
||
Result := FData[address]
|
||
else
|
||
Result := 0;
|
||
end;
|
||
|
||
procedure TSharedMemory.SetR(address: Integer; value: Word);
|
||
begin
|
||
if (address >= 0) and (address < 255) then
|
||
begin
|
||
FData[address] := Byte(value shr 8);
|
||
FData[address + 1] := Byte(value and $FF);
|
||
end;
|
||
end;
|
||
|
||
function TSharedMemory.GetR(address: Integer): Word;
|
||
begin
|
||
if (address >= 0) and (address < 255) then
|
||
Result := (FData[address] shl 8) or FData[address + 1]
|
||
else
|
||
Result := 0;
|
||
end;
|
||
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> MQTT <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
procedure TfMain.OnMQTTStatus(AConnected: Boolean);
|
||
begin
|
||
{
|
||
if AConnected then begin
|
||
lblConnectionStatus.Caption := 'Connected';
|
||
lblConnectionStatus.Font.Color := CLR_GREEN;
|
||
lblConnectionStatus.Tag := 1;
|
||
end else begin
|
||
lblConnectionStatus.Caption := 'Disconnected';
|
||
lblConnectionStatus.Font.Color := CLR_RED;
|
||
lblConnectionStatus.Tag := 2;
|
||
mmMQTTmsg.Lines.Add('Connection Error - Connection to server was lost.');
|
||
end;
|
||
}
|
||
end;
|
||
|
||
procedure TfMain.OnMQTTMessage(const ATopic, APayload: string);
|
||
var
|
||
JsonObj: TJSONObject;
|
||
i, DONum: Integer;
|
||
Pair: TJSONPair;
|
||
KeyStr, ValStr: string;
|
||
begin
|
||
// mmMQTTmsg.Lines.Add(ATopic+' '+APayload);
|
||
Edit2.Text := ATopic+' '+APayload;
|
||
|
||
try
|
||
JsonObj := TJSONObject.ParseJSONValue(APayload) as TJSONObject;
|
||
if Assigned(JsonObj) then
|
||
begin
|
||
try
|
||
for i := 0 to JsonObj.Count - 1 do
|
||
begin
|
||
Pair := JsonObj.Pairs[i];
|
||
KeyStr := Pair.JsonString.Value;
|
||
ValStr := Pair.JsonValue.Value;
|
||
|
||
if (Length(KeyStr) >= 5) and (Copy(KeyStr, 1, 3) = 'DO_') then
|
||
begin
|
||
DONum := StrToIntDef(Copy(KeyStr, 4, Length(KeyStr) - 3), -1);
|
||
if DONum >= 0 then
|
||
begin
|
||
if ValStr = '1' then
|
||
SendModbus(slvID, cmdFSC, 35 + DONum, 1)
|
||
else if ValStr = '0' then
|
||
SendModbus(slvID, cmdFSC, 35 + DONum, 0);
|
||
end;
|
||
end;
|
||
end;
|
||
finally
|
||
JsonObj.Free;
|
||
end;
|
||
end;
|
||
except
|
||
on E: Exception do printlog('MQTT Msg Error: ' + E.Message);
|
||
end;
|
||
end;
|
||
|
||
procedure TfMain.ComPort1AfterClose(Sender: TObject);
|
||
begin
|
||
printlog('Comm Close');
|
||
ReadTimer.Enabled := false;
|
||
Open1.Enabled := True;
|
||
Close1.Enabled := False;
|
||
end;
|
||
|
||
procedure TfMain.ComPort1AfterOpen(Sender: TObject);
|
||
begin
|
||
printlog('Comm Open');
|
||
packet_count := 0;
|
||
read_No := 0;
|
||
timeout_count := 0;
|
||
req_flag := true;
|
||
ReadTimer.Enabled := True;
|
||
Open1.Enabled := False;
|
||
Close1.Enabled := True;
|
||
end;
|
||
|
||
procedure TfMain.ComPort1RxChar(Sender: TObject; Count: Integer);
|
||
var
|
||
S: string;
|
||
i, dVal, p, shm_addr: integer;
|
||
noofdata, mVal: word;
|
||
tmp_mVal: array [0..1] of byte;
|
||
b: Byte;
|
||
Buffer: array of Byte;
|
||
begin
|
||
SetLength(Buffer, Count);
|
||
ComPort1.Read(Buffer[0], Count);
|
||
S := '';
|
||
for i := 0 to Count - 1 do S := S + Char(Buffer[i]);
|
||
|
||
case read_No of
|
||
0:
|
||
begin
|
||
for i := 0 to Count - 1 do
|
||
begin
|
||
Inc(packet_count, 1);
|
||
if packet_count >= 25 then
|
||
begin
|
||
if (dPacket[1] = slvID) and (dPacket[2] = cmdRHR) and (dPacket[3] = $14) then
|
||
begin
|
||
noofdata := dPacket[3] div 2;
|
||
for p := 1 to 4 do
|
||
begin
|
||
FillChar(tmp_mVal, sizeof(tmp_mVal), 0);
|
||
tmp_mVal[1] := dPacket[4 + (p - 1) * 2];
|
||
tmp_mVal[0] := dPacket[5 + (p - 1) * 2];
|
||
Move(tmp_mVal[0], mVal, 2);
|
||
SharedMem.SetR(p - 1, mVal);
|
||
grid_pulse.Cells[1, p] := inttostr(mVal);
|
||
end;
|
||
printlog('*************************** Read Word Complete');
|
||
FillChar(dPacket[1], Sizeof(dPacket), 0);
|
||
read_No := 1; packet_count := 0; timeout_count := 0; req_flag := true;
|
||
end;
|
||
end
|
||
else dPacket[packet_count] := Buffer[i];
|
||
end;
|
||
end;
|
||
1:
|
||
begin
|
||
for i := 0 to Count - 1 do
|
||
begin
|
||
Inc(packet_count, 1);
|
||
if packet_count >= 12 then
|
||
begin
|
||
if (dPacket[1] = slvID) and (dPacket[2] = cmdRCR) and (dPacket[3] = $07) then
|
||
begin
|
||
shm_addr := 0;
|
||
dVal := dPacket[4];
|
||
for p := 0 to 7 do begin
|
||
b := GetBit(dVal, p); grid_di01.Cells[1, p + 1] := IntToStr(b);
|
||
SharedMem.SetB(shm_addr, b); Inc(shm_addr, 1);
|
||
end;
|
||
dVal := dPacket[5];
|
||
for p := 0 to 7 do begin
|
||
b := GetBit(dVal, p); grid_di02.Cells[1, p + 1] := IntToStr(b);
|
||
SharedMem.SetB(shm_addr, b); Inc(shm_addr, 1);
|
||
end;
|
||
dVal := dPacket[6];
|
||
for p := 0 to 7 do begin
|
||
b := GetBit(dVal, p); grid_do01.Cells[1, p + 1] := IntToStr(b);
|
||
SharedMem.SetB(shm_addr, b); Inc(shm_addr, 1);
|
||
end;
|
||
dVal := dPacket[7];
|
||
for p := 0 to 7 do begin
|
||
b := GetBit(dVal, p); grid_do02.Cells[1, p + 1] := IntToStr(b);
|
||
SharedMem.SetB(shm_addr, b); Inc(shm_addr, 1);
|
||
end;
|
||
dVal := dPacket[8];
|
||
for p := 0 to 7 do begin
|
||
b := GetBit(dVal, p); grid_doCmd.Cells[p + 1, 1] := IntToStr(b); Inc(shm_addr, 1);
|
||
end;
|
||
dVal := dPacket[9];
|
||
for p := 0 to 7 do begin
|
||
b := GetBit(dVal, p); grid_doCmd.Cells[p + 9, 1] := IntToStr(b); Inc(shm_addr, 1);
|
||
end;
|
||
printlog('*************************** Read Coil Complete');
|
||
FillChar(dPacket[1], Sizeof(dPacket), 0);
|
||
read_No := 0; packet_count := 0; timeout_count := 0; req_flag := true;
|
||
end;
|
||
end
|
||
else dPacket[packet_count] := Buffer[i];
|
||
end;
|
||
end;
|
||
2:
|
||
begin
|
||
for i := 0 to Count - 1 do
|
||
begin
|
||
Inc(packet_count, 1);
|
||
if packet_count >= 8 then
|
||
begin
|
||
if (dPacket[1] = slvID) and ((dPacket[2] = cmdFSC) or (dPacket[2] = cmdPSR)) then
|
||
begin
|
||
FillChar(dPacket[1], Sizeof(dPacket), 0);
|
||
read_No := 0; packet_count := 0; timeout_count := 0; req_flag := true;
|
||
end;
|
||
end
|
||
else dPacket[packet_count] := Buffer[i];
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TfMain.FormClose(Sender: TObject; var Action: TCloseAction);
|
||
begin
|
||
ReadTimer.Enabled := False;
|
||
if Comport1.Connected then Comport1.Close;
|
||
SharedMem.Close;
|
||
end;
|
||
|
||
procedure TfMain.FormCreate(Sender: TObject);
|
||
begin
|
||
appPath := ExtractFilepath(Application.ExeName);
|
||
wrtList := TStringList.Create;
|
||
SharedMem := TSharedMemory.Create;
|
||
// MQTT_Client := TIdTCPClient.Create(nil);
|
||
MQTT_Timer := TTimer.Create(nil);
|
||
MQTT_Timer.Enabled := False;
|
||
MQTT_Timer.Interval := 1000;
|
||
MQTT_Timer.OnTimer := MQTT_TimerTimer;
|
||
prev_pulse[1] := -1;
|
||
prev_pulse[2] := -1;
|
||
prev_pulse[3] := -1;
|
||
prev_pulse[4] := -1;
|
||
end;
|
||
|
||
procedure TfMain.FormDestroy(Sender: TObject);
|
||
begin
|
||
wrtList.Free;
|
||
SharedMem.Free;
|
||
// MQTT_Client.Free;
|
||
if FMQTTClient <> nil then begin
|
||
FMQTTClient.OnMessage := nil;
|
||
FMQTTClient.OnStatus := nil;
|
||
FMQTTClient.Disconnect;
|
||
FreeAndNil(FMQTTClient);
|
||
end;
|
||
MQTT_Timer.Free;
|
||
end;
|
||
|
||
procedure TfMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
||
begin
|
||
CanClose := exit_flag;
|
||
end;
|
||
|
||
procedure TfMain.Exit1Click(Sender: TObject);
|
||
begin
|
||
exit_flag := true;
|
||
fMain.close;
|
||
end;
|
||
|
||
procedure TfMain.EXIT2Click(Sender: TObject);
|
||
begin
|
||
exit_flag := true;
|
||
fMain.Close;
|
||
end;
|
||
|
||
procedure TfMain.CtrlTimerTimer(Sender: TObject);
|
||
var i: integer;
|
||
begin
|
||
if (ComPort1.Connected) then begin
|
||
if SharedMem.GetB(auto_shm_addr) = rsON then begin
|
||
for i := 0 to 7 do begin
|
||
if (SharedMem.GetB(valve01_ctrl_shm_addr + i) = vsOpen) and (SharedMem.GetB(valve01_ctrlSts_shm_addr + i) = vsClose) then
|
||
SendModbus(slvID, cmdFSC, valve01_ctrl_shm_addr + i, vsOpen)
|
||
else if (SharedMem.GetB(valve01_ctrl_shm_addr + i) = vsClose) and (SharedMem.GetB(valve01_ctrlSts_shm_addr + i) = vsOpen) then
|
||
SendModbus(slvID, cmdFSC, valve01_ctrl_shm_addr + i, vsClose);
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TfMain.AutoRun1Click(Sender: TObject);
|
||
var ini: Tinifile;
|
||
begin
|
||
AutoRun1.Checked := not AutoRun1.Checked;
|
||
ini := TInifile.Create(appPath + 'xFarm.ini');
|
||
if AutoRun1.Checked then ini.WriteString('COMM', 'AUTO_RUN', 'YES')
|
||
else ini.WriteString('COMM', 'AUTO_RUN', 'NO');
|
||
ini.Free;
|
||
end;
|
||
|
||
procedure TfMain.grid_di01DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
|
||
begin
|
||
if (ARow > 0) and (ACol > 0) then begin
|
||
if StrToIntDef(grid_di01.Cells[ACol, ARow], 0) = 0 then grid_di01.Canvas.Brush.Color := clWhite
|
||
else grid_di01.Canvas.Brush.Color := clRed;
|
||
grid_di01.Canvas.FillRect(Rect);
|
||
grid_di01.Canvas.TextOut(Rect.Left + 2, Rect.Top + 2, grid_di01.Cells[ACol, ARow]);
|
||
end;
|
||
end;
|
||
|
||
procedure TfMain.grid_di02DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
|
||
begin
|
||
if (ARow > 0) and (ACol > 0) then begin
|
||
if StrToIntDef(grid_di02.Cells[ACol, ARow], 0) = 0 then grid_di02.Canvas.Brush.Color := clWhite
|
||
else grid_di02.Canvas.Brush.Color := clRed;
|
||
grid_di02.Canvas.FillRect(Rect);
|
||
grid_di02.Canvas.TextOut(Rect.Left + 2, Rect.Top + 2, grid_di02.Cells[ACol, ARow]);
|
||
end;
|
||
end;
|
||
|
||
procedure TfMain.grid_do01DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
|
||
begin
|
||
if (ARow > 0) and (ACol > 0) then begin
|
||
if StrToIntDef(grid_do01.Cells[ACol, ARow], 0) = 0 then grid_do01.Canvas.Brush.Color := clWhite
|
||
else grid_do01.Canvas.Brush.Color := clRed;
|
||
grid_do01.Canvas.FillRect(Rect);
|
||
grid_do01.Canvas.TextOut(Rect.Left + 2, Rect.Top + 2, grid_do01.Cells[ACol, ARow]);
|
||
end;
|
||
end;
|
||
|
||
procedure TfMain.grid_do02DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
|
||
begin
|
||
if (ARow > 0) and (ACol > 0) then begin
|
||
if StrToIntDef(grid_do02.Cells[ACol, ARow], 0) = 0 then grid_do02.Canvas.Brush.Color := clWhite
|
||
else grid_do02.Canvas.Brush.Color := clRed;
|
||
grid_do02.Canvas.FillRect(Rect);
|
||
grid_do02.Canvas.TextOut(Rect.Left + 2, Rect.Top + 2, grid_do02.Cells[ACol, ARow]);
|
||
end;
|
||
end;
|
||
|
||
procedure TfMain.grid_doCmdDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
|
||
begin
|
||
if (ARow > 0) and (ACol > 0) then begin
|
||
if StrToIntDef(grid_doCmd.Cells[ACol, ARow], 0) = 0 then grid_doCmd.Canvas.Brush.Color := clWhite
|
||
else grid_doCmd.Canvas.Brush.Color := clRed;
|
||
grid_doCmd.Canvas.FillRect(Rect);
|
||
grid_doCmd.Canvas.TextOut(Rect.Left + 2, Rect.Top + 2, grid_doCmd.Cells[ACol, ARow]);
|
||
end;
|
||
end;
|
||
|
||
procedure TfMain.AutoHideClick(Sender: TObject);
|
||
var
|
||
ini: Tinifile;
|
||
begin
|
||
AutoHide.Checked := not AutoHide.Checked;
|
||
ini := TInifile.Create(appPath + 'xFarm.ini');
|
||
if AutoHide.Checked then ini.WriteString('COMM', 'AUTO_HIDE', 'YES')
|
||
else ini.WriteString('COMM', 'AUTO_HIDE', 'NO');
|
||
ini.Free;
|
||
end;
|
||
|
||
procedure TfMain.initTimerTimer(Sender: TObject);
|
||
var
|
||
ini: Tinifile;
|
||
auto_run, auto_hide: string;
|
||
begin
|
||
exit_flag := false;
|
||
SharedMem.Open;
|
||
Memo1.Clear;
|
||
ini := TInifile.Create(appPath + 'xFarm.ini');
|
||
with ini do begin
|
||
ctrlID := ReadString('CONTROLER', 'CODE', '');
|
||
c_Port := ReadString('COMM', 'PORT', 'COM7');
|
||
auto_run := ReadString('COMM', 'AUTO_RUN', 'NO');
|
||
auto_hide := ReadString('COMM', 'AUTO_HIDE', 'NO');
|
||
db_ip := ReadString('DB', 'IP', '127.0.0.1');
|
||
db_user := ReadString('DB', 'USER', 'root');
|
||
db_pw := ReadString('DB', 'PW', '1233');
|
||
db_port := ReadInteger('DB', 'PORT', 3306);
|
||
mqtt_ip := ReadString('MQTT', 'IP', '192.168.200.240');
|
||
mqtt_port := ReadInteger('MQTT', 'PORT', 1883);
|
||
// mqtt_topic := ReadString('MQTT', 'TOPIC', 'SMART-FARM/2/3/2/PUB/1/1/0/GTW/1001');
|
||
mqtt_topicH := ReadString('MQTT', 'TOPICH', 'SMART-FARM/2/3/2/');
|
||
mqtt_topicT := ReadString('MQTT', 'TOPICT', '/1/1/0/GTW/');
|
||
mqtt_GtwyID := ReadString('MQTT', 'GtwyID', '1001');
|
||
end;
|
||
ini.Free;
|
||
|
||
FMQTTClient := TMQTTClient.Create(mqtt_ip, mqtt_port, 'SmartFarmHMI');
|
||
FMQTTClient.OnMessage := OnMQTTMessage;
|
||
FMQTTClient.OnStatus := OnMQTTStatus;
|
||
// FMQTTClient.Subscribe(mqtt_topic);
|
||
// FMQTTClient.Subscribe(ReplaceAll(mqtt_topic,'PUB','SUB'));
|
||
FMQTTClient.Subscribe(mqtt_topicH+'SUB'+mqtt_topicT+mqtt_GtwyID);
|
||
FMQTTClient.Connect;
|
||
|
||
MQTT_Timer.Enabled := True;
|
||
|
||
StatusBar1.Panels.Items[3].Text := c_Port;
|
||
StatusBar1.Panels.Items[4].Text := ctrlID;
|
||
Comport1.Port := c_Port;
|
||
if upperCase(Trim(auto_run)) = 'YES' then begin
|
||
AutoRun1.Checked := True;
|
||
if not Comport1.Connected then Comport1.Open;
|
||
end else AutoRun1.Checked := False;
|
||
if upperCase(Trim(auto_hide)) = 'YES' then AutoHide.Checked := True
|
||
else AutoHide.Checked := False;
|
||
initTimer.Enabled := False;
|
||
end;
|
||
|
||
procedure TfMain.Close1Click(Sender: TObject);
|
||
begin
|
||
if ComPort1.Connected then ComPort1.Close;
|
||
end;
|
||
|
||
procedure TfMain.Open1Click(Sender: TObject);
|
||
begin
|
||
if not Comport1.Connected then ComPort1.Open;
|
||
end;
|
||
|
||
function TfMain.GetBit(value: Byte; bitIndex: Integer): Byte;
|
||
begin
|
||
if (bitIndex >= 0) and (bitIndex <= 7) then Result := (value shr bitIndex) and 1
|
||
else Result := 0;
|
||
end;
|
||
|
||
function TfMain.CalculateCRC(data: array of Byte; length: Integer): Word;
|
||
var i, j: Integer; crc: Word;
|
||
begin
|
||
crc := $FFFF;
|
||
for i := 0 to length - 1 do begin
|
||
crc := crc xor data[i];
|
||
for j := 0 to 7 do begin
|
||
if (crc and 1) <> 0 then crc := (crc shr 1) xor $A001
|
||
else crc := crc shr 1;
|
||
end;
|
||
end;
|
||
Result := crc;
|
||
end;
|
||
|
||
procedure TfMain.SendModbusRequest(slaveID, functionCode: Byte; startAddr, count: Word);
|
||
var request: array[0..7] of Byte; crc: Word;
|
||
begin
|
||
request[0] := slaveID; request[1] := functionCode;
|
||
request[2] := Hi(startAddr); request[3] := Lo(startAddr);
|
||
request[4] := Hi(count); request[5] := Lo(count);
|
||
crc := CalculateCRC(request, 6);
|
||
request[6] := Lo(crc); request[7] := Hi(crc);
|
||
ComPort1.Write(request, 8);
|
||
end;
|
||
|
||
procedure TfMain.SendModbus(DeviceID, cmd: Byte; Address, Value: Word);
|
||
var snddata: string;
|
||
begin
|
||
if not ComPort1.Connected then exit;
|
||
snddata := format('%d,%d,%d,%d', [DeviceID, cmd, Address, Value]);
|
||
wrtList.Add(snddata);
|
||
end;
|
||
|
||
procedure TfMain.SendModbusRTUCoilCommand(DeviceID: Byte; CoilAddress: Word; CoilOn: Boolean);
|
||
var Frame: array[0..7] of Byte; crc, CoilValue: Word;
|
||
begin
|
||
if CoilOn then CoilValue := $FF00 else CoilValue := $0000;
|
||
Frame[0] := DeviceID; Frame[1] := cmdFSC;
|
||
Frame[2] := Hi(CoilAddress); Frame[3] := Lo(CoilAddress);
|
||
Frame[4] := Hi(CoilValue); Frame[5] := Lo(CoilValue);
|
||
crc := CalculateCRC(Frame, 6);
|
||
Frame[6] := Lo(crc); Frame[7] := Hi(crc);
|
||
if ComPort1.Connected then begin
|
||
ComPort1.Write(Frame, SizeOf(Frame));
|
||
printlog('[Coil Write]' + format('[%d]=[%d]', [CoilAddress, CoilValue]));
|
||
end;
|
||
end;
|
||
|
||
procedure TfMain.SendModbusRTUCommand(DeviceID, FunctionCode: Byte; RegisterAddress, Value: Word);
|
||
var Frame: array[0..7] of Byte; crc: Word;
|
||
begin
|
||
Frame[0] := DeviceID; Frame[1] := FunctionCode;
|
||
Frame[2] := Hi(RegisterAddress); Frame[3] := Lo(RegisterAddress);
|
||
Frame[4] := Hi(Value); Frame[5] := Lo(Value);
|
||
crc := CalculateCRC(Frame, 6);
|
||
Frame[6] := Lo(crc); Frame[7] := Hi(crc);
|
||
if ComPort1.Connected then begin
|
||
ComPort1.Write(Frame, SizeOf(Frame));
|
||
printlog('[Register Write]' + format('[%d]=[%d]', [RegisterAddress, Value]));
|
||
end;
|
||
end;
|
||
|
||
procedure TfMain.printlog(_msg: string);
|
||
var S: string;
|
||
begin
|
||
if Memo1.Lines.Count > 1000 then Memo1.Clear;
|
||
S := formatdatetime('dd hh:nn:ss', now()) + '->' + _msg;
|
||
Memo1.Lines.Add(S);
|
||
end;
|
||
|
||
procedure TfMain.ReadTimerTimer(Sender: TObject);
|
||
var
|
||
wrtCmd, devID: Byte;
|
||
wrtAddress, wrtValue: word;
|
||
S: string;
|
||
begin
|
||
if (ComPort1.Connected) then SharedMem.SetB(comm_shm_addr, commOK)
|
||
else SharedMem.SetB(comm_shm_addr, commDisconnect);
|
||
|
||
if (ComPort1.Connected) and (req_flag) then
|
||
begin
|
||
req_flag := false;
|
||
packet_count := 0;
|
||
FillChar(dPacket[1], Sizeof(dPacket), 0);
|
||
|
||
if wrtList.Count > 0 then
|
||
begin
|
||
read_No := 2;
|
||
S := wrtList[0];
|
||
wrtList.Delete(0);
|
||
devID := StrToIntDef(copy(S, 1, Pos(',', S) - 1), $01);
|
||
delete(S, 1, Pos(',', S));
|
||
wrtCmd := StrToIntDef(copy(S, 1, Pos(',', S) - 1), $06);
|
||
delete(S, 1, Pos(',', S));
|
||
wrtAddress := StrToIntDef(copy(S, 1, Pos(',', S) - 1), $0000);
|
||
delete(S, 1, Pos(',', S));
|
||
wrtValue := StrToIntDef(S, 0);
|
||
|
||
case wrtCmd of
|
||
cmdFSC:
|
||
begin
|
||
if wrtValue = $01 then SendModbusRTUCoilCommand(devID, wrtAddress, True)
|
||
else SendModbusRTUCoilCommand(devID, wrtAddress, False);
|
||
StatusBar1.Panels.Items[1].Text := 'Write Coil';
|
||
end;
|
||
cmdPSR:
|
||
begin
|
||
SendModbusRTUCommand(devID, wrtCmd, wrtAddress, wrtValue);
|
||
StatusBar1.Panels.Items[1].Text := 'Write Reg';
|
||
end;
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
case read_No of
|
||
0:
|
||
begin
|
||
SendModbusRequest(slvID, cmdRHR, $0000, $0A);
|
||
StatusBar1.Panels.Items[1].Text := 'Read Reg';
|
||
end;
|
||
1:
|
||
begin
|
||
SendModbusRequest(slvID, cmdRCR, $0000, $38);
|
||
StatusBar1.Panels.Items[1].Text := 'Read Coil';
|
||
end;
|
||
end;
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
Inc(timeout_count, 1);
|
||
if timeout_count > 30 then
|
||
begin
|
||
packet_count := 0;
|
||
read_No := 0;
|
||
timeout_count := 0;
|
||
FillChar(dPacket[1], Sizeof(dPacket), 0);
|
||
req_flag := true;
|
||
if Comport1.Connected then SharedMem.SetB(comm_shm_addr, commError);
|
||
printlog('Time Out ---------------');
|
||
end;
|
||
StatusBar1.Panels.Items[2].Text := inttostr(timeout_count);
|
||
end;
|
||
end;
|
||
|
||
procedure TfMain.MQTT_TimerTimer(Sender: TObject);
|
||
begin
|
||
SendMQTTData;
|
||
end;
|
||
|
||
procedure TfMain.SendMQTTData;
|
||
var
|
||
JsonObj: TJSONObject;
|
||
DI, DOs, AI: string;
|
||
p: integer;
|
||
curr_pulse, pulse_diff: Integer;
|
||
Payload: string;
|
||
Buffer: TIdBytes;
|
||
TopicBytes, PayloadBytes: TIdBytes;
|
||
RemLen: Integer;
|
||
begin
|
||
// if not Assigned(MQTT_Client) then Exit;
|
||
if not Assigned(FMQTTClient) then Exit;
|
||
DI := '';
|
||
for p := 1 to 8 do DI := DI + IntToStr(StrToIntDef(grid_di01.Cells[1, p], 0)) + '|';
|
||
for p := 1 to 8 do DI := DI + IntToStr(StrToIntDef(grid_di02.Cells[1, p], 0)) + '|';
|
||
if Length(DI) > 0 then Delete(DI, Length(DI), 1);
|
||
DOs := '';
|
||
for p := 1 to 8 do DOs := DOs + IntToStr(StrToIntDef(grid_do02.Cells[1, p], 0)) + '|';
|
||
for p := 1 to 8 do DOs := DOs + IntToStr(StrToIntDef(grid_do01.Cells[1, p], 0)) + '|';
|
||
if Length(DOs) > 0 then Delete(DOs, Length(DOs), 1);
|
||
AI := '';
|
||
for p := 1 to 4 do begin
|
||
curr_pulse := StrToIntDef(grid_pulse.Cells[1, p], 0);
|
||
if p >= 3 then begin
|
||
if prev_pulse[p] = -1 then pulse_diff := 0
|
||
else begin
|
||
pulse_diff := curr_pulse - prev_pulse[p];
|
||
if pulse_diff < 0 then pulse_diff := curr_pulse;
|
||
end;
|
||
AI := AI + IntToStr(pulse_diff) + '|';
|
||
end;
|
||
prev_pulse[p] := curr_pulse;
|
||
end;
|
||
if Length(AI) > 0 then Delete(AI, Length(AI), 1);
|
||
JsonObj := TJSONObject.Create;
|
||
try
|
||
JsonObj.AddPair('DI', DI); JsonObj.AddPair('DO', DOs); JsonObj.AddPair('AI', AI);
|
||
JsonObj.AddPair('HM', '0|0|0|0|0'); JsonObj.AddPair('TM', '0|0|0|0|0');
|
||
JsonObj.AddPair('CD', '0|0|0|0|0'); JsonObj.AddPair('NT', '0|0|0|0|0');
|
||
JsonObj.AddPair('PH', '0|0|0|0|0'); JsonObj.AddPair('GT', '0|0|0|0|0');
|
||
JsonObj.AddPair('GM', '0|0|0|0|0'); JsonObj.AddPair('GNT', '0|0|0|0|0');
|
||
JsonObj.AddPair('WP', '0|0|0|0|0'); JsonObj.AddPair('GT2', '0|0|0|0|0');
|
||
Payload := JsonObj.ToString;
|
||
finally JsonObj.Free; end;
|
||
try
|
||
// if not MQTT_Client.Connected then begin
|
||
if not FMQTTClient.Connected then begin
|
||
FMQTTClient.Host := mqtt_ip;
|
||
FMQTTClient.Port := mqtt_port;
|
||
FMQTTClient.Connect;
|
||
{
|
||
SetLength(Buffer, 0); AppendByte(Buffer, $10);
|
||
AppendByte(Buffer, 12 + 4); AppendByte(Buffer, 0); AppendByte(Buffer, 4);
|
||
AppendBytes(Buffer, ToBytes('MQTT', enUTF8)); AppendByte(Buffer, 4);
|
||
AppendByte(Buffer, 2); AppendByte(Buffer, 0); AppendByte(Buffer, 60);
|
||
AppendByte(Buffer, 0); AppendByte(Buffer, 4); AppendBytes(Buffer, ToBytes('PLC1', enUTF8));
|
||
FMQTTClient.IOHandler.Write(Buffer); Sleep(100);
|
||
}
|
||
end;
|
||
if FMQTTClient.Connected then begin
|
||
{
|
||
TopicBytes := ToBytes(mqtt_topic, enUTF8); PayloadBytes := ToBytes(Payload, enUTF8);
|
||
RemLen := 2 + Length(TopicBytes) + Length(PayloadBytes);
|
||
SetLength(Buffer, 0); AppendByte(Buffer, $30);
|
||
if (RemLen < 128) then AppendByte(Buffer, Byte(RemLen))
|
||
else begin
|
||
AppendByte(Buffer, Byte((RemLen mod 128) or $80));
|
||
AppendByte(Buffer, Byte(RemLen div 128));
|
||
end;
|
||
AppendByte(Buffer, Hi(Word(Length(TopicBytes)))); AppendByte(Buffer, Lo(Word(Length(TopicBytes))));
|
||
AppendBytes(Buffer, TopicBytes); AppendBytes(Buffer, PayloadBytes);
|
||
MQTT_Client.IOHandler.Write(Buffer);
|
||
}
|
||
|
||
FMQTTClient.Publish(mqtt_topicH+'PUB'+mqtt_topicT+mqtt_GtwyID, Payload);
|
||
|
||
Edit1.Text := Payload;
|
||
end;
|
||
except on E: Exception do printlog('MQTT Error: ' + E.Message); end;
|
||
end;
|
||
|
||
end.
|
||
|