Subversion Repositories userdetect2

Rev

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