Examples/TCP_IP/MQTT_Broker/unit1.pas at master · PascalCorpsman/Examples · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
Unit Unit1;

{$MODE objfpc}{$H+}

Interface

Uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  lNetComponents, uMQTTbroker;

Type

  { TForm1 }

  TForm1 = Class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    CheckBox1: TCheckBox;
    LTCPComponent1: TLTCPComponent;
    Memo1: TMemo;
    Procedure Button1Click(Sender: TObject);
    Procedure Button2Click(Sender: TObject);
    Procedure Button3Click(Sender: TObject);
    Procedure Button4Click(Sender: TObject);
    Procedure FormCloseQuery(Sender: TObject; Var CanClose: Boolean);
    Procedure FormCreate(Sender: TObject);
  private
    fServer: TMQTTBroker;
    Procedure OnLog(Sender: TObject; ClientID: integer; aValue: String);
    Function OnSubscribeRequest(Sender: TObject; ClientID: integer; PackageIdentifier: uint16; Subscription: String): Treturn;
    Procedure OnUnSubscribeRequest(Sender: TObject; ClientID: integer; PackageIdentifier: uint16; Subscription: String);
    Procedure OnPublishRequest(Sender: TObject; ClientID: integer; aName, aPayload: String; DUP, Retain: Boolean);
    Procedure OnPing(Sender: TObject; ClientID: integer);
    Procedure OnAcceptMQTTClient(Sender: TObject; ClientID: integer);
  public

  End;

Var
  Form1: TForm1;

Implementation

{$R *.lfm}

{ TForm1 }

Procedure TForm1.Button1Click(Sender: TObject);
Begin
  If fServer.Listen() Then Begin
    Button1.Enabled := false;
  End;
End;

Procedure TForm1.Button2Click(Sender: TObject);
Begin
  fServer.Disconnect;
  button1.enabled := true;
End;

Procedure TForm1.Button3Click(Sender: TObject);
Begin
  Memo1.Clear;
End;

Procedure TForm1.Button4Click(Sender: TObject);
Begin
  close;
End;

Procedure TForm1.FormCloseQuery(Sender: TObject; Var CanClose: Boolean);
Begin
  fServer.Disconnect;
  fServer.CallAction();
  fServer.free;
End;

Procedure TForm1.FormCreate(Sender: TObject);
Begin
  fServer := TMQTTBroker.Create(LTCPComponent1);
  fserver.OnLog := @OnLog;
  fserver.OnSubscribeRequest := @OnSubscribeRequest;
  fserver.OnUnSubscribeRequest := @OnUnSubscribeRequest;
  fserver.OnPublishRequest := @OnPublishRequest;
  fserver.OnPingEvent := @OnPing;
  fserver.OnAcceptMQTTClient := @OnAcceptMQTTClient;
  memo1.Clear;
End;

Procedure TForm1.OnLog(Sender: TObject; ClientID: integer; aValue: String);
Var
  s: String;
Begin
  If ClientID <> 0 Then Begin
    aValue := '[' + inttostr(ClientID) + '] ' + aValue;
  End;
  If CheckBox1.Checked Then Begin
    s := FormatDateTime('YYYY.MM.DD HH:NN:SS', now) + ' ' + aValue;
  End
  Else Begin
    s := aValue;
  End;
  Memo1.Lines.Add(s);
End;

Function TForm1.OnSubscribeRequest(Sender: TObject; ClientID: integer;
  PackageIdentifier: uint16; Subscription: String): Treturn;
Begin
  Onlog(self, ClientID, 'Request subscription for: ' + Subscription);
  result := rQoS0;
End;

Procedure TForm1.OnUnSubscribeRequest(Sender: TObject; ClientID: integer;
  PackageIdentifier: uint16; Subscription: String);
Begin
  Onlog(self, ClientID, 'Request unsubscription for: ' + Subscription);
End;

Procedure TForm1.OnPublishRequest(Sender: TObject; ClientID: integer; aName,
  aPayload: String; DUP, Retain: Boolean);
Begin
  OnLog(self, ClientID, format('Publish: %s = %s', [aName, aPayload]));
End;

Procedure TForm1.OnPing(Sender: TObject; ClientID: integer);
Begin
  Onlog(self, ClientID, 'Ping from client');
End;

Procedure TForm1.OnAcceptMQTTClient(Sender: TObject; ClientID: integer);
Begin
  Onlog(self, ClientID, 'Accept client');
End;

End.