Subversion Repositories userdetect2

Rev

Rev 69 | Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
68 daniel-mar 1
unit UD2_Main;
2
 
3
// TODO: !!ud2 plugin: computer sid, win version, pc name, username, ... (RT)
4
// TODO (future): auch commandline tool das nur errorlevel zurückgibt
5
// TODO: alle funktionalitäten aus userdetect1 (is_user) übernehmen
6
// TODO (kleinigkeit): wie das aufblitzen des forms verhindern bei CLI?
7
// TODO (future): Editor, um alles in der GUI zu erledigen
8
// TODO (idee): argumente an die DLL stellen, z.B. FileAge(Letter.doc):20=calc.exe
9
// TODO: example ini file entwerfen
10
// TODO: geticon funktion in ud2_obj.pas?
11
// TODO (idee): ein plugin kann mehrere methodnames haben?
12
// TODO: möglichkeit, Task Definition File neu zu laden, nach änderungen die man durchgeführt hat
13
 
14
interface
15
 
16
{$IF CompilerVersion >= 25.0}
17
{$LEGACYIFEND ON}
18
{$IFEND}
19
 
20
uses
21
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
22
  Dialogs, StdCtrls, Grids, ValEdit, UD2_Obj, ComCtrls, ImgList, ExtCtrls,
23
  CommCtrl, Menus, VTSListView, VTSCompat;
24
 
25
const
26
  DefaultIniFile = 'UserDetect2.ini';
27
  DefaultWarnIfNothingMatches = 'false';
28
  TagWarnIfNothingMatches = 'WarnIfNothingMatches';
29
  DefaultCloseAfterLaunching = 'false';
30
  TagCloseAfterLaunching = 'CloseAfterLaunching';
31
  TagIcon = 'Icon';
32
 
33
type
34
  TUD2MainForm = class(TForm)
35
    OpenDialog1: TOpenDialog;
36
    PageControl1: TPageControl;
37
    TasksTabSheet: TTabSheet;
38
    TabSheet2: TTabSheet;
39
    TabSheet3: TTabSheet;
40
    IniTemplateMemo: TMemo;
41
    TabSheet4: TTabSheet;
42
    ListView1: TVTSListView;
43
    ImageList1: TImageList;
44
    SaveDialog1: TSaveDialog;
45
    TabSheet5: TTabSheet;
46
    Image1: TImage;
47
    Label1: TLabel;
48
    Label2: TLabel;
49
    Label3: TLabel;
50
    Label4: TLabel;
51
    Label5: TLabel;
52
    Label6: TLabel;
53
    Label7: TLabel;
54
    Label8: TLabel;
55
    ListView2: TVTSListView;
56
    ListView3: TVTSListView;
57
    ErrorsTabSheet: TTabSheet;
58
    ErrorsMemo: TMemo;
59
    Memo1: TMemo;
60
    Panel1: TPanel;
61
    Button1: TButton;
62
    Button2: TButton;
63
    PopupMenu1: TPopupMenu;
64
    Run1: TMenuItem;
65
    Properties1: TMenuItem;
66
    PopupMenu2: TPopupMenu;
67
    CopyTaskDefinitionExample1: TMenuItem;
68
    Button3: TButton;
69
    VersionLabel: TLabel;
70
    procedure FormDestroy(Sender: TObject);
71
    procedure FormShow(Sender: TObject);
72
    procedure ListView1DblClick(Sender: TObject);
73
    procedure ListView1KeyPress(Sender: TObject; var Key: Char);
74
    procedure Button1Click(Sender: TObject);
75
    procedure Button2Click(Sender: TObject);
76
    procedure URLLabelClick(Sender: TObject);
77
    procedure PopupMenu1Popup(Sender: TObject);
78
    procedure Run1Click(Sender: TObject);
79
    procedure Properties1Click(Sender: TObject);
80
    procedure PopupMenu2Popup(Sender: TObject);
81
    procedure CopyTaskDefinitionExample1Click(Sender: TObject);
82
    procedure ListViewCompare(Sender: TObject; Item1, Item2: TListItem;
83
      Data: Integer; var Compare: Integer);
