unit UD2_Main;
interface
{$IF CompilerVersion >= 25.0}
{$LEGACYIFEND ON}
{$IFEND}
{$INCLUDE 'UserDetect2.inc'}
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, ValEdit, UD2_Obj, ComCtrls, ImgList, ExtCtrls,
CommCtrl, Menus, VTSListView, VTSCompat, UD2_PluginStatus, Contnrs,
System.ImageList;
const
DefaultIniFile = 'UserDetect2.ini';
DefaultWarnIfNothingMatchesGUI = 'true';
TagWarnIfNothingMatchesGUI = 'WarnIfNothingMatches.GUI';
DefaultWarnIfNothingMatchesCLI = 'false';
TagWarnIfNothingMatchesCLI = 'WarnIfNothingMatches.CLI';
DefaultCloseAfterLaunching = 'false';
TagCloseAfterLaunching = 'CloseAfterLaunching';
TagIcon = 'Icon';
type
TUD2MainForm = class(TForm)
OpenDialog1: TOpenDialog;
PageControl1: TPageControl;
TasksTabSheet: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
IniTemplateMemo: TMemo;
TabSheet4: TTabSheet;
TasksListView: TVTSListView;
TasksImageList: TImageList;
SaveDialog1: TSaveDialog;
TabSheet5: TTabSheet;
Image1: TImage;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
LoadedPluginsListView: TVTSListView;
IdentificationsListView: TVTSListView;
ErrorsTabSheet: TTabSheet;
ErrorsMemo: TMemo;
Memo1: TMemo;
Panel1: TPanel;
OpenTDFButton: TButton;
SaveTDFButton: TButton;
TasksPopupMenu: TPopupMenu;
Run1: TMenuItem;
Properties1: TMenuItem;
IdentificationsPopupMenu: TPopupMenu;
CopyTaskDefinitionExample1: TMenuItem;
Button3: TButton;
VersionLabel: TLabel;
LoadedPluginsPopupMenu: TPopupMenu;
CopyStatusCodeToClipboard: TMenuItem;
Panel2: TPanel;
Image2: TImage;
DynamicTestGroupbox: TGroupBox;
DynamicTestPluginComboBox: TComboBox;
DynamicTestPluginLabel: TLabel;
DynamicTestDataLabel: TLabel;
DynamicTestDataEdit: TEdit;
DynamicTestButton: TButton;
procedure FormDestroy(Sender: TObject);
procedure TasksListViewDblClick(Sender: TObject);
procedure TasksListViewKeyPress(Sender: TObject; var Key: Char);
procedure OpenTDFButtonClick(Sender: TObject);
procedure SaveTDFButtonClick(Sender: TObject);
procedure URLLabelClick(Sender: TObject);
procedure TasksPopupMenuPopup(Sender: TObject);
procedure Run1Click(Sender: TObject);
procedure Properties1Click(Sender: TObject);
procedure IdentificationsPopupMenuPopup(Sender: TObject);
procedure CopyTaskDefinitionExample1Click(Sender: TObject);
procedure ListViewCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
procedure Button3Click(Sender: TObject);
procedure LoadedPluginsPopupMenuPopup(Sender: TObject);
procedure CopyStatusCodeToClipboardClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure DynamicTestButtonClick(Sender: TObject);
private
procedure ConvertFirstIconToGray;
protected
ud2: TUD2;
procedure LoadTaskList;
procedure LoadDetectedIDs;
procedure LoadINITemplate;
procedure LoadLoadedPluginList;
procedure LoadDynamicPluginList;
function GetIniFileName: string;
procedure DoRun(ShortTaskName: string; gui: boolean);
procedure CheckForErrors;
public
procedure Run;
end;
var
UD2MainForm: TUD2MainForm;
implementation
{$R *.dfm}
uses
ShellAPI, Clipbrd, Math, AlphaNumSort, UD2_Utils, UD2_TaskProperties, UD2_Parsing;
type
TUD2ListViewEntry = class(TObject)
ShortTaskName: string;
CloseAfterLaunching: boolean;
TaskPropertiesForm: TForm;
end;
function AddIconRecToImageList(rec: TIconFileIdx; ImageList: TImageList): integer;
var
icon: TIcon;
begin
icon := TIcon.Create;
try
icon.Handle := ExtractIcon(Application.Handle, PChar(rec.FileName), rec.IconIndex);
// result := ImageList.AddIcon(ico);
result := AddTransparentIconToImageList(ImageList, icon);
AddTransparentIconToImageList(ImageList, icon, true)
finally
icon.Free;
end;
end;
{ TUD2MainForm }
function TUD2MainForm.GetIniFileName: string;
resourcestring
LNG_FILE_NOT_FOUND = 'File "%s" not found.';
begin
if (ParamCount >= 1) and not CheckBoolParam(1, 'C') then
begin
if FileExists(ParamStr(1)) then
begin
result := ParamStr(1);
end
else
begin
ExitCode := EXITCODE_INI_NOT_FOUND;
MessageDlg(Format(LNG_FILE_NOT_FOUND, [ParamStr(1)]), mtError, [mbOK], 0);
result := '';
end;
Exit;
end
else
begin
if FileExists(DefaultIniFile) then
begin
result := DefaultIniFile;
Exit;
end;
if FileExists(GetOwnCmdName + '.ini') then
begin
result := GetOwnCmdName + '.ini';
Exit;
end;
if CompatOpenDialogExecute(OpenDialog1) then
begin
result := OpenDialog1.FileName;
Exit;
end;
result := '';
Exit;
end;
end;
procedure TUD2MainForm.LoadTaskList;
var
sl: TStringList;
i: integer;
ShortTaskName, iconString: string;
iconIndex: integer;
obj: TUD2ListViewEntry;
cmds: TUD2CommandArray;
begin
for i := 0 to TasksListView.Items.Count-1 do
begin
TUD2ListViewEntry(TasksListView.Items.Item[i].Data).Free;
end;
TasksListView.Clear;
sl := TStringList.Create;
try
ud2.GetTaskListing(sl);
for i := 0 to sl.Count-1 do
begin
ShortTaskName := sl.Names[i];
Obj := TUD2ListViewEntry.Create;
Obj.ShortTaskName := ShortTaskName;
Obj.CloseAfterLaunching := ud2.ReadMetatagBool(ShortTaskName, TagCloseAfterLaunching, DefaultCloseAfterLaunching);
TasksListView.AddItem(sl.Values[ShortTaskName], TObject(Obj));
iconString := ud2.ReadMetatagString(ShortTaskName, TagIcon, '');
if iconString <> '' then
begin
iconIndex := AddIconRecToImageList(SplitIconString(iconString), TasksImageList);
if iconIndex <> -1 then
begin
TasksListView.Items.Item[TasksListView.Items.Count-1].ImageIndex := iconIndex;
end;
end;
SetLength(cmds, 0);
cmds := ud2.GetCommandList(obj.ShortTaskName);
if Length(cmds) = 0 then
begin
TasksListView.Items.Item[TasksListView.Items.Count-1].ImageIndex := TasksListView.Items.Item[TasksListView.Items.Count-1].ImageIndex + 1;
end;
end;
finally
sl.Free;
end;
end;
procedure TUD2MainForm.DoRun(ShortTaskName: string; gui: boolean);
resourcestring
LNG_TASK_NOT_EXISTS = 'The task "%s" does not exist in the INI file.';
LNG_NOTHING_MATCHES = 'No identification string matches to your environment. No application was launched. Please check the Task Definition File.';
var
i: integer;
cmds: TUD2CommandArray;
showMismatchError: boolean;
begin
if not ud2.TaskExists(ShortTaskName) then
begin
// This can happen if the task name is taken from command line
MessageDlg(Format(LNG_TASK_NOT_EXISTS, [ShortTaskName]), mtError, [mbOK], 0);
ExitCode := EXITCODE_TASK_NOT_EXISTS;
Exit;
end;
SetLength(cmds, 0);
cmds := ud2.GetCommandList(ShortTaskName); // TODO: What to do with AErrorOut (errors from dynamic queries?)
if gui then
showMismatchError := ud2.ReadMetatagBool(ShortTaskName, TagWarnIfNothingMatchesGUI, DefaultWarnIfNothingMatchesGUI)
else
showMismatchError := ud2.ReadMetatagBool(ShortTaskName, TagWarnIfNothingMatchesCLI, DefaultWarnIfNothingMatchesCLI);
if (Length(cmds) = 0) and showMismatchError then
begin
MessageDlg(LNG_NOTHING_MATCHES, mtWarning, [mbOK], 0);
ExitCode := EXITCODE_TASK_NOTHING_MATCHES;
end;
for i := Low(cmds) to High(cmds) do
begin
UD2_RunCMD(cmds[i]);
end;
end;
procedure TUD2MainForm.FormDestroy(Sender: TObject);
var
i: integer;
begin
if Assigned(ud2) then FreeAndNil(ud2);
for i := 0 to TasksListView.Items.Count-1 do
begin
TUD2ListViewEntry(TasksListView.Items.Item[i].Data).Free;
end;
TasksListView.Clear;
end;
procedure TUD2MainForm.CheckForErrors;
begin
ErrorsTabSheet.TabVisible := ud2.Errors.Count > 0;
if ErrorsTabSheet.TabVisible then
begin
ErrorsMemo.Lines.Assign(ud2.Errors);
PageControl1.ActivePage := ErrorsTabSheet;
end;
end;
procedure TUD2MainForm.LoadDetectedIDs;
var
i, j: integer;
pl: TUD2Plugin;
ude: TUD2IdentificationEntry;
begin
IdentificationsListView.Clear;
for i := 0 to ud2.LoadedPlugins.Count-1 do
begin
pl := ud2.LoadedPlugins.Items[i] as TUD2Plugin;
for j := 0 to pl.DetectedIdentifications.Count-1 do
begin
ude := pl.DetectedIdentifications.Items[j] as TUD2IdentificationEntry;
with IdentificationsListView.Items.Add do
begin
Data := ude;
Caption := pl.PluginName;
if ude.DynamicDataUsed then
SubItems.Add(ude.DynamicData)
else
SubItems.Add('');
SubItems.Add(pl.IdentificationMethodName);
SubItems.Add(ude.IdentificationString);
SubItems.Add(pl.PluginGUIDString)
end;
end;
end;
for i := 0 to IdentificationsListView.Columns.Count-1 do
begin
IdentificationsListView.Columns.Items[i].Width := LVSCW_AUTOSIZE_USEHEADER;
end;
end;
procedure TUD2MainForm.LoadINITemplate;
var
i, j: integer;
pl: TUD2Plugin;
ude: TUD2IdentificationEntry;
idNames: TStringList;
begin
IniTemplateMemo.Clear;
IniTemplateMemo.Lines.Add('[ExampleTask1]');
IniTemplateMemo.Lines.Add('; Optional but recommended');
IniTemplateMemo.Lines.Add(UD2_TagDescription+'=Run Task #1');
IniTemplateMemo.Lines.Add('; Warns when no application was launched. Default: false.');
IniTemplateMemo.Lines.Add(TagWarnIfNothingMatchesGUI+'='+DefaultWarnIfNothingMatchesGUI);
IniTemplateMemo.Lines.Add(TagWarnIfNothingMatchesCLI+'='+DefaultWarnIfNothingMatchesCLI);
IniTemplateMemo.Lines.Add('; Optional: IconDLL + IconIndex');
IniTemplateMemo.Lines.Add(TagIcon+'=%SystemRoot%\system32\Shell32.dll,3');
IniTemplateMemo.Lines.Add('; Optional: Can be true or false');
IniTemplateMemo.Lines.Add(TagCloseAfterLaunching+'='+DefaultCloseAfterLaunching);
for i := 0 to ud2.LoadedPlugins.Count-1 do
begin
pl := ud2.LoadedPlugins.Items[i] as TUD2Plugin;
for j := 0 to pl.DetectedIdentifications.Count-1 do
begin
ude := pl.DetectedIdentifications.Items[j] as TUD2IdentificationEntry;
IniTemplateMemo.Lines.Add(Format('; %s', [ude.Plugin.PluginName]));
idNames := TStringList.Create;
try
ude.GetIdNames(idNames);
if idNames.Count >= 1 then
IniTemplateMemo.Lines.Add(idNames.Strings[0]+'=calc.exe');
finally
idNames.Free;
end;
end;
end;
end;
procedure TUD2MainForm.LoadLoadedPluginList;
resourcestring
LNG_MS = '%dms';
var
i: integer;
pl: TUD2Plugin;
begin
LoadedPluginsListView.Clear;
for i := 0 to ud2.LoadedPlugins.Count-1 do
begin
pl := ud2.LoadedPlugins.Items[i] as TUD2Plugin;
with LoadedPluginsListView.Items.Add do
begin
Data := pl;
Caption := pl.PluginDLL;
SubItems.Add(pl.PluginVendor);
SubItems.Add(pl.PluginName);
SubItems.Add(pl.PluginVersion);
SubItems.Add(pl.IdentificationMethodName);
if pl.AcceptsDynamicRequests then
SubItems.Add('Yes')
else
SubItems.Add('No');
SubItems.Add(IntToStr(pl.DetectedIdentifications.Count));
SubItems.Add(Format(LNG_MS, [Max(1,pl.LoadingTime)])); // at least show 1ms, otherwise it would look unloggical
SubItems.Add(pl.IdentificationProcedureStatusCodeDescribed);
SubItems.Add(pl.PluginGUIDString);
end;
end;
for i := 0 to LoadedPluginsListView.Columns.Count-1 do
begin
LoadedPluginsListView.Columns.Items[i].Width := LVSCW_AUTOSIZE_USEHEADER;
end;
end;
procedure TUD2MainForm.TasksListViewDblClick(Sender: TObject);
var
obj: TUD2ListViewEntry;
begin
if TasksListView.ItemIndex = -1 then exit;
obj := TUD2ListViewEntry(TasksListView.Selected.Data);
DoRun(obj.ShortTaskName, true);
if obj.CloseAfterLaunching then Close;
end;
procedure TUD2MainForm.TasksListViewKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
begin
TasksListViewDblClick(Sender);
end;
end;
procedure TUD2MainForm.OpenTDFButtonClick(Sender: TObject);
var
cmd: TUD2Command;
begin
cmd.executable := ud2.IniFileName;
cmd.runAsAdmin := false;
cmd.runInOwnDirectory := false;
cmd.windowMode := SW_NORMAL;
UD2_RunCMD(cmd);
end;
procedure TUD2MainForm.SaveTDFButtonClick(Sender: TObject);
begin
if CompatSaveDialogExecute(SaveDialog1) then
begin
IniTemplateMemo.Lines.SaveToFile(SaveDialog1.FileName);
end;
end;
procedure TUD2MainForm.URLLabelClick(Sender: TObject);
var
cmd: TUD2Command;
begin
cmd.executable := TLabel(Sender).Caption;
if Pos('@', cmd.executable) > 0 then
cmd.executable := 'mailto:' + cmd.executable
else
cmd.executable := 'http://' + cmd.executable;
cmd.runAsAdmin := false;
cmd.runInOwnDirectory := false;
cmd.windowMode := SW_NORMAL;
UD2_RunCMD(cmd);
end;
procedure TUD2MainForm.TasksPopupMenuPopup(Sender: TObject);
begin
Run1.Enabled := TasksListView.ItemIndex <> -1;
Properties1.Enabled := TasksListView.ItemIndex <> -1;
end;
procedure TUD2MainForm.Run1Click(Sender: TObject);
begin
TasksListViewDblClick(Sender);
end;
procedure TUD2MainForm.Properties1Click(Sender: TObject);
var
obj: TUD2ListViewEntry;
begin
if TasksListView.ItemIndex = -1 then exit;
obj := TUD2ListViewEntry(TasksListView.Selected.Data);
if obj.TaskPropertiesForm = nil then
begin
obj.TaskPropertiesForm := TUD2TaskPropertiesForm.Create(Self, ud2, obj.ShortTaskName);
end;
obj.TaskPropertiesForm.Show;
end;
procedure TUD2MainForm.IdentificationsPopupMenuPopup(Sender: TObject);
begin
CopyTaskDefinitionExample1.Enabled := IdentificationsListView.ItemIndex <> -1;
end;
procedure TUD2MainForm.CopyTaskDefinitionExample1Click(Sender: TObject);
var
s: string;
ude: TUD2IdentificationEntry;
begin
if IdentificationsListView.ItemIndex = -1 then exit;
ude := TUD2IdentificationEntry(IdentificationsListView.Selected.Data);
s := '; ' + ude.Plugin.PluginName + #13#10 +
UD2_CondToStr(ude.GetConditionString(false))+'=calc.exe'+#13#10+
#13#10+
'; Alternatively:'+#13#10+
UD2_CondToStr(ude.GetConditionString(true))+'=calc.exe'+#13#10;
Clipboard.AsText := s;
end;
procedure TUD2MainForm.ListViewCompare(Sender: TObject; Item1,
Item2: TListItem; Data: Integer; var Compare: Integer);
var
ListView: TVTSListView;
begin
ListView := Sender as TVTSListView;
if ListView.CurSortedColumn = 0 then
begin
Compare := AlphaNumCompare(Item1.Caption, Item2.Caption);
end
else
begin
Compare := AlphaNumCompare(Item1.SubItems[ListView.CurSortedColumn-1],
Item2.SubItems[ListView.CurSortedColumn-1]);
end;
if ListView.CurSortedDesc then Compare := -Compare;
end;
procedure TUD2MainForm.ConvertFirstIconToGray;
var
buffer, mask: TBitmap;
x, y: integer;
begin
buffer := TBitmap.Create;
mask := TBitmap.Create;
try
TasksImageList.GetBitmap(0, buffer);
for x := 0 to buffer.Width - 1 do
begin
for y := 0 to buffer.Height - 1 do
begin
buffer.Canvas.Pixels[x, y] := ToGray(buffer.Canvas.Pixels[x, y]);
end;
end;
// create a mask for the icon.
mask.Assign(buffer);
mask.Canvas.Brush.Color := buffer.Canvas.Pixels[0, buffer.Height -1];
mask.Monochrome := true;
TasksImageList.Add(buffer, mask);
finally
buffer.Free;
mask.Free;
end;
end;
procedure TUD2MainForm.Button3Click(Sender: TObject);
begin
VTS_CheckUpdates('userdetect2', VersionLabel.Caption);
end;
procedure TUD2MainForm.LoadedPluginsPopupMenuPopup(Sender: TObject);
begin
CopyStatusCodeToClipboard.Enabled := LoadedPluginsListView.ItemIndex <> -1;
end;
procedure TUD2MainForm.CopyStatusCodeToClipboardClick(Sender: TObject);
var
s: string;
pl: TUD2Plugin;
begin
if LoadedPluginsListView.ItemIndex = -1 then exit;
pl := TUD2Plugin(LoadedPluginsListView.Selected.Data);
s := (*'; ' +*) pl.IdentificationProcedureStatusCodeDescribed;
Clipboard.AsText := s;
end;
procedure TUD2MainForm.Run;
resourcestring
LNG_SYNTAX = 'Syntax: %s [TaskDefinitionFile [/T TaskName] | /C IdentificationTerm [Command] | /?]';
var
LoadedIniFile: string;
begin
ExitCode := EXITCODE_OK;
if ((ParamCount = 1) and CheckBoolParam(1, '?')) or
(CheckBoolParam(2, 'T') and (ParamCount > 3)) or
(CheckBoolParam(1, 'C') and (ParamCount > 3)) or
(not CheckBoolParam(2, 'T') and not CheckBoolParam(1, 'C') and (ParamCount > 1)) then
begin
ExitCode := EXITCODE_SYNTAX_ERROR;
MessageDlg(Format(LNG_SYNTAX, [GetOwnCmdName]), mtInformation, [mbOK], 0);
Visible := false;
Close;
Exit;
end;
LoadedIniFile := GetIniFileName;
if LoadedIniFile = '' then
begin
Visible := false;
Close;
Exit;
end;
ud2 := TUD2.Create(LoadedIniFile);
ud2.HandlePluginDir('', '*.udp');
ud2.HandlePluginDir('Plugins', '*.udp');
ud2.HandlePluginDir('Plugins', '*.dll');
if CheckBoolParam(1, 'C') then
begin
if ud2.FulfilsEverySubterm(ParamStr(2)) then
begin
ExitCode := EXITCODE_OK;
if ParamStr(3) <> '' then
begin
UD2_RunCMD(UD2P_DecodeCommand(ParamStr(3)));
end;
end
else
begin
ExitCode := EXITCODE_TASK_NOTHING_MATCHES;
end;
Visible := false;
Close;
Exit;
end
else if CheckBoolParam(2, 'T') then
begin
DoRun(ParamStr(3), false);
Visible := false;
Close;
Exit;
end
else
begin
LoadTaskList;
LoadDetectedIDs;
LoadINITemplate;
LoadLoadedPluginList;
LoadDynamicPluginList;
CheckForErrors;
Visible := true;
Exit;
end;
end;
procedure TUD2MainForm.FormCreate(Sender: TObject);
begin
// To avoid accidental change of the default tab from the IDE VCL Designer
PageControl1.ActivePage := TasksTabSheet;
VersionLabel.Caption := GetFileVersion(ParamStr(0));
ConvertFirstIconToGray;
end;
procedure TUD2MainForm.DynamicTestButtonClick(Sender: TObject);
var
p: TUD2Plugin;
x: TArrayOfString;
newStuff: boolean;
errors: TStrings;
resourcestring
LNG_DETECTED_DYNAMICS = 'The plugin returned following identification strings:';
LNG_NOTHING_DETECTED = 'The plugin did not send any identification strings.';
LNG_STATUS_RETURNED = 'The plugin sent following status in reply to your request:';
LNG_ERROR_RETURNED = 'The dynamic plugin could not load. The plugin sent following error messages:';
begin
if DynamicTestPluginComboBox.ItemIndex = -1 then
begin
ShowMessage('Please select a plugin that is accepting dynamic requests.');
Exit;
end;
p := DynamicTestPluginComboBox.Items.Objects[DynamicTestPluginComboBox.ItemIndex] as TUD2Plugin;
errors := TStringList.Create;
try
newStuff := p.InvokeDynamicCheck(DynamicTestDataEdit.Text, errors, x);
if errors.Count > 0 then
begin
ShowMessage(LNG_ERROR_RETURNED + #13#10#13#10 + errors.Text);
Exit;
end;
finally
FreeAndNil(errors);
end;
if p.IdentificationProcedureStatusCode.wCategory <> UD2_STATUSCAT_SUCCESS then
begin
// e.g. "Not available" because of invalid dynamic input data
ShowMessage(LNG_STATUS_RETURNED + #13#10#13#10 + p.IdentificationProcedureStatusCodeDescribed);
Exit;
end;
if Length(x) > 0 then
ShowMessage(LNG_DETECTED_DYNAMICS + #13#10#13#10 + MergeString(x, #13#10))
else
ShowMessage(LNG_NOTHING_DETECTED);
if newStuff then
begin
LoadDetectedIDs;
LoadINITemplate;
LoadLoadedPluginList; // To update the "Detected IDs" column
end;
end;
procedure TUD2MainForm.LoadDynamicPluginList;
var
i: integer;
p: TUD2Plugin;
begin
DynamicTestPluginComboBox.Clear;
for i := 0 to ud2.LoadedPlugins.Count-1 do
begin
p := ud2.LoadedPlugins.Items[i] as TUD2Plugin;
if p.AcceptsDynamicRequests then
begin
// TODO: PROBLEM!! Beim Dynamic Check (Dynamic Query) wird der plugin status überschrieben!!!
DynamicTestPluginComboBox.Items.AddObject(p.PluginName, p);
end;
end;
end;
end.