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;

// 式式式 MQTT 式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式式
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.