Skip to content

Commit 883e245

Browse files
PascalCorpsmanPascalCorpsman
committed
Add demo MQTT broker
1 parent ec7ed04 commit 883e245

File tree

4 files changed

+335
-0
lines changed

4 files changed

+335
-0
lines changed

‎TCP_IP/MQTT_Broker/project1.lpi

Lines changed: 100 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,100 @@
1+
<?xml version="1.0" encoding="UTF-8"?>
2+
<CONFIG>
3+
<ProjectOptions>
4+
<Version Value="12"/>
5+
<General>
6+
<SessionStorage Value="InProjectDir"/>
7+
<Title Value="project1"/>
8+
<Scaled Value="True"/>
9+
<ResourceType Value="res"/>
10+
<UseXPManifest Value="True"/>
11+
<XPManifest>
12+
<DpiAware Value="True"/>
13+
</XPManifest>
14+
</General>
15+
<BuildModes>
16+
<Item Name="Default" Default="True"/>
17+
</BuildModes>
18+
<PublishOptions>
19+
<Version Value="2"/>
20+
<UseFileFilters Value="True"/>
21+
</PublishOptions>
22+
<RunParams>
23+
<FormatVersion Value="2"/>
24+
</RunParams>
25+
<RequiredPackages>
26+
<Item>
27+
<PackageName Value="lnetvisual"/>
28+
</Item>
29+
<Item>
30+
<PackageName Value="LCL"/>
31+
</Item>
32+
</RequiredPackages>
33+
<Units>
34+
<Unit>
35+
<Filename Value="project1.lpr"/>
36+
<IsPartOfProject Value="True"/>
37+
</Unit>
38+
<Unit>
39+
<Filename Value="unit1.pas"/>
40+
<IsPartOfProject Value="True"/>
41+
<ComponentName Value="Form1"/>
42+
<HasResources Value="True"/>
43+
<ResourceBaseClass Value="Form"/>
44+
<UnitName Value="Unit1"/>
45+
</Unit>
46+
<Unit>
47+
<Filename Value="../uMQTTbroker.pas"/>
48+
<IsPartOfProject Value="True"/>
49+
</Unit>
50+
</Units>
51+
</ProjectOptions>
52+
<CompilerOptions>
53+
<Version Value="11"/>
54+
<Target>
55+
<Filename Value="project1"/>
56+
</Target>
57+
<SearchPaths>
58+
<IncludeFiles Value="$(ProjOutDir)"/>
59+
<OtherUnitFiles Value=".."/>
60+
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
61+
</SearchPaths>
62+
<Parsing>
63+
<SyntaxOptions>
64+
<IncludeAssertionCode Value="True"/>
65+
</SyntaxOptions>
66+
</Parsing>
67+
<CodeGeneration>
68+
<Checks>
69+
<IOChecks Value="True"/>
70+
<RangeChecks Value="True"/>
71+
<OverflowChecks Value="True"/>
72+
<StackChecks Value="True"/>
73+
</Checks>
74+
<VerifyObjMethodCallValidity Value="True"/>
75+
</CodeGeneration>
76+
<Linking>
77+
<Debugging>
78+
<UseHeaptrc Value="True"/>
79+
</Debugging>
80+
<Options>
81+
<Win32>
82+
<GraphicApplication Value="True"/>
83+
</Win32>
84+
</Options>
85+
</Linking>
86+
</CompilerOptions>
87+
<Debugging>
88+
<Exceptions>
89+
<Item>
90+
<Name Value="EAbort"/>
91+
</Item>
92+
<Item>
93+
<Name Value="ECodetoolError"/>
94+
</Item>
95+
<Item>
96+
<Name Value="EFOpenError"/>
97+
</Item>
98+
</Exceptions>
99+
</Debugging>
100+
</CONFIG>