84
    procedure Button3Click(Sender: TObject);
85
  protected
86
    ud2: TUD2;
87
    procedure LoadTaskList;
88
    procedure LoadDetectedIDs;
89
    procedure LoadINITemplate;
90
    procedure LoadLoadedPluginList;
91
    function GetIniFileName: string;
92
    procedure DoRun(ShortTaskName: string);
93
    procedure CheckForErrors;
94
  end;
95
 
96
var
97
  UD2MainForm: TUD2MainForm;
98
 
99
implementation
100
 
101
{$R *.dfm}
102
 
103
uses
104
  ShellAPI, Clipbrd, UD2_Utils, UD2_TaskProperties;
105
 
106
type
107
  TUD2ListViewEntry = class(TObject)
108
    ShortTaskName: string;
109
    CloseAfterLaunching: boolean;
110
    TaskPropertiesForm: TForm;
111
  end;
112
 
113
function AddIconRecToImageList(rec: TIconFileIdx; ImageList: TImageList): integer;
114
var
115
  icon: TIcon;
116
begin
117
  icon := TIcon.Create;
118
  try
119
    icon.Handle := ExtractIcon(Application.Handle, PChar(rec.FileName), rec.IconIndex);
120
 
121
    // result := ImageList.AddIcon(ico);
122
    result := AddTransparentIconToImageList(ImageList, icon);
123
  finally
124
    icon.Free;
125
  end;
126
end;
127
 
128
{ TUD2MainForm }
129
 
130
function TUD2MainForm.GetIniFileName: string;
131
resourcestring
132
  LNG_FILE_NOT_FOUND = 'File "%s" not found.';
133
begin
134
  if ParamCount >= 1 then
135
  begin
136
    if FileExists(ParamStr(1)) then
137
    begin
138
      result := ParamStr(1);
139
    end
140
    else
141
    begin
142
      MessageDlg(Format(LNG_FILE_NOT_FOUND, [ParamStr(1)]), mtError, [mbOK], 0);
143
      result := '';
144
    end;
145
    Exit;
146
  end
147
  else
148
  begin
149
    if FileExists(DefaultIniFile) then
150
    begin
151
      result := DefaultIniFile;
152
      Exit;
153
    end;
154
 
155
    if FileExists(GetOwnCmdName + '.ini') then
156
    begin
157
      result := GetOwnCmdName + '.ini';
158
      Exit;
159
    end;
160
 
161
    if CompatOpenDialogExecute(OpenDialog1) then
162
    begin
163
      result := OpenDialog1.FileName;
164
      Exit;
165
    end;
166
 
167
    result := '';
168
    Exit;
169
  end;
170
end;
171
 
172
procedure TUD2MainForm.LoadTaskList;
173
var
174
  sl: TStringList;
175
  i: integer;
176
  ShortTaskName, iconString: string;
177
  iconIndex: integer;
178
  obj: TUD2ListViewEntry;
179
begin
180
  ListView1.Clear;
181
  sl := TStringList.Create;
182
  try
183
    ud2.GetTaskListing(sl);
184
    for i := 0 to sl.Count-1 do
185
    begin
186
      ShortTaskName := sl.Names[i];
187
 
188
      Obj := TUD2ListViewEntry.Create;
189
      Obj.ShortTaskName := ShortTaskName;
190
      Obj.CloseAfterLaunching := ud2.ReadMetatagBool(ShortTaskName, TagCloseAfterLaunching, DefaultCloseAfterLaunching);
191
 
192
      ListView1.AddItem(sl.Values[ShortTaskName], TObject(Obj));
193
 
194
      iconString := ud2.ReadMetatagString(ShortTaskName, TagIcon, '');
195
      if iconString <> '' then
196
      begin
197
        iconIndex := AddIconRecToImageList(SplitIconString(iconString), ImageList1);
198
        if iconIndex <> -1 then
199
        begin
200
          ListView1.Items.Item[ListView1.Items.Count-1].ImageIndex := iconIndex;
201
        end;
