source: trunk/UFormMain.pas

Last change on this file was 3, checked in by chronos, 6 years ago
  • Modified: Prepared context menu actions for Services list.
File size: 11.7 KB
Line 
1unit UFormMain;
2
3{$mode delphi}{$H+}
4
5interface
6
7uses
8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
9 ComCtrls, ExtCtrls, ActnList, Process, Contnrs;
10
11type
12 TSystemProcess = class
13 Name: string;
14 Path: string;
15 Parameters: string;
16 Cpu: Single;
17 Drive: Single;
18 Memory: Single;
19 Network: Single;
20 User: string;
21 PID: Integer;
22 Description: string;
23 end;
24
25 TSystemProcesses = class(TObjectList)
26 end;
27
28 TSystemServiceState = (ssStopped, ssRunning);
29
30 TSystemService = class
31 Name: string;
32 Description: string;
33 State: TSystemServiceState;
34 end;
35
36 TSystemServices = class(TObjectList)
37 end;
38
39 { TFormMain }
40
41 TFormMain = class(TForm)
42 AAlwaysOnTop: TAction;
43 AServiceStart: TAction;
44 AServiceRestart: TAction;
45 AServiceStop: TAction;
46 ARestore: TAction;
47 ARun: TAction;
48 AExit: TAction;
49 ActionList1: TActionList;
50 ImageList1: TImageList;
51 ListViewOnStartup: TListView;
52 ListViewDetails: TListView;
53 ListViewProcesses: TListView;
54 ListViewServices: TListView;
55 MainMenu1: TMainMenu;
56 MenuItem1: TMenuItem;
57 MenuItem10: TMenuItem;
58 MenuItem11: TMenuItem;
59 MenuItem12: TMenuItem;
60 MenuItem13: TMenuItem;
61 MenuItem14: TMenuItem;
62 MenuItem15: TMenuItem;
63 MenuItem16: TMenuItem;
64 MenuItem17: TMenuItem;
65 MenuItem18: TMenuItem;
66 MenuItem19: TMenuItem;
67 MenuItem2: TMenuItem;
68 MenuItem20: TMenuItem;
69 MenuItem21: TMenuItem;
70 MenuItem22: TMenuItem;
71 MenuItem23: TMenuItem;
72 MenuItem24: TMenuItem;
73 MenuItem25: TMenuItem;
74 MenuItem26: TMenuItem;
75 MenuItem27: TMenuItem;
76 MenuItem28: TMenuItem;
77 MenuItem29: TMenuItem;
78 MenuItem3: TMenuItem;
79 MenuItem30: TMenuItem;
80 MenuItem31: TMenuItem;
81 MenuItem32: TMenuItem;
82 MenuItem33: TMenuItem;
83 MenuItem34: TMenuItem;
84 MenuItem35: TMenuItem;
85 MenuItem36: TMenuItem;
86 MenuItem37: TMenuItem;
87 MenuItem38: TMenuItem;
88 MenuItem39: TMenuItem;
89 MenuItem4: TMenuItem;
90 MenuItem40: TMenuItem;
91 MenuItem41: TMenuItem;
92 MenuItem42: TMenuItem;
93 MenuItem43: TMenuItem;
94 MenuItem44: TMenuItem;
95 MenuItem45: TMenuItem;
96 MenuItem46: TMenuItem;
97 MenuItem47: TMenuItem;
98 MenuItem5: TMenuItem;
99 MenuItem6: TMenuItem;
100 MenuItem7: TMenuItem;
101 MenuItem8: TMenuItem;
102 MenuItem9: TMenuItem;
103 MenuItemRun: TMenuItem;
104 MenuItemExit: TMenuItem;
105 PageControl1: TPageControl;
106 Panel1: TPanel;
107 PopupMenuServices: TPopupMenu;
108 PopupMenuProcesses: TPopupMenu;
109 PopupMenuDetails: TPopupMenu;
110 PopupMenuTrayIcon: TPopupMenu;
111 TabSheet1: TTabSheet;
112 TabSheet2: TTabSheet;
113 TabSheet3: TTabSheet;
114 TabSheetServices: TTabSheet;
115 TabSheetDetails: TTabSheet;
116 TabSheetUsers: TTabSheet;
117 TabSheetProcesses: TTabSheet;
118 TimerRefresh: TTimer;
119 TrayIcon1: TTrayIcon;
120 procedure AExitExecute(Sender: TObject);
121 procedure ARestoreExecute(Sender: TObject);
122 procedure ARunExecute(Sender: TObject);
123 procedure AServiceRestartExecute(Sender: TObject);
124 procedure AServiceStartExecute(Sender: TObject);
125 procedure AServiceStopExecute(Sender: TObject);
126 procedure FormCreate(Sender: TObject);
127 procedure FormDestroy(Sender: TObject);
128 procedure FormShow(Sender: TObject);
129 procedure FormWindowStateChange(Sender: TObject);
130 procedure ListViewDetailsData(Sender: TObject; Item: TListItem);
131 procedure ListViewProcessesData(Sender: TObject; Item: TListItem);
132 procedure ListViewServicesData(Sender: TObject; Item: TListItem);
133 procedure PageControl1Change(Sender: TObject);
134 procedure PopupMenuServicesPopup(Sender: TObject);
135 procedure TimerRefreshTimer(Sender: TObject);
136 procedure TrayIcon1Click(Sender: TObject);
137 private
138 Processes: TSystemProcesses;
139 Services: TSystemServices;
140 function Cut(var Text: string; Separator: string): string;
141 procedure ReloadTab;
142 procedure ReloadProcessList;
143 procedure ReloadServiceList;
144 function ExecuteAnWaitForOutput(Executable: string; Parameters: array of string): string;
145 public
146
147 end;
148
149var
150 FormMain: TFormMain;
151
152implementation
153
154{$R *.lfm}
155
156resourcestring
157 SRunNewTask = 'Run new task';
158 SRunNewTaskPrompt = 'Enter name of a program, service, document or resource from the Internet and Windows system will open it.';
159
160 var
161 SystemServiceStatusText: array [TSystemServiceState] of string = ('Stopped', 'Running');
162{ TFormMain }
163
164procedure TFormMain.AExitExecute(Sender: TObject);
165begin
166 Application.Terminate;
167end;
168
169procedure TFormMain.ARestoreExecute(Sender: TObject);
170begin
171 Show;
172 BringToFront;
173end;
174
175procedure TFormMain.ARunExecute(Sender: TObject);
176var
177 Text: string;
178 Process: TProcess;
179begin
180 Text := InputBox(SRunNewTask, SRunNewTaskPrompt, '');
181 if Text <> '' then begin
182 Process := TProcess.Create(nil);
183 try
184 Process.Executable := Text;
185 Process.Options := [poNoConsole];
186 Process.Execute;
187 finally
188 Process.Free;
189 end;
190 end;
191end;
192
193procedure TFormMain.AServiceRestartExecute(Sender: TObject);
194begin
195 if Assigned(ListViewServices.Selected) then begin
196 ExecuteAnWaitForOutput('/bin/systemctl', ['restart',
197 TSystemService(ListViewServices.Selected.Data).Name])
198 end;
199end;
200
201procedure TFormMain.AServiceStartExecute(Sender: TObject);
202begin
203 ExecuteAnWaitForOutput('/bin/systemctl', ['start',
204 TSystemService(ListViewServices.Selected.Data).Name])
205end;
206
207procedure TFormMain.AServiceStopExecute(Sender: TObject);
208begin
209 ExecuteAnWaitForOutput('/bin/systemctl', ['stop',
210 TSystemService(ListViewServices.Selected.Data).Name])
211end;
212
213procedure TFormMain.FormCreate(Sender: TObject);
214begin
215 Processes := TSystemProcesses.Create;
216 Services := TSystemServices.Create;
217end;
218
219procedure TFormMain.FormDestroy(Sender: TObject);
220begin
221 Services.Free;
222 Processes.Free;
223end;
224
225procedure TFormMain.FormShow(Sender: TObject);
226begin
227 PageControl1.TabIndex := 0;
228 ReloadTab;
229 TimerRefresh.Enabled := True;
230end;
231
232procedure TFormMain.FormWindowStateChange(Sender: TObject);
233begin
234 ARestore.Visible := WindowState = wsMinimized;
235end;
236
237procedure TFormMain.ListViewDetailsData(Sender: TObject; Item: TListItem);
238begin
239 if Item.Index < Processes.Count then
240 with TSystemProcess(Processes[Item.Index]) do begin
241 Item.Data := Processes[Item.Index];
242 Item.Caption := Name;
243 Item.SubItems.Add(IntToStr(PID));
244 //Item.SubItems.Add(Status);
245 Item.SubItems.Add(User);
246 Item.SubItems.Add(FloatToStr(Cpu));
247 Item.SubItems.Add(FloatToStr(Memory));
248 Item.SubItems.Add(Description);
249 end;
250end;
251
252procedure TFormMain.ListViewProcessesData(Sender: TObject; Item: TListItem);
253begin
254 if Item.Index < Processes.Count then
255 with TSystemProcess(Processes[Item.Index]) do begin
256 Item.Data := Processes[Item.Index];
257 Item.Caption := Name;
258 Item.SubItems.Add(FloatToStr(Cpu));
259 Item.SubItems.Add(FloatToStr(Memory));
260 Item.SubItems.Add(FloatToStr(Drive));
261 Item.SubItems.Add(FloatToStr(Network));
262 end;
263end;
264
265procedure TFormMain.ListViewServicesData(Sender: TObject; Item: TListItem);
266begin
267 if Item.Index < Services.Count then
268 with TSystemService(Services[Item.Index]) do begin
269 Item.Data := Services[Item.Index];
270 Item.Caption := Name;
271 Item.SubItems.Add('');
272 Item.SubItems.Add(Description);
273 Item.SubItems.Add(SystemServiceStatusText[State]);
274 Item.SubItems.Add('');
275 end;
276end;
277
278procedure TFormMain.PageControl1Change(Sender: TObject);
279begin
280 ReloadTab;
281end;
282
283procedure TFormMain.PopupMenuServicesPopup(Sender: TObject);
284begin
285 AServiceRestart.Enabled := Assigned(ListViewServices.Selected) and
286 (TSystemService(ListViewServices.Selected.Data).State = ssRunning);
287 AServiceStop.Enabled := Assigned(ListViewServices.Selected) and
288 (TSystemService(ListViewServices.Selected.Data).State = ssRunning);
289 AServiceStart.Enabled := Assigned(ListViewServices.Selected) and
290 (TSystemService(ListViewServices.Selected.Data).State = ssStopped);
291end;
292
293procedure TFormMain.TimerRefreshTimer(Sender: TObject);
294begin
295 ReloadTab;
296end;
297
298procedure TFormMain.TrayIcon1Click(Sender: TObject);
299begin
300
301end;
302
303function TFormMain.Cut(var Text: string; Separator: string): string;
304begin
305 if Pos(Separator, Text) > 0 then begin
306 Result := Copy(Text, 1, Pos(Separator, Text) - 1);
307 Delete(Text, 1, Length(Result) + Length(Separator));
308 end else begin
309 Result := Text;
310 Text := '';
311 end;
312end;
313
314procedure TFormMain.ReloadTab;
315begin
316 if PageControl1.ActivePage = TabSheetProcesses then begin
317 ReloadProcessList;
318 ListViewProcesses.Items.Count := Processes.Count;
319 ListViewProcesses.Refresh;
320 end;
321 if PageControl1.ActivePage = TabSheetDetails then begin
322 ReloadProcessList;
323 ListViewDetails.Items.Count := Processes.Count;
324 ListViewDetails.Refresh;
325 end;
326 if PageControl1.ActivePage = TabSheetServices then begin
327 ReloadServiceList;
328 ListViewServices.Items.Count := Services.Count;
329 ListViewServices.Refresh;
330 end;
331end;
332
333procedure TFormMain.ReloadProcessList;
334var
335 Lines: TStringList;
336 I: Integer;
337 NewProcess: TSystemProcess;
338 Line: string;
339begin
340 Processes.Clear;
341 Lines := TStringList.Create;
342 try
343 Lines.Text := ExecuteAnWaitForOutput('/bin/ps', ['auxw']);
344 for I := 1 to Lines.Count - 1 do begin
345 Line := Lines[I];
346 while Pos(' ', Line) > 0 do
347 Line := StringReplace(Line, ' ', ' ', [rfReplaceAll]);
348 NewProcess := TSystemProcess.Create;
349 NewProcess.User := Cut(Line, ' ');
350 NewProcess.PID := StrToInt(Cut(Line, ' '));
351 NewProcess.Cpu := StrToFloat(Cut(Line, ' '));
352 NewProcess.Memory := StrToFloat(Cut(Line, ' '));
353 Cut(Line, ' ');
354 Cut(Line, ' ');
355 Cut(Line, ' ');
356 Cut(Line, ' ');
357 Cut(Line, ' ');
358 Cut(Line, ' ');
359 NewProcess.Name := Cut(Line, ' ');
360 if Copy(NewProcess.Name, 1, 1) = '/' then begin
361 NewProcess.Path := ExtractFileDir(NewProcess.Name);
362 NewProcess.Name := ExtractFileName(NewProcess.Name);
363 end else NewProcess.Path := '';
364 NewProcess.Parameters := Line;
365 Processes.Add(NewProcess);
366 end;
367 finally
368 Lines.Free;
369 end;
370end;
371
372procedure TFormMain.ReloadServiceList;
373var
374 Process: TProcess;
375 Lines: TStringList;
376 I: Integer;
377 NewService: TSystemService;
378 Line: string;
379 State: string;
380begin
381 Services.Clear;
382 Process := TProcess.Create(nil);
383 Lines := TStringList.Create;
384 try
385 Lines.Text := ExecuteAnWaitForOutput('/bin/systemctl', ['list-units',
386 '--no-pager', '--all', '--plain', '--no-legend']);
387 for I := 0 to Lines.Count - 1 do begin
388 Line := Lines[I];
389 while Pos(' ', Line) > 0 do
390 Line := StringReplace(Line, ' ', ' ', [rfReplaceAll]);
391 NewService := TSystemService.Create;
392 NewService.Name := Cut(Line, ' ');
393 Cut(Line, ' ');
394 Cut(Line, ' ');
395 State := Cut(Line, ' ');
396 if State = 'running' then NewService.State := ssRunning
397 else NewService.State := ssStopped;
398 NewService.Description := Line;
399 Services.Add(NewService);
400 end;
401 finally
402 Lines.Free;
403 end;
404end;
405
406function TFormMain.ExecuteAnWaitForOutput(Executable: string;
407 Parameters: array of string): string;
408var
409 Process: TProcess;
410 OutputStream: TMemoryStream;
411 I: Integer;
412 BytesRead: Integer;
413 Buffer: array[0..2047] of Byte;
414begin
415 Process := TProcess.Create(nil);
416 OutputStream := TMemoryStream.Create;
417 try
418 Process.Executable := Executable;
419 for I := 0 to Length(Parameters) - 1 do
420 Process.Parameters.Add(Parameters[I]);
421 Process.Options := [poNoConsole, poUsePipes];
422 Process.Execute;
423
424 repeat
425 BytesRead := Process.Output.Read(Buffer, Length(Buffer));
426 OutputStream.Write(Buffer, BytesRead)
427 until BytesRead = 0;
428
429 SetLength(Result, OutputStream.Size);
430 if OutputStream.Size > 0 then begin;
431 OutputStream.Position := 0;
432 OutputStream.Read(Result[1], OutputStream.Size);
433 end else Result := '';
434 finally
435 OutputStream.Free;
436 Process.Free;
437 end;
438end;
439
440end.
441
Note: See TracBrowser for help on using the repository browser.