Subversion Repositories delphiutils

Rev

Rev 68 | Go to most recent revision | Blame | Last modification | View Log | RSS feed

  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. // TODO (idee): lahme DLLs abschießen beim start (per GUI)
  14. // TODO: splash screen wegen DLL load
  15. // TODO: nt4 compat
  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
  107.   ShellAPI, Clipbrd, Math, AlphaNumSort, UD2_Utils, UD2_TaskProperties;
  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;
  330. resourcestring
  331.   LNG_MS = '%dms';
  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);
  347.       SubItems.Add(Format(LNG_MS, [Max(1,pl.time)])); // at least show 1ms, otherwise it would be unloggical
  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
  492.     Compare := AlphaNumCompare(Item1.Caption, Item2.Caption);
  493.   end
  494.   else
  495.   begin
  496.     Compare := AlphaNumCompare(Item1.SubItems[ListView.CurSortedColumn-1],
  497.                                Item2.SubItems[ListView.CurSortedColumn-1]);
  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.
  508.