202
      end;
203
    end;
204
  finally
205
    sl.Free;
206
  end;
207
end;
208
 
209
procedure TUD2MainForm.DoRun(ShortTaskName: string);
210
resourcestring
211
  LNG_TASK_NOT_EXISTS = 'The task "%s" does not exist in the INI file.';
212
  LNG_NOTHING_MATCHES = 'No identification string matches to your environment. No application was launched. Please check the Task Definition File.';
213
var
214
  slCmds: TStringList;
215
  i: integer;
216
  cmd: string;
217
begin
218
  if not ud2.TaskExists(ShortTaskName) then
219
  begin
220
    // This can happen if the task name is taken from command line
221
    MessageDlg(Format(LNG_TASK_NOT_EXISTS, [ShortTaskName]), mtError, [mbOK], 0);
222
    Exit;
223
  end;
224
 
225
  slCmds := TStringList.Create;
226
  try
227
    ud2.GetCommandList(ShortTaskName, slCmds);
228
 
229
    if (slCmds.Count = 0) and
230
      ud2.ReadMetatagBool(ShortTaskName,
231
      TagWarnIfNothingMatches, DefaultWarnIfNothingMatches) then
232
    begin
233
      MessageDlg(LNG_NOTHING_MATCHES, mtWarning, [mbOK], 0);
234
    end;
235
 
236
    for i := 0 to slCmds.Count-1 do
237
    begin
238
      cmd := slCmds.Strings[i];
239
      if cmd = '' then continue;
240
      UD2_RunCMD(cmd, SW_NORMAL); // TODO: SW_NORMAL konfigurieren?
241
    end;
242
  finally
243
    slCmds.Free;
244
  end;
245
end;
246
 
247
procedure TUD2MainForm.FormDestroy(Sender: TObject);
248
var
249
  i: integer;
250
begin
251
  if Assigned(ud2) then ud2.Free;
252
  for i := 0 to ListView1.Items.Count-1 do
253
  begin
254
    TUD2ListViewEntry(ListView1.Items.Item[i].Data).Free;
255
  end;
256
end;
257
 
258
procedure TUD2MainForm.CheckForErrors;
259
begin
260
  ErrorsTabSheet.TabVisible := ud2.Errors.Count > 0;
261
  if ErrorsTabSheet.TabVisible then
262
  begin
263
    ErrorsMemo.Lines.Assign(ud2.Errors);
264
    PageControl1.ActivePage := ErrorsTabSheet;
265
  end;
266
end;
267
 
268
procedure TUD2MainForm.LoadDetectedIDs;
269
var
270
  i, j: integer;
271
  pl: TUD2Plugin;
272
  ude: TUD2IdentificationEntry;
273
begin
274
  ListView3.Clear;
275
  for i := 0 to ud2.LoadedPlugins.Count-1 do
276
  begin
277
    pl := ud2.LoadedPlugins.Items[i] as TUD2Plugin;
278
    for j := 0 to pl.DetectedIdentifications.Count-1 do
279
    begin
280
      ude := pl.DetectedIdentifications.Items[j] as TUD2IdentificationEntry;
281
      with ListView3.Items.Add do
282
      begin
283
        Caption := pl.PluginName;
284
        SubItems.Add(pl.IdentificationMethodName);
285
        SubItems.Add(ude.IdentificationString);
286
        SubItems.Add(GUIDToString(pl.PluginGUID));
287
      end;
288
    end;
289
  end;
290
 
291
  for i := 0 to ListView3.Columns.Count-1 do
292
  begin
293
    ListView3.Columns.Items[i].Width := LVSCW_AUTOSIZE_USEHEADER;
294
  end;
295
end;
296
 
297
procedure TUD2MainForm.LoadINITemplate;
298
var
299
  i, j: integer;
300
  pl: TUD2Plugin;
301
  ude: TUD2IdentificationEntry;
302
begin
303
  IniTemplateMemo.Clear;
304
  IniTemplateMemo.Lines.Add('[ExampleTask1]');
305
  IniTemplateMemo.Lines.Add('; Description: Optional but recommended');