‎TCP_IP/MQTT_Broker/project1.lpr

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
program project1;
2+
3+
{$mode objfpc}{$H+}
4+
5+
uses
6+
{$IFDEF UNIX}
7+
cthreads,
8+
{$ENDIF}
9+
{$IFDEF HASAMIGA}
10+
athreads,
11+
{$ENDIF}
12+
Interfaces, // this includes the LCL widgetset
13+
Forms, Unit1, uMQTTbroker, lnetvisual;
14+
15+
{$R *.res}
16+
17+
begin
18+
RequireDerivedFormResource:=True;
19+
Application.Scaled:=True;
20+
Application.Initialize;
21+
Application.CreateForm(TForm1, Form1);
22+
Application.Run;
23+
end.
24+

‎TCP_IP/MQTT_Broker/unit1.lfm

Lines changed: 81 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,81 @@
1+
object Form1: TForm1
2+
Left = 347
3+
Height = 733
4+
Top = 107
5+
Width = 886
6+
Caption = 'Listen'
7+
ClientHeight = 733
8+
ClientWidth = 886
9+
OnCloseQuery = FormCloseQuery
10+
OnCreate = FormCreate
11+
LCLVersion = '2.3.0.0'
12+
object Button1: TButton
13+
Left = 8
14+
Height = 25
15+
Top = 8
16+
Width = 75
17+
Caption = 'Listen'
18+
OnClick = Button1Click
19+
TabOrder = 0
20+
end
21+
object Memo1: TMemo
22+
Left = 8
23+
Height = 648
24+
Top = 40
25+
Width = 872
26+
Anchors = [akTop, akLeft, akRight, akBottom]
27+
Font.Name = 'Courier New'
28+
Lines.Strings = (
29+
'Memo1'
30+
)
31+
ParentFont = False
32+
ScrollBars = ssAutoBoth
33+
TabOrder = 1
34+
WordWrap = False
35+
end
36+
object Button2: TButton
37+
Left = 160
38+
Height = 25
39+
Top = 8
40+
Width = 75
41+
Caption = 'Disconnect'
42+
OnClick = Button2Click
43+
TabOrder = 2
44+
end
45+
object Button3: TButton
46+
Left = 805
47+
Height = 25
48+
Top = 696
49+
Width = 75
50+
Anchors = [akRight, akBottom]
51+
Caption = 'Clear'
52+
OnClick = Button3Click
53+
TabOrder = 3
54+
end
55+
object CheckBox1: TCheckBox
56+
Left = 8
57+
Height = 22
58+
Top = 699
59+
Width = 194
60+
Anchors = [akLeft, akBottom]
61+
Caption = 'Include Timestamps into log'
62+
TabOrder = 4
63+
end
64+
object Button4: TButton
65+
Left = 805
66+
Height = 25
67+
Top = 8
68+
Width = 75
69+
Anchors = [akTop, akRight]
70+
Caption = 'Close'
71+
OnClick = Button4Click
72+
TabOrder = 5
73+
end
74+
object LTCPComponent1: TLTCPComponent
75+
Port = 0
76+
Timeout = 0
77+
ReuseAddress = False
78+
Left = 104
79+
Top = 8
80+
end
81+
end

‎TCP_IP/MQTT_Broker/unit1.pas

