-
Notifications
You must be signed in to change notification settings - Fork 1
/
Main.pas
187 lines (159 loc) · 5.46 KB
/
Main.pas
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
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, JvMenus, JvComponentBase, JvTrayIcon, ShellAPI, Properties,
ExtCtrls, BomeOneInstance, MMSystem, JvXPCore, XPMan, Backend, JclRegistry,
PJVersionInfo;
type
TfrmMain = class(TForm)
pmMenu: TJvPopupMenu;
miExit: TMenuItem;
tiTrayIcon: TJvTrayIcon;
miShowState: TMenuItem;
N1: TMenuItem;
miChangeState: TMenuItem;
N2: TMenuItem;
miInfo: TMenuItem;
N3: TMenuItem;
miProperties: TMenuItem;
tiTimer: TTimer;
oiOneInstance: TOneInstance;
XPManifest: TXPManifest;
miHomepage: TMenuItem;
miTestBackendEnabled: TMenuItem;
viVersionInfo: TPJVersionInfo;
procedure miExitClick(Sender: TObject);
procedure miShowStateClick(Sender: TObject);
procedure tiTrayIconDblClick(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure miChangeStateClick(Sender: TObject);
procedure miPropertiesClick(Sender: TObject);
procedure miInfoClick(Sender: TObject);
procedure tiTimerTimer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure miHomepageClick(Sender: TObject);
procedure pmMenuPopup(Sender: TObject);
private
{ Private-Deklarationen }
backend: TBackend;
function GetBackendURL: string;
public
{ Public-Deklarationen }
procedure DoShowState(aForce: boolean);
end;
var
frmMain: TfrmMain;
implementation
uses Info, InnoSetup;
{$R *.dfm}
procedure TfrmMain.miExitClick(Sender: TObject);
begin
Close;
end;
procedure TfrmMain.miShowStateClick(Sender: TObject);
begin
DoShowState(true);
end;
procedure TfrmMain.tiTrayIconDblClick(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
miShowState.Click;
end;
procedure TfrmMain.miChangeStateClick(Sender: TObject);
begin
if RegReadBoolDef(HKEY_CURRENT_USER, strRegPathApp + Application.Title, 'UseTestBackend', false) then
ShellExecute(0, 'OPEN', PChar('https://testhackerspacehb.appspot.com/'), '', '', SW_SHOWNORMAL)
else
ShellExecute(0, 'OPEN', PChar('https://hackerspacehb.appspot.com/'), '', '', SW_SHOWNORMAL)
end;
procedure TfrmMain.miPropertiesClick(Sender: TObject);
begin
if not frmProperties.Visible then begin
if frmProperties.ShowModal = mrOK then begin
Backend.BackendURL := GetBackendURL;
DoShowState(false);
end;
end else
frmProperties.BringToFront;
end;
procedure TfrmMain.miInfoClick(Sender: TObject);
begin
frmInfo.Show;
end;
procedure TfrmMain.tiTimerTimer(Sender: TObject);
begin
DoShowState(false);
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
CreateMutexes('osn');
viVersionInfo.Filename := Application.ExeName;
Backend := TBackend.Create(GetBackendURL);
with viVersionInfo do
Backend.UserAgent := Format('%s/%d.%d.%d.%d (Windows)', [
StringReplace(Application.Title, ' ', '', [rfReplaceAll, rfIgnoreCase]),
FileVersionNumber.V1, FileVersionNumber.V2, FileVersionNumber.V3, FileVersionNumber.V4
]);
DoShowState(false);
end;
procedure TfrmMain.DoShowState(aForce: boolean);
var
strState: string;
strHeadline: string;
strBody: string;
strIcon: string;
strSound: string;
boolBalloonNotification: bool;
boolSoundNotification: bool;
boolHasChanged: bool;
begin
boolBalloonNotification := RegReadBoolDef(HKEY_CURRENT_USER, strRegPathApp + Application.Title, 'BalloonNotification', true);
boolSoundNotification := RegReadBoolDef(HKEY_CURRENT_USER, strRegPathApp + Application.Title, 'SoundNotification', true);
Backend.Read;
boolHasChanged := Backend.HasChanged;
if Backend.Error then begin
strIcon := 'icon error.ico';
strHeadline := 'Fehler';
strBody := Backend.ErrorMsg;
end else begin
if Backend.Open then begin
strState := 'Geöffnet';
strIcon := 'icon open.ico';
strSound := 'SpaceOpened';
end else begin
strState := 'Geschlossen';
strIcon := 'icon closed.ico';
strSound := 'SpaceClosed';
end;
strHeadline := Format('%s seit %s Uhr', [strState, FormatDateTime('ddd h:nn', Backend.LastChange)]);
if backend.Status <> '' then
strBody := Backend.Status
else
strBody := '(Keine Nachricht)';
end;
with tiTrayIcon do begin
Hint := strHeadline + #13#10#13#10 + strBody;
Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + strIcon);
if (boolHasChanged and boolBalloonNotification) or aForce then
BalloonHint(strHeadline, strBody, btNone, 10000, True);
end;
if (boolHasChanged and boolSoundNotification) or aForce then
PlaySound(PAnsiChar(strSound), 0, SND_ALIAS or SND_APPLICATION or SND_ASYNC);
end;
procedure TfrmMain.miHomepageClick(Sender: TObject);
begin
ShellExecute(0, 'OPEN', PChar('http://www.hackerspace-bremen.de/'), '', '', SW_SHOWNORMAL);
end;
procedure TfrmMain.pmMenuPopup(Sender: TObject);
begin
miTestBackendEnabled.Visible := RegReadBoolDef(HKEY_CURRENT_USER, strRegPathApp + Application.Title, 'UseTestBackend', false);
end;
function TfrmMain.GetBackendURL: string;
begin
if RegReadBoolDef(HKEY_CURRENT_USER, strRegPathApp + Application.Title, 'UseTestBackend', false) then
result := 'https://testhackerspacehb.appspot.com/v2/status'
else
result := 'https://hackerspacehb.appspot.com/v2/status';
end;
end.