306
  IniTemplateMemo.Lines.Add('Description=Run Task #1');
307
  IniTemplateMemo.Lines.Add('; WarnIfNothingMatches: Warns when no application was launched. Default: false.');
308
  IniTemplateMemo.Lines.Add('WarnIfNothingMatches=false');
309
  IniTemplateMemo.Lines.Add('; Optional: IconDLL + IconIndex');
310
  IniTemplateMemo.Lines.Add('Icon=%SystemRoot%\system32\Shell32.dll,3');
311
  IniTemplateMemo.Lines.Add('; Optional: Can be true or false');
312
  IniTemplateMemo.Lines.Add(TagCloseAfterLaunching+'=true');
313
 
314
  for i := 0 to ud2.LoadedPlugins.Count-1 do
315
  begin
316
    pl := ud2.LoadedPlugins.Items[i] as TUD2Plugin;
317
    for j := 0 to pl.DetectedIdentifications.Count-1 do
318
    begin
319
      ude := pl.DetectedIdentifications.Items[j] as TUD2IdentificationEntry;
320
      IniTemplateMemo.Lines.Add(Format('; %s', [ude.Plugin.PluginName]));
321
      IniTemplateMemo.Lines.Add(ude.GetPrimaryIdName+'=calc.exe');
322
    end;
323
  end;
324
end;
325
 
326
procedure TUD2MainForm.LoadLoadedPluginList;
327
var
328
  i: integer;
329
  pl: TUD2Plugin;
330
begin
331
  ListView2.Clear;
332
  for i := 0 to ud2.LoadedPlugins.Count-1 do
333
  begin
334
    pl := ud2.LoadedPlugins.Items[i] as TUD2Plugin;
335
    with ListView2.Items.Add do
336
    begin
337
      Caption := pl.PluginDLL;
338
      SubItems.Add(pl.PluginVendor);
339
      SubItems.Add(pl.PluginName);
340
      SubItems.Add(pl.PluginVersion);
341
      SubItems.Add(pl.IdentificationMethodName);
342
      SubItems.Add(pl.PluginGUIDString);
343
    end;
344
  end;
345
 
346
  for i := 0 to ListView2.Columns.Count-1 do
347
  begin
348
    ListView2.Columns.Items[i].Width := LVSCW_AUTOSIZE_USEHEADER;
349
  end;
350
end;
351
 
352
procedure TUD2MainForm.FormShow(Sender: TObject);
353
resourcestring
354
  LNG_SYNTAX = 'Syntax: %s [TaskDefinitionFile [TaskName]]';
355
var
356
  LoadedIniFile: string;
357
begin
358
  // To avoid accidental changes from the GUI designer
359
  PageControl1.ActivePage := TasksTabSheet;
360
 
361
  if ((ParamCount = 1) and (ParamStr(1) = '/?')) or (ParamCount >= 3) then
362
  begin
363
    MessageDlg(Format(LNG_SYNTAX, [GetOwnCmdName]), mtInformation, [mbOK], 0);
364
    Close;
365
    Exit;
366
  end;
367
 
368
  LoadedIniFile := GetIniFileName;
369
  if LoadedIniFile = '' then
370
  begin
371
    Close;
372
    Exit;
373
  end;
374
  ud2 := TUD2.Create(LoadedIniFile);
375
 
376
  ud2.HandlePluginDir('Plugins\');
377
 
378
  if ParamCount >= 2 then
379
  begin
380
    DoRun(ParamStr(2));
381
    Close;
382
    Exit;
383
  end
384
  else
385
  begin
386
    LoadTaskList;
387
    LoadDetectedIDs;
388
    LoadINITemplate;
389
    LoadLoadedPluginList;
390
    CheckForErrors;
391
  end;
392
end;
393
 
394
procedure TUD2MainForm.ListView1DblClick(Sender: TObject);
395
var
396
  obj: TUD2ListViewEntry;
397
begin
398
  if ListView1.ItemIndex = -1 then exit;
399
  obj := TUD2ListViewEntry(ListView1.Selected.Data);
400
  DoRun(obj.ShortTaskName);
401
  if obj.CloseAfterLaunching then Close;
402
end;
403
 
404
procedure TUD2MainForm.ListView1KeyPress(Sender: TObject; var Key: Char);
405
begin
406
  if Key = #13 then
407
  begin
408
    ListView1DblClick(Sender);
409
  end;
410
end;
411
 
412
procedure TUD2MainForm.Button1Click(Sender: TObject);
413
begin
414
  UD2_RunCMD(ud2.IniFileName, SW_NORMAL);
415
end;
416
 
417
procedure TUD2MainForm.Button2Click(Sender: TObject);
418
begin
419
  if CompatSaveDialogExecute(SaveDialog1) then
420
  begin
421
    IniTemplateMemo.Lines.SaveToFile(SaveDialog1.FileName);
422
  end;
423
end;
424
 
425
procedure TUD2MainForm.URLLabelClick(Sender: TObject);
426
var
427
  s: string;
428
begin
429
  s := TLabel(Sender).Caption;
430
  if Pos('@', s) > 0 then
431
    s := 'mailto:' + s
432
  else
433
    s := 'http://' + s;
434
  UD2_RunCMD(s, SW_NORMAL);
435
end;
436
 
437
procedure TUD2MainForm.PopupMenu1Popup(Sender: TObject);
438
begin
439
  Run1.Enabled := ListView1.ItemIndex <> -1;
440
  Properties1.Enabled := ListView1.ItemIndex <> -1;
441
end;
442
 
443
procedure TUD2MainForm.Run1Click(Sender: TObject);
444
begin
445
  ListView1DblClick(Sender);
446
end;
447
 
448
procedure TUD2MainForm.Properties1Click(Sender: TObject);
449
var
450
  obj: TUD2ListViewEntry;
451
begin
452
  if ListView1.ItemIndex = -1 then exit;
453
  obj := TUD2ListViewEntry(ListView1.Selected.Data);
454
  if obj.TaskPropertiesForm = nil then
455
  begin
456
    obj.TaskPropertiesForm := TUD2TaskPropertiesForm.Create(Self, ud2, obj.ShortTaskName);
457
  end;
458
  obj.TaskPropertiesForm.Show;
459
end;
460
 
461
procedure TUD2MainForm.PopupMenu2Popup(Sender: TObject);
462
begin
463
  CopyTaskDefinitionExample1.Enabled := ListView3.ItemIndex <> -1;
464
end;
465
 
466
procedure TUD2MainForm.CopyTaskDefinitionExample1Click(Sender: TObject);
467
var
468
  s: string;
469
begin
470
  s := '; '+ListView3.Selected.Caption+#13#10+
471
       ListView3.Selected.SubItems[0] + ':' + ListView3.Selected.SubItems[1] + '=calc.exe'+#13#10+
472
       #13#10+
473
       '; Alternatively:'+#13#10+
474
       ListView3.Selected.SubItems[2] + ':' + ListView3.Selected.SubItems[1] + '=calc.exe'+#13#10;
475
  Clipboard.AsText := s;
476
end;
477
 
478
procedure TUD2MainForm.ListViewCompare(Sender: TObject; Item1,
479
  Item2: TListItem; Data: Integer; var Compare: Integer);
480
var
481
  ListView: TVTSListView;
482
begin
483
  ListView := Sender as TVTSListView;
484
  if ListView.CurSortedColumn = 0 then
485
  begin
486
    Compare := CompareText(Item1.Caption, Item2.Caption);
487
  end
488
  else
489
  begin
490
    Compare := CompareText(Item1.SubItems[ListView.CurSortedColumn-1],
491
                           Item2.SubItems[ListView.CurSortedColumn-1]);
492
  end;
493
  if ListView.CurSortedDesc then Compare := -Compare;
494
end;
495
 
496
procedure TUD2MainForm.Button3Click(Sender: TObject);
497
begin
498
  VTS_CheckUpdates('userdetect2', VersionLabel.Caption);
499
end;
500
 
501
end.