Login | ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/userdetect2/trunk/UserDetect2/UD2_Main.pas
Revision: 96
Committed: Tue Jan 3 13:13:18 2017 UTC (4 years, 9 months ago) by daniel-marschall
Content type: text/x-pascal
File size: 20894 byte(s)
Log Message:
Release 2.3.2

File Contents

# Content
1 unit UD2_Main;
2
3 interface
4
5 {$IF CompilerVersion >= 25.0}
6 {$LEGACYIFEND ON}
7 {$IFEND}
8
9 {$INCLUDE 'UserDetect2.inc'}
10
11 uses
12 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
13 Dialogs, StdCtrls, Grids, ValEdit, UD2_Obj, ComCtrls, ImgList, ExtCtrls,
14 CommCtrl, Menus, VTSListView, VTSCompat, UD2_PluginStatus, Contnrs,
15 System.ImageList;
16
17 const
18 DefaultIniFile = 'UserDetect2.ini';
19 DefaultWarnIfNothingMatchesGUI = 'true';
20 TagWarnIfNothingMatchesGUI = 'WarnIfNothingMatches.GUI';
21 DefaultWarnIfNothingMatchesCLI = 'false';
22 TagWarnIfNothingMatchesCLI = 'WarnIfNothingMatches.CLI';
23 DefaultCloseAfterLaunching = 'false';
24 TagCloseAfterLaunching = 'CloseAfterLaunching';
25 TagIcon = 'Icon';
26
27 type
28 TUD2MainForm = class(TForm)
29 OpenDialog1: TOpenDialog;
30 PageControl1: TPageControl;
31 TasksTabSheet: TTabSheet;
32 TabSheet2: TTabSheet;
33 TabSheet3: TTabSheet;
34 IniTemplateMemo: TMemo;
35 TabSheet4: TTabSheet;
36 TasksListView: TVTSListView;
37 TasksImageList: TImageList;
38 SaveDialog1: TSaveDialog;
39 TabSheet5: TTabSheet;
40 Image1: TImage;
41 Label1: TLabel;
42 Label2: TLabel;
43 Label3: TLabel;
44 Label4: TLabel;
45 Label5: TLabel;
46 Label6: TLabel;
47 Label7: TLabel;
48 Label8: TLabel;
49 LoadedPluginsListView: TVTSListView;
50 IdentificationsListView: TVTSListView;
51 ErrorsTabSheet: TTabSheet;
52 ErrorsMemo: TMemo;
53 Memo1: TMemo;
54 Panel1: TPanel;
55 OpenTDFButton: TButton;
56 SaveTDFButton: TButton;
57 TasksPopupMenu: TPopupMenu;
58 Run1: TMenuItem;
59 Properties1: TMenuItem;
60 IdentificationsPopupMenu: TPopupMenu;
61 CopyTaskDefinitionExample1: TMenuItem;
62 Button3: TButton;
63 VersionLabel: TLabel;
64 LoadedPluginsPopupMenu: TPopupMenu;
65 CopyStatusCodeToClipboard: TMenuItem;
66 Panel2: TPanel;
67 Image2: TImage;
68 DynamicTestGroupbox: TGroupBox;
69 DynamicTestPluginComboBox: TComboBox;
70 DynamicTestPluginLabel: TLabel;
71 DynamicTestDataLabel: TLabel;
72 DynamicTestDataEdit: TEdit;
73 DynamicTestButton: TButton;
74 procedure FormDestroy(Sender: TObject);
75 procedure TasksListViewDblClick(Sender: TObject);
76 procedure TasksListViewKeyPress(Sender: TObject; var Key: Char);
77 procedure OpenTDFButtonClick(Sender: TObject);
78 procedure SaveTDFButtonClick(Sender: TObject);
79 procedure URLLabelClick(Sender: TObject);
80 procedure TasksPopupMenuPopup(Sender: TObject);
81 procedure Run1Click(Sender: TObject);
82 procedure Properties1Click(Sender: TObject);
83 procedure IdentificationsPopupMenuPopup(Sender: TObject);
84 procedure CopyTaskDefinitionExample1Click(Sender: TObject);
85 procedure ListViewCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
86 procedure Button3Click(Sender: TObject);
87 procedure LoadedPluginsPopupMenuPopup(Sender: TObject);
88 procedure CopyStatusCodeToClipboardClick(Sender: TObject);
89 procedure FormCreate(Sender: TObject);
90 procedure DynamicTestButtonClick(Sender: TObject);
91 private
92 procedure ConvertFirstIconToGray;
93 protected
94 ud2: TUD2;
95 procedure LoadTaskList;
96 procedure LoadDetectedIDs;
97 procedure LoadINITemplate;
98 procedure LoadLoadedPluginList;
99 procedure LoadDynamicPluginList;
100 function GetIniFileName: string;
101 procedure DoRun(ShortTaskName: string; gui: boolean);
102 procedure CheckForErrors;
103 public
104 procedure Run;
105 end;
106
107 var
108 UD2MainForm: TUD2MainForm;
109
110 implementation
111
112 {$R *.dfm}
113
114 uses
115 ShellAPI, Clipbrd, Math, AlphaNumSort, UD2_Utils, UD2_TaskProperties, UD2_Parsing;
116
117 type
118 TUD2ListViewEntry = class(TObject)
119 ShortTaskName: string;
120 CloseAfterLaunching: boolean;
121 TaskPropertiesForm: TForm;
122 end;
123
124 function AddIconRecToImageList(rec: TIconFileIdx; ImageList: TImageList): integer;
125 var
126 icon: TIcon;
127 begin
128 icon := TIcon.Create;
129 try
130 icon.Handle := ExtractIcon(Application.Handle, PChar(rec.FileName), rec.IconIndex);
131
132 // result := ImageList.AddIcon(ico);
133 result := AddTransparentIconToImageList(ImageList, icon);
134 AddTransparentIconToImageList(ImageList, icon, true)
135 finally
136 icon.Free;
137 end;
138 end;
139
140 { TUD2MainForm }
141
142 function TUD2MainForm.GetIniFileName: string;
143 resourcestring
144 LNG_FILE_NOT_FOUND = 'File "%s" not found.';
145 begin
146 if (ParamCount >= 1) and not CheckBoolParam(1, 'C') then
147 begin
148 if FileExists(ParamStr(1)) then
149 begin
150 result := ParamStr(1);
151 end
152 else
153 begin
154 ExitCode := EXITCODE_INI_NOT_FOUND;
155 MessageDlg(Format(LNG_FILE_NOT_FOUND, [ParamStr(1)]), mtError, [mbOK], 0);
156 result := '';
157 end;
158 Exit;
159 end
160 else
161 begin
162 if FileExists(DefaultIniFile) then
163 begin
164 result := DefaultIniFile;
165 Exit;
166 end;
167
168 if FileExists(GetOwnCmdName + '.ini') then
169 begin
170 result := GetOwnCmdName + '.ini';
171 Exit;
172 end;
173
174 if CompatOpenDialogExecute(OpenDialog1) then
175 begin
176 result := OpenDialog1.FileName;
177 Exit;
178 end;
179
180 result := '';
181 Exit;
182 end;
183 end;
184
185 procedure TUD2MainForm.LoadTaskList;
186 var
187 sl: TStringList;
188 i: integer;
189 ShortTaskName, iconString: string;
190 iconIndex: integer;
191 obj: TUD2ListViewEntry;
192 cmds: TUD2CommandArray;
193 begin
194 for i := 0 to TasksListView.Items.Count-1 do
195 begin
196 TUD2ListViewEntry(TasksListView.Items.Item[i].Data).Free;
197 end;
198 TasksListView.Clear;
199
200 sl := TStringList.Create;
201 try
202 ud2.GetTaskListing(sl);
203 for i := 0 to sl.Count-1 do
204 begin
205 ShortTaskName := sl.Names[i];
206
207 Obj := TUD2ListViewEntry.Create;
208 Obj.ShortTaskName := ShortTaskName;
209 Obj.CloseAfterLaunching := ud2.ReadMetatagBool(ShortTaskName, TagCloseAfterLaunching, DefaultCloseAfterLaunching);
210
211 TasksListView.AddItem(sl.Values[ShortTaskName], TObject(Obj));
212
213 iconString := ud2.ReadMetatagString(ShortTaskName, TagIcon, '');
214 if iconString <> '' then
215 begin
216 iconIndex := AddIconRecToImageList(SplitIconString(iconString), TasksImageList);
217 if iconIndex <> -1 then
218 begin
219 TasksListView.Items.Item[TasksListView.Items.Count-1].ImageIndex := iconIndex;
220 end;
221 end;
222
223 SetLength(cmds, 0);
224 cmds := ud2.GetCommandList(obj.ShortTaskName);
225 if Length(cmds) = 0 then
226 begin
227 TasksListView.Items.Item[TasksListView.Items.Count-1].ImageIndex := TasksListView.Items.Item[TasksListView.Items.Count-1].ImageIndex + 1;
228 end;
229 end;
230 finally
231 sl.Free;
232 end;
233 end;
234
235 procedure TUD2MainForm.DoRun(ShortTaskName: string; gui: boolean);
236 resourcestring
237 LNG_TASK_NOT_EXISTS = 'The task "%s" does not exist in the INI file.';
238 LNG_NOTHING_MATCHES = 'No identification string matches to your environment. No application was launched. Please check the Task Definition File.';
239 var
240 i: integer;
241 cmds: TUD2CommandArray;
242 showMismatchError: boolean;
243 begin
244 if not ud2.TaskExists(ShortTaskName) then
245 begin
246 // This can happen if the task name is taken from command line
247 MessageDlg(Format(LNG_TASK_NOT_EXISTS, [ShortTaskName]), mtError, [mbOK], 0);
248 ExitCode := EXITCODE_TASK_NOT_EXISTS;
249 Exit;
250 end;
251
252 SetLength(cmds, 0);
253 cmds := ud2.GetCommandList(ShortTaskName); // TODO: What to do with AErrorOut (errors from dynamic queries?)
254
255 if gui then
256 showMismatchError := ud2.ReadMetatagBool(ShortTaskName, TagWarnIfNothingMatchesGUI, DefaultWarnIfNothingMatchesGUI)
257 else
258 showMismatchError := ud2.ReadMetatagBool(ShortTaskName, TagWarnIfNothingMatchesCLI, DefaultWarnIfNothingMatchesCLI);
259
260 if (Length(cmds) = 0) and showMismatchError then
261 begin
262 MessageDlg(LNG_NOTHING_MATCHES, mtWarning, [mbOK], 0);
263 ExitCode := EXITCODE_TASK_NOTHING_MATCHES;
264 end;
265
266 for i := Low(cmds) to High(cmds) do
267 begin
268 UD2_RunCMD(cmds[i]);
269 end;
270 end;
271
272 procedure TUD2MainForm.FormDestroy(Sender: TObject);
273 var
274 i: integer;
275 begin
276 if Assigned(ud2) then FreeAndNil(ud2);
277
278 for i := 0 to TasksListView.Items.Count-1 do
279 begin
280 TUD2ListViewEntry(TasksListView.Items.Item[i].Data).Free;
281 end;
282 TasksListView.Clear;
283 end;
284
285 procedure TUD2MainForm.CheckForErrors;
286 begin
287 ErrorsTabSheet.TabVisible := ud2.Errors.Count > 0;
288 if ErrorsTabSheet.TabVisible then
289 begin
290 ErrorsMemo.Lines.Assign(ud2.Errors);
291 PageControl1.ActivePage := ErrorsTabSheet;
292 end;
293 end;
294
295 procedure TUD2MainForm.LoadDetectedIDs;
296 var
297 i, j: integer;
298 pl: TUD2Plugin;
299 ude: TUD2IdentificationEntry;
300 begin
301 IdentificationsListView.Clear;
302 for i := 0 to ud2.LoadedPlugins.Count-1 do
303 begin
304 pl := ud2.LoadedPlugins.Items[i] as TUD2Plugin;
305 for j := 0 to pl.DetectedIdentifications.Count-1 do
306 begin
307 ude := pl.DetectedIdentifications.Items[j] as TUD2IdentificationEntry;
308
309 with IdentificationsListView.Items.Add do
310 begin
311 Data := ude;
312 Caption := pl.PluginName;
313 if ude.DynamicDataUsed then
314 SubItems.Add(ude.DynamicData)
315 else
316 SubItems.Add('');
317 SubItems.Add(pl.IdentificationMethodName);
318 SubItems.Add(ude.IdentificationString);
319 SubItems.Add(pl.PluginGUIDString)
320 end;
321 end;
322 end;
323
324 for i := 0 to IdentificationsListView.Columns.Count-1 do
325 begin
326 IdentificationsListView.Columns.Items[i].Width := LVSCW_AUTOSIZE_USEHEADER;
327 end;
328 end;
329
330 procedure TUD2MainForm.LoadINITemplate;
331 var
332 i, j: integer;
333 pl: TUD2Plugin;
334 ude: TUD2IdentificationEntry;
335 idNames: TStringList;
336 begin
337 IniTemplateMemo.Clear;
338 IniTemplateMemo.Lines.Add('[ExampleTask1]');
339 IniTemplateMemo.Lines.Add('; Optional but recommended');
340 IniTemplateMemo.Lines.Add(UD2_TagDescription+'=Run Task #1');
341 IniTemplateMemo.Lines.Add('; Warns when no application was launched. Default: false.');
342 IniTemplateMemo.Lines.Add(TagWarnIfNothingMatchesGUI+'='+DefaultWarnIfNothingMatchesGUI);
343 IniTemplateMemo.Lines.Add(TagWarnIfNothingMatchesCLI+'='+DefaultWarnIfNothingMatchesCLI);
344 IniTemplateMemo.Lines.Add('; Optional: IconDLL + IconIndex');
345 IniTemplateMemo.Lines.Add(TagIcon+'=%SystemRoot%\system32\Shell32.dll,3');
346 IniTemplateMemo.Lines.Add('; Optional: Can be true or false');
347 IniTemplateMemo.Lines.Add(TagCloseAfterLaunching+'='+DefaultCloseAfterLaunching);
348
349 for i := 0 to ud2.LoadedPlugins.Count-1 do
350 begin
351 pl := ud2.LoadedPlugins.Items[i] as TUD2Plugin;
352 for j := 0 to pl.DetectedIdentifications.Count-1 do
353 begin
354 ude := pl.DetectedIdentifications.Items[j] as TUD2IdentificationEntry;
355 IniTemplateMemo.Lines.Add(Format('; %s', [ude.Plugin.PluginName]));
356
357 idNames := TStringList.Create;
358 try
359 ude.GetIdNames(idNames);
360 if idNames.Count >= 1 then
361 IniTemplateMemo.Lines.Add(idNames.Strings[0]+'=calc.exe');
362 finally
363 idNames.Free;
364 end;
365
366 end;
367 end;
368 end;
369
370 procedure TUD2MainForm.LoadLoadedPluginList;
371 resourcestring
372 LNG_MS = '%dms';
373 var
374 i: integer;
375 pl: TUD2Plugin;
376 begin
377 LoadedPluginsListView.Clear;
378 for i := 0 to ud2.LoadedPlugins.Count-1 do
379 begin
380 pl := ud2.LoadedPlugins.Items[i] as TUD2Plugin;
381 with LoadedPluginsListView.Items.Add do
382 begin
383 Data := pl;
384 Caption := pl.PluginDLL;
385 SubItems.Add(pl.PluginVendor);
386 SubItems.Add(pl.PluginName);
387 SubItems.Add(pl.PluginVersion);
388 SubItems.Add(pl.IdentificationMethodName);
389 if pl.AcceptsDynamicRequests then
390 SubItems.Add('Yes')
391 else
392 SubItems.Add('No');
393 SubItems.Add(IntToStr(pl.DetectedIdentifications.Count));
394 SubItems.Add(Format(LNG_MS, [Max(1,pl.LoadingTime)])); // at least show 1ms, otherwise it would look unloggical
395 SubItems.Add(pl.IdentificationProcedureStatusCodeDescribed);
396 SubItems.Add(pl.PluginGUIDString);
397 end;
398 end;
399
400 for i := 0 to LoadedPluginsListView.Columns.Count-1 do
401 begin
402 LoadedPluginsListView.Columns.Items[i].Width := LVSCW_AUTOSIZE_USEHEADER;
403 end;
404 end;
405
406 procedure TUD2MainForm.TasksListViewDblClick(Sender: TObject);
407 var
408 obj: TUD2ListViewEntry;
409 begin
410 if TasksListView.ItemIndex = -1 then exit;
411 obj := TUD2ListViewEntry(TasksListView.Selected.Data);
412 DoRun(obj.ShortTaskName, true);
413 if obj.CloseAfterLaunching then Close;
414 end;
415
416 procedure TUD2MainForm.TasksListViewKeyPress(Sender: TObject; var Key: Char);
417 begin
418 if Key = #13 then
419 begin
420 TasksListViewDblClick(Sender);
421 end;
422 end;
423
424 procedure TUD2MainForm.OpenTDFButtonClick(Sender: TObject);
425 var
426 cmd: TUD2Command;
427 begin
428 cmd.executable := ud2.IniFileName;
429 cmd.runAsAdmin := false;
430 cmd.runInOwnDirectory := false;
431 cmd.windowMode := SW_NORMAL;
432 UD2_RunCMD(cmd);
433 end;
434
435 procedure TUD2MainForm.SaveTDFButtonClick(Sender: TObject);
436 begin
437 if CompatSaveDialogExecute(SaveDialog1) then
438 begin
439 IniTemplateMemo.Lines.SaveToFile(SaveDialog1.FileName);
440 end;
441 end;
442
443 procedure TUD2MainForm.URLLabelClick(Sender: TObject);
444 var
445 cmd: TUD2Command;
446 begin
447 cmd.executable := TLabel(Sender).Caption;
448 if Pos('@', cmd.executable) > 0 then
449 cmd.executable := 'mailto:' + cmd.executable
450 else
451 cmd.executable := 'http://' + cmd.executable;
452
453 cmd.runAsAdmin := false;
454 cmd.runInOwnDirectory := false;
455 cmd.windowMode := SW_NORMAL;
456
457 UD2_RunCMD(cmd);
458 end;
459
460 procedure TUD2MainForm.TasksPopupMenuPopup(Sender: TObject);
461 begin
462 Run1.Enabled := TasksListView.ItemIndex <> -1;
463 Properties1.Enabled := TasksListView.ItemIndex <> -1;
464 end;
465
466 procedure TUD2MainForm.Run1Click(Sender: TObject);
467 begin
468 TasksListViewDblClick(Sender);
469 end;
470
471 procedure TUD2MainForm.Properties1Click(Sender: TObject);
472 var
473 obj: TUD2ListViewEntry;
474 begin
475 if TasksListView.ItemIndex = -1 then exit;
476 obj := TUD2ListViewEntry(TasksListView.Selected.Data);
477 if obj.TaskPropertiesForm = nil then
478 begin
479 obj.TaskPropertiesForm := TUD2TaskPropertiesForm.Create(Self, ud2, obj.ShortTaskName);
480 end;
481 obj.TaskPropertiesForm.Show;
482 end;
483
484 procedure TUD2MainForm.IdentificationsPopupMenuPopup(Sender: TObject);
485 begin
486 CopyTaskDefinitionExample1.Enabled := IdentificationsListView.ItemIndex <> -1;
487 end;
488
489 procedure TUD2MainForm.CopyTaskDefinitionExample1Click(Sender: TObject);
490 var
491 s: string;
492 ude: TUD2IdentificationEntry;
493 begin
494 if IdentificationsListView.ItemIndex = -1 then exit;
495
496 ude := TUD2IdentificationEntry(IdentificationsListView.Selected.Data);
497 s := '; ' + ude.Plugin.PluginName + #13#10 +
498 UD2_CondToStr(ude.GetConditionString(false))+'=calc.exe'+#13#10+
499 #13#10+
500 '; Alternatively:'+#13#10+
501 UD2_CondToStr(ude.GetConditionString(true))+'=calc.exe'+#13#10;
502
503 Clipboard.AsText := s;
504 end;
505
506 procedure TUD2MainForm.ListViewCompare(Sender: TObject; Item1,
507 Item2: TListItem; Data: Integer; var Compare: Integer);
508 var
509 ListView: TVTSListView;
510 begin
511 ListView := Sender as TVTSListView;
512 if ListView.CurSortedColumn = 0 then
513 begin
514 Compare := AlphaNumCompare(Item1.Caption, Item2.Caption);
515 end
516 else
517 begin
518 Compare := AlphaNumCompare(Item1.SubItems[ListView.CurSortedColumn-1],
519 Item2.SubItems[ListView.CurSortedColumn-1]);
520 end;
521 if ListView.CurSortedDesc then Compare := -Compare;
522 end;
523
524 procedure TUD2MainForm.ConvertFirstIconToGray;
525 var
526 buffer, mask: TBitmap;
527 x, y: integer;
528 begin
529 buffer := TBitmap.Create;
530 mask := TBitmap.Create;
531 try
532 TasksImageList.GetBitmap(0, buffer);
533 for x := 0 to buffer.Width - 1 do
534 begin
535 for y := 0 to buffer.Height - 1 do
536 begin
537 buffer.Canvas.Pixels[x, y] := ToGray(buffer.Canvas.Pixels[x, y]);
538 end;
539 end;
540
541 // create a mask for the icon.
542 mask.Assign(buffer);
543 mask.Canvas.Brush.Color := buffer.Canvas.Pixels[0, buffer.Height -1];
544 mask.Monochrome := true;
545
546 TasksImageList.Add(buffer, mask);
547 finally
548 buffer.Free;
549 mask.Free;
550 end;
551 end;
552
553 procedure TUD2MainForm.Button3Click(Sender: TObject);
554 begin
555 VTS_CheckUpdates('userdetect2', VersionLabel.Caption);
556 end;
557
558 procedure TUD2MainForm.LoadedPluginsPopupMenuPopup(Sender: TObject);
559 begin
560 CopyStatusCodeToClipboard.Enabled := LoadedPluginsListView.ItemIndex <> -1;
561 end;
562
563 procedure TUD2MainForm.CopyStatusCodeToClipboardClick(Sender: TObject);
564 var
565 s: string;
566 pl: TUD2Plugin;
567 begin
568 if LoadedPluginsListView.ItemIndex = -1 then exit;
569 pl := TUD2Plugin(LoadedPluginsListView.Selected.Data);
570 s := (*'; ' +*) pl.IdentificationProcedureStatusCodeDescribed;
571 Clipboard.AsText := s;
572 end;
573
574 procedure TUD2MainForm.Run;
575 resourcestring
576 LNG_SYNTAX = 'Syntax: %s [TaskDefinitionFile [/T TaskName] | /C IdentificationTerm [Command] | /?]';
577 var
578 LoadedIniFile: string;
579 begin
580 ExitCode := EXITCODE_OK;
581
582 if ((ParamCount = 1) and CheckBoolParam(1, '?')) or
583 (CheckBoolParam(2, 'T') and (ParamCount > 3)) or
584 (CheckBoolParam(1, 'C') and (ParamCount > 3)) or
585 (not CheckBoolParam(2, 'T') and not CheckBoolParam(1, 'C') and (ParamCount > 1)) then
586 begin
587 ExitCode := EXITCODE_SYNTAX_ERROR;
588 MessageDlg(Format(LNG_SYNTAX, [GetOwnCmdName]), mtInformation, [mbOK], 0);
589
590 Visible := false;
591 Close;
592 Exit;
593 end;
594
595 LoadedIniFile := GetIniFileName;
596 if LoadedIniFile = '' then
597 begin
598 Visible := false;
599 Close;
600 Exit;
601 end;
602 ud2 := TUD2.Create(LoadedIniFile);
603
604 ud2.HandlePluginDir('', '*.udp');
605 ud2.HandlePluginDir('Plugins', '*.udp');
606 ud2.HandlePluginDir('Plugins', '*.dll');
607
608 if CheckBoolParam(1, 'C') then
609 begin
610 if ud2.FulfilsEverySubterm(ParamStr(2)) then
611 begin
612 ExitCode := EXITCODE_OK;
613
614 if ParamStr(3) <> '' then
615 begin
616 UD2_RunCMD(UD2P_DecodeCommand(ParamStr(3)));
617 end;
618 end
619 else
620 begin
621 ExitCode := EXITCODE_TASK_NOTHING_MATCHES;
622 end;
623
624 Visible := false;
625 Close;
626 Exit;
627 end
628 else if CheckBoolParam(2, 'T') then
629 begin
630 DoRun(ParamStr(3), false);
631
632 Visible := false;
633 Close;
634 Exit;
635 end
636 else
637 begin
638 LoadTaskList;
639 LoadDetectedIDs;
640 LoadINITemplate;
641 LoadLoadedPluginList;
642 LoadDynamicPluginList;
643 CheckForErrors;
644
645 Visible := true;
646 Exit;
647 end;
648 end;
649
650 procedure TUD2MainForm.FormCreate(Sender: TObject);
651 begin
652 // To avoid accidental change of the default tab from the IDE VCL Designer
653 PageControl1.ActivePage := TasksTabSheet;
654
655 VersionLabel.Caption := GetFileVersion(ParamStr(0));
656
657 ConvertFirstIconToGray;
658 end;
659
660 procedure TUD2MainForm.DynamicTestButtonClick(Sender: TObject);
661 var
662 p: TUD2Plugin;
663 x: TArrayOfString;
664 newStuff: boolean;
665 errors: TStrings;
666 resourcestring
667 LNG_DETECTED_DYNAMICS = 'The plugin returned following identification strings:';
668 LNG_NOTHING_DETECTED = 'The plugin did not send any identification strings.';
669 LNG_STATUS_RETURNED = 'The plugin sent following status in reply to your request:';
670 LNG_ERROR_RETURNED = 'The dynamic plugin could not load. The plugin sent following error messages:';
671 begin
672 if DynamicTestPluginComboBox.ItemIndex = -1 then
673 begin
674 ShowMessage('Please select a plugin that is accepting dynamic requests.');
675 Exit;
676 end;
677
678 p := DynamicTestPluginComboBox.Items.Objects[DynamicTestPluginComboBox.ItemIndex] as TUD2Plugin;
679
680 errors := TStringList.Create;
681 try
682 newStuff := p.InvokeDynamicCheck(DynamicTestDataEdit.Text, errors, x);
683 if errors.Count > 0 then
684 begin
685 ShowMessage(LNG_ERROR_RETURNED + #13#10#13#10 + errors.Text);
686 Exit;
687 end;
688 finally
689 FreeAndNil(errors);
690 end;
691
692 if p.IdentificationProcedureStatusCode.wCategory <> UD2_STATUSCAT_SUCCESS then
693 begin
694 // e.g. "Not available" because of invalid dynamic input data
695 ShowMessage(LNG_STATUS_RETURNED + #13#10#13#10 + p.IdentificationProcedureStatusCodeDescribed);
696 Exit;
697 end;
698
699 if Length(x) > 0 then
700 ShowMessage(LNG_DETECTED_DYNAMICS + #13#10#13#10 + MergeString(x, #13#10))
701 else
702 ShowMessage(LNG_NOTHING_DETECTED);
703
704 if newStuff then
705 begin
706 LoadDetectedIDs;
707 LoadINITemplate;
708 LoadLoadedPluginList; // To update the "Detected IDs" column
709 end;
710 end;
711
712 procedure TUD2MainForm.LoadDynamicPluginList;
713 var
714 i: integer;
715 p: TUD2Plugin;
716 begin
717 DynamicTestPluginComboBox.Clear;
718 for i := 0 to ud2.LoadedPlugins.Count-1 do
719 begin
720 p := ud2.LoadedPlugins.Items[i] as TUD2Plugin;
721 if p.AcceptsDynamicRequests then
722 begin
723 // TODO: PROBLEM!! Beim Dynamic Check (Dynamic Query) wird der plugin status ├╝berschrieben!!!
724 DynamicTestPluginComboBox.Items.AddObject(p.PluginName, p);
725 end;
726 end;
727 end;
728
729 end.