Lines changed: 130 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,130 @@
1+
Unit Unit1;
2+
3+
{$MODE objfpc}{$H+}
4+
5+
Interface
6+
7+
Uses
8+
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
9+
lNetComponents, uMQTTbroker;
10+
11+
Type
12+
13+
{ TForm1 }
14+
15+
TForm1 = Class(TForm)
16+
Button1: TButton;
17+
Button2: TButton;
18+
Button3: TButton;
19+
Button4: TButton;
20+
CheckBox1: TCheckBox;
21+
LTCPComponent1: TLTCPComponent;
22+
Memo1: TMemo;
23+
Procedure Button1Click(Sender: TObject);
24+
Procedure Button2Click(Sender: TObject);
25+
Procedure Button3Click(Sender: TObject);
26+
Procedure Button4Click(Sender: TObject);
27+
Procedure FormCloseQuery(Sender: TObject; Var CanClose: Boolean);
28+
Procedure FormCreate(Sender: TObject);
29+
private
30+
fServer: TMQTTBroker;
31+
Procedure OnLog(Sender: TObject; ClientID: integer; aValue: String);
32+
Function OnSubscribeRequest(Sender: TObject; ClientID: integer; Subscription: String): Treturn;
33+
Procedure OnPublishRequest(Sender: TObject; ClientID: integer; aName, aPayload: String; DUP, Retain: Boolean);
34+
Procedure OnPing(Sender: TObject; ClientID: integer);
35+
Procedure OnAcceptMQTTClient(Sender: TObject; ClientID: integer);
36+
public
37+
38+
End;
39+
40+
Var
41+
Form1: TForm1;
42+
43+
Implementation
44+
45+
{$R *.lfm}
46+
47+
{ TForm1 }
48+
49+
Procedure TForm1.Button1Click(Sender: TObject);
50+
Begin
51+
If fServer.Listen() Then Begin
52+
Button1.Enabled := false;
53+
End;
54+
End;
55+
56+
Procedure TForm1.Button2Click(Sender: TObject);
57+
Begin
58+
fServer.Disconnect;
59+
button1.enabled := true;
60+
End;
61+
62+
Procedure TForm1.Button3Click(Sender: TObject);
63+
Begin
64+
Memo1.Clear;
65+
End;
66+
67+
Procedure TForm1.Button4Click(Sender: TObject);
68+
Begin
69+
close;
70+
End;
71+
72+
Procedure TForm1.FormCloseQuery(Sender: TObject; Var CanClose: Boolean);
73+
Begin
74+
fServer.Disconnect;
75+
fServer.CallAction();
76+
fServer.free;
77+
End;
78+
79+
Procedure TForm1.FormCreate(Sender: TObject);
80+
Begin
81+
fServer := TMQTTBroker.Create(LTCPComponent1);
82+
fserver.OnLog := @OnLog;
83+
fserver.OnSubscribeRequest := @OnSubscribeRequest;
84+
fserver.OnPublishRequest := @OnPublishRequest;
85+
fserver.OnPingEvent := @OnPing;
86+
fserver.OnAcceptMQTTClient := @OnAcceptMQTTClient;
87+
memo1.Clear;
88+
End;
89+
90+
Procedure TForm1.OnLog(Sender: TObject; ClientID: integer; aValue: String);
91+
Var
92+
s: String;
93+
Begin
94+
If ClientID <> 0 Then Begin
95+
aValue := '[' + inttostr(ClientID) + '] ' + aValue;
96+
End;
97+
If CheckBox1.Checked Then Begin
98+
s := FormatDateTime('YYYY.MM.DD HH:NN:SS', now) + ' ' + aValue;
99+
End
100+
Else Begin
101+
s := aValue;
102+
End;
103+
Memo1.Lines.Add(s);
104+
End;
105+
106+
Function TForm1.OnSubscribeRequest(Sender: TObject; ClientID: integer;
107+
Subscription: String): Treturn;
108+
Begin
109+
Onlog(self, ClientID, 'Request subscription for: ' + Subscription);
110+
result := rQoS0;
111+
End;
112+
113+
Procedure TForm1.OnPublishRequest(Sender: TObject; ClientID: integer; aName,
114+
aPayload: String; DUP, Retain: Boolean);
115+
Begin
116+
OnLog(self, ClientID, format('Publish: %s = %s', [aName, aPayload]));
117+
End;
118+
119+
Procedure TForm1.OnPing(Sender: TObject; ClientID: integer);
120+
Begin
121+
Onlog(self, ClientID, 'Ping from client');
122+
End;
123+
124+
Procedure TForm1.OnAcceptMQTTClient(Sender: TObject; ClientID: integer);
125+
Begin
126+
Onlog(self, ClientID, 'Accept client');
127+
End;
128+
129+
End.
130+

0 commit comments

Comments
 (0)