Subversion Repositories userdetect2

Rev

Rev 83 | Rev 85 | 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_Obj;
2
 
3
interface
4
 
5
{$IF CompilerVersion >= 25.0}
6
{$LEGACYIFEND ON}
7
{$IFEND}
8
 
70 daniel-mar 9
{$INCLUDE 'UserDetect2.inc'}
10
 
68 daniel-mar 11
uses
71 daniel-mar 12
  Windows, SysUtils, Classes, IniFiles, Contnrs, Dialogs, UD2_PluginIntf,
83 daniel-mar 13
  UD2_PluginStatus, UD2_Utils;
68 daniel-mar 14
 
15
type
83 daniel-mar 16
  TUD2IdentificationEntry = class;
17
 
68 daniel-mar 18
  TUD2Plugin = class(TObject)
19
  protected
20
    FDetectedIdentifications: TObjectList{<TUD2IdentificationEntry>};
21
  public
82 daniel-mar 22
    // This flag will be set if "AutoOSNotSupportedCompatibility" of the INI manifest had to be enforced/used
23
    OSNotSupportedEnforced: boolean;
24
 
68 daniel-mar 25
    PluginDLL: string;
26
    PluginGUID: TGUID;
27
    PluginName: WideString;
28
    PluginVendor: WideString;
29
    PluginVersion: WideString;
30
    IdentificationMethodName: WideString;
70 daniel-mar 31
 
32
    // ONLY contains the non-failure status code of IdentificationStringW
33
    IdentificationProcedureStatusCode: UD2_STATUS;
34
    IdentificationProcedureStatusCodeDescribed: WideString;
83 daniel-mar 35
 
69 daniel-mar 36
    Time: Cardinal;
68 daniel-mar 37
    function PluginGUIDString: string;
83 daniel-mar 38
    property DetectedIdentifications: TObjectList{<TUD2IdentificationEntry>} read FDetectedIdentifications;
68 daniel-mar 39
    destructor Destroy; override;
40
    constructor Create;
83 daniel-mar 41
    function AddIdentification(IdStr: WideString): TUD2IdentificationEntry;
42
 
43
    function InvokeDynamicCheck(dynamicData: string): boolean;
44
    function GetDynamicRequestResult(dynamicData: string): TArrayOfString;
45
 
46
    function EqualsMethodNameOrGuid(idMethodNameOrGUID: string): boolean;
68 daniel-mar 47
  end;
48
 
49
  TUD2IdentificationEntry = class(TObject)
50
  private
51
    FIdentificationString: WideString;
52
    FPlugin: TUD2Plugin;
83 daniel-mar 53
    FDynamicDataUsed: boolean;
54
    FDynamicData: string;
68 daniel-mar 55
  public
83 daniel-mar 56
    property DynamicDataUsed: boolean read FDynamicDataUsed write FDynamicDataUsed;
57
    property DynamicData: string read FDynamicData write FDynamicData;
68 daniel-mar 58
    property IdentificationString: WideString read FIdentificationString;
59
    property Plugin: TUD2Plugin read FPlugin;
60
    procedure GetIdNames(sl: TStrings);
61
    constructor Create(AIdentificationString: WideString; APlugin: TUD2Plugin);
62
  end;
63
 
64
  TUD2 = class(TObject)
65
  private
70 daniel-mar 66
    {$IFDEF CHECK_FOR_SAME_PLUGIN_GUID}
68 daniel-mar 67
    FGUIDLookup: TStrings;
70 daniel-mar 68
    {$ENDIF}
68 daniel-mar 69
  protected
70
    FLoadedPlugins: TObjectList{<TUD2Plugin>};
71
    FIniFile: TMemIniFile;
72
    FErrors: TStrings;
73
    FIniFileName: string;
74
  public
75
    property IniFileName: string read FIniFileName;
76
    property Errors: TStrings read FErrors;
77
    property LoadedPlugins: TObjectList{<TUD2Plugin>} read FLoadedPlugins;
78
    property IniFile: TMemIniFile read FIniFile;
84 daniel-mar 79
    procedure GetAllDetectedIDs(outSL: TStrings);
82 daniel-mar 80
    function FulfilsEverySubterm(idTerm: WideString; slIdNames: TStrings=nil): boolean;
83 daniel-mar 81
    procedure CheckTerm(idTermAndCmd: string; commandSLout: TStrings; slIdNames: TStrings=nil);
82
    function FindPluginByMethodNameOrGuid(idMethodName: string): TUD2Plugin;
68 daniel-mar 83
    procedure GetCommandList(ShortTaskName: string; outSL: TStrings);
80 daniel-mar 84
    procedure HandlePluginDir(APluginDir, AFileMask: string);
68 daniel-mar 85
    procedure GetTaskListing(outSL: TStrings);
86
    constructor Create(AIniFileName: string);
87
    destructor Destroy; override;
88
    function TaskExists(ShortTaskName: string): boolean;
80 daniel-mar 89
    function ReadMetatagString(ShortTaskName, MetatagName: string; DefaultVal: string): string;
90
    function ReadMetatagBool(ShortTaskName, MetatagName: string; DefaultVal: string): boolean;
68 daniel-mar 91
    function GetTaskName(AShortTaskName: string): string;
71 daniel-mar 92
    class function GenericErrorLookup(grStatus: UD2_STATUS): string;
68 daniel-mar 93
  end;
94
 
95
implementation
96
 
97
uses
83 daniel-mar 98
  Math;
68 daniel-mar 99
 
84 daniel-mar 100
const
101
  cchBufferSize = 32768;
102
 
69 daniel-mar 103
type
104
  TUD2PluginLoader = class(TThread)
105
  protected
106
    dllFile: string;
107
    lngID: LANGID;
83 daniel-mar 108
    useDynamicData: boolean;
109
    dynamicData: WideString;
69 daniel-mar 110
    procedure Execute; override;
70 daniel-mar 111
    function HandleDLL: boolean;
69 daniel-mar 112
  public
83 daniel-mar 113
    pl: TUD2Plugin; // TODO: why do we need it?! can it be leaked if we use it for dynamic requests?
69 daniel-mar 114
    Errors: TStringList;
83 daniel-mar 115
    ResultIdentifiers: TArrayOfString;
116
    constructor Create(Suspended: boolean; DLL: string; alngid: LANGID; useDynamicData: boolean; dynamicData: WideString);
69 daniel-mar 117
    destructor Destroy; override;
118
  end;
119
 
71 daniel-mar 120
class function TUD2.GenericErrorLookup(grStatus: UD2_STATUS): string;
68 daniel-mar 121
resourcestring
80 daniel-mar 122
  LNG_STATUS_OK_UNSPECIFIED               = 'Success (Unspecified)';
123
  LNG_STATUS_OK_SINGLELINE                = 'Success (One identifier returned)';
124
  LNG_STATUS_OK_MULTILINE                 = 'Success (Multiple identifiers returned)';
125
  LNG_UNKNOWN_SUCCESS                     = 'Success (Unknown status code %s)';
69 daniel-mar 126
 
80 daniel-mar 127
  LNG_STATUS_NOTAVAIL_UNSPECIFIED         = 'Not available (Unspecified)';
128
  LNG_STATUS_NOTAVAIL_OS_NOT_SUPPORTED    = 'Not available (Operating system not supported)';
129
  LNG_STATUS_NOTAVAIL_HW_NOT_SUPPORTED    = 'Not available (Hardware not supported)';
130
  LNG_STATUS_NOTAVAIL_NO_ENTITIES         = 'Not available (No entities to identify)';
131
  LNG_STATUS_NOTAVAIL_WINAPI_CALL_FAILURE = 'Not available (A Windows API call failed. Message: %s)';
83 daniel-mar 132
  LNG_STATUS_NOTAVAIL_ONLY_ACCEPT_DYNAMIC = 'Not available (Arguments required)';
80 daniel-mar 133
  LNG_UNKNOWN_NOTAVAIL                    = 'Not available (Unknown status code %s)';
69 daniel-mar 134
 
82 daniel-mar 135
  LNG_STATUS_FAILURE_UNSPECIFIED          = 'Error (Unspecified)';
136
  LNG_STATUS_FAILURE_BUFFER_TOO_SMALL     = 'Error (The provided buffer is too small!)';
137
  LNG_STATUS_FAILURE_INVALID_ARGS         = 'Error (The function received invalid arguments!)';
138
  LNG_STATUS_FAILURE_PLUGIN_NOT_LICENSED  = 'Error (The plugin is not licensed)';
139
  LNG_STATUS_FAILURE_NO_RETURNED_VALUE    = 'Error (Plugin did not return a status)';
140
  LNG_STATUS_FAILURE_CATCHED_EXCEPTION    = 'Error (Catched unexpected Exception)';
80 daniel-mar 141
  LNG_UNKNOWN_FAILED                      = 'Error (Unknown status code %s)';
69 daniel-mar 142
 
71 daniel-mar 143
  LNG_UNKNOWN_STATUS                      = 'Unknown status code with unexpected category: %s';
68 daniel-mar 144
begin
71 daniel-mar 145
       if UD2_STATUS_Equal(grStatus, UD2_STATUS_OK_UNSPECIFIED, false)               then result := LNG_STATUS_OK_UNSPECIFIED
146
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_OK_SINGLELINE, false)                then result := LNG_STATUS_OK_SINGLELINE
147
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_OK_MULTILINE, false)                 then result := LNG_STATUS_OK_MULTILINE
69 daniel-mar 148
 
71 daniel-mar 149
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_NOTAVAIL_UNSPECIFIED, false)         then result := LNG_STATUS_NOTAVAIL_UNSPECIFIED
150
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_NOTAVAIL_OS_NOT_SUPPORTED, false)    then result := LNG_STATUS_NOTAVAIL_OS_NOT_SUPPORTED
151
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_NOTAVAIL_HW_NOT_SUPPORTED, false)    then result := LNG_STATUS_NOTAVAIL_HW_NOT_SUPPORTED
152
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_NOTAVAIL_NO_ENTITIES, false)         then result := LNG_STATUS_NOTAVAIL_NO_ENTITIES
153
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_NOTAVAIL_WINAPI_CALL_FAILURE, false) then result := Format(LNG_STATUS_NOTAVAIL_WINAPI_CALL_FAILURE, [FormatOSError(grStatus.dwExtraInfo)])
83 daniel-mar 154
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_NOTAVAIL_ONLY_ACCEPT_DYNAMIC, false) then result := LNG_STATUS_NOTAVAIL_ONLY_ACCEPT_DYNAMIC
69 daniel-mar 155
 
82 daniel-mar 156
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_FAILURE_UNSPECIFIED, false)          then result := LNG_STATUS_FAILURE_UNSPECIFIED
157
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_FAILURE_BUFFER_TOO_SMALL, false)     then result := LNG_STATUS_FAILURE_BUFFER_TOO_SMALL
158
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_FAILURE_INVALID_ARGS, false)         then result := LNG_STATUS_FAILURE_INVALID_ARGS
159
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_FAILURE_PLUGIN_NOT_LICENSED, false)  then result := LNG_STATUS_FAILURE_PLUGIN_NOT_LICENSED
160
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_FAILURE_NO_RETURNED_VALUE, false)    then result := LNG_STATUS_FAILURE_NO_RETURNED_VALUE
161
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_FAILURE_CATCHED_EXCEPTION, false)    then result := LNG_STATUS_FAILURE_CATCHED_EXCEPTION
69 daniel-mar 162
 
71 daniel-mar 163
  else if grStatus.wCategory = UD2_STATUSCAT_SUCCESS   then result := Format(LNG_UNKNOWN_SUCCESS,  [UD2_STATUS_FormatStatusCode(grStatus)])
164
  else if grStatus.wCategory = UD2_STATUSCAT_NOT_AVAIL then result := Format(LNG_UNKNOWN_NOTAVAIL, [UD2_STATUS_FormatStatusCode(grStatus)])
165
  else if grStatus.wCategory = UD2_STATUSCAT_FAILED    then result := Format(LNG_UNKNOWN_FAILED,   [UD2_STATUS_FormatStatusCode(grStatus)])
166
  else                                                      result := Format(LNG_UNKNOWN_STATUS,   [UD2_STATUS_FormatStatusCode(grStatus)]);
68 daniel-mar 167
end;
168
 
169
{ TUD2Plugin }
170
 
171
function TUD2Plugin.PluginGUIDString: string;
172
begin
173
  result := UpperCase(GUIDToString(PluginGUID));
174
end;
175
 
83 daniel-mar 176
function TUD2Plugin.AddIdentification(IdStr: WideString): TUD2IdentificationEntry;
68 daniel-mar 177
begin
83 daniel-mar 178
  result := TUD2IdentificationEntry.Create(IdStr, Self);
179
  DetectedIdentifications.Add(result);
68 daniel-mar 180
end;
181
 
182
destructor TUD2Plugin.Destroy;
183
begin
184
  DetectedIdentifications.Free;
185
  inherited;
186
end;
187
 
188
constructor TUD2Plugin.Create;
189
begin
190
  inherited Create;
191
  FDetectedIdentifications := TObjectList{<TUD2IdentificationEntry>}.Create(true);
192
end;
193
 
83 daniel-mar 194
function TUD2Plugin.InvokeDynamicCheck(dynamicData: string): boolean;
195
var
196
  ude: TUD2IdentificationEntry;
197
  i: integer;
198
  ids: TArrayOfString;
199
  id: string;
200
begin
201
  result := false;
68 daniel-mar 202
 
83 daniel-mar 203
  for i := 0 to FDetectedIdentifications.Count-1 do
204
  begin
205
    ude := FDetectedIdentifications.Items[i] as TUD2IdentificationEntry;
206
    if ude.dynamicDataUsed and (ude.dynamicData = dynamicData) then
207
    begin
208
      // The dynamic content was already evaluated (and therefore is already added in FDetectedIdentifications).
209
      Exit;
210
    end;
211
  end;
212
 
213
  SetLength(ids, 0);
214
  ids := GetDynamicRequestResult(dynamicData);
215
 
216
  for i := 0 to Length(ids)-1 do
217
  begin
218
    id := ids[i];
219
 
220
    ude := AddIdentification(id);
221
    ude.dynamicDataUsed := true;
222
    ude.dynamicData := dynamicData;
223
 
224
    result := true;
225
  end;
226
end;
227
 
228
function TUD2Plugin.GetDynamicRequestResult(dynamicData: string): TArrayOfString;
229
var
230
  lngID: LANGID;
231
  pll: TUD2PluginLoader;
68 daniel-mar 232
begin
83 daniel-mar 233
  lngID := GetSystemDefaultLangID;
234
 
235
  pll := TUD2PluginLoader.Create(false, PluginDLL, lngid, true, dynamicData);
236
  try
237
    pll.WaitFor;
238
    result := pll.ResultIdentifiers;
239
  finally
240
    pll.Free;
241
  end;
68 daniel-mar 242
end;
243
 
83 daniel-mar 244
function TUD2Plugin.EqualsMethodNameOrGuid(idMethodNameOrGUID: string): boolean;
245
begin
246
  result := SameText(IdentificationMethodName, idMethodNameOrGUID) or
247
            SameText(GUIDToString(PluginGUID), idMethodNameOrGUID)
248
end;
249
 
250
{ TUD2IdentificationEntry }
251
 
68 daniel-mar 252
procedure TUD2IdentificationEntry.GetIdNames(sl: TStrings);
253
begin
83 daniel-mar 254
  if DynamicDataUsed then
255
  begin
84 daniel-mar 256
    sl.Add(Plugin.IdentificationMethodName+'('+DynamicData+'):'+IdentificationString);
257
    sl.Add(Plugin.PluginGUIDString+'('+DynamicData+'):'+IdentificationString);
83 daniel-mar 258
  end
259
  else
260
  begin
261
    sl.Add(Plugin.IdentificationMethodName+':'+IdentificationString);
262
    sl.Add(Plugin.PluginGUIDString+':'+IdentificationString);
263
  end;
68 daniel-mar 264
end;
265
 
266
constructor TUD2IdentificationEntry.Create(AIdentificationString: WideString;
267
  APlugin: TUD2Plugin);
268
begin
269
  inherited Create;
270
  FIdentificationString := AIdentificationString;
271
  FPlugin := APlugin;
272
end;
273
 
274
{ TUD2 }
275
 
80 daniel-mar 276
procedure TUD2.HandlePluginDir(APluginDir, AFileMask: string);
69 daniel-mar 277
Var
278
  SR: TSearchRec;
279
  path: string;
70 daniel-mar 280
  pluginLoader: TUD2PluginLoader;
69 daniel-mar 281
  tob: TObjectList;
68 daniel-mar 282
  i: integer;
70 daniel-mar 283
  {$IFDEF CHECK_FOR_SAME_PLUGIN_GUID}
284
  sPluginID, prevDLL: string;
285
  {$ENDIF}
69 daniel-mar 286
  lngid: LANGID;
68 daniel-mar 287
resourcestring
288
  LNG_PLUGINS_SAME_GUID = 'Attention: The plugin "%s" and the plugin "%s" have the same identification GUID. The latter will not be loaded.';
289
begin
69 daniel-mar 290
  tob := TObjectList.Create;
68 daniel-mar 291
  try
69 daniel-mar 292
    tob.OwnsObjects := false;
68 daniel-mar 293
 
69 daniel-mar 294
    lngID := GetSystemDefaultLangID;
68 daniel-mar 295
 
80 daniel-mar 296
    path := APluginDir;
297
    if path <> '' then path := IncludeTrailingPathDelimiter(path);
298
 
299
    if FindFirst(path + AFileMask, 0, SR) = 0 then
68 daniel-mar 300
    begin
301
      try
69 daniel-mar 302
        repeat
303
          try
83 daniel-mar 304
            tob.Add(TUD2PluginLoader.Create(false, path + sr.Name, lngid, false, ''));
69 daniel-mar 305
          except
306
            on E: Exception do
307
            begin
308
              MessageDlg(E.Message, mtError, [mbOK], 0);
309
            end;
310
          end;
311
        until FindNext(SR) <> 0;
68 daniel-mar 312
      finally
69 daniel-mar 313
        FindClose(SR);
68 daniel-mar 314
      end;
315
    end;
316
 
69 daniel-mar 317
    for i := 0 to tob.count-1 do
68 daniel-mar 318
    begin
70 daniel-mar 319
      pluginLoader := tob.items[i] as TUD2PluginLoader;
320
      pluginLoader.WaitFor;
321
      Errors.AddStrings(pluginLoader.Errors);
322
      {$IFDEF CHECK_FOR_SAME_PLUGIN_GUID}
323
      if Assigned(pluginLoader.pl) then
68 daniel-mar 324
      begin
82 daniel-mar 325
        if not pluginLoader.pl.OSNotSupportedEnforced then
69 daniel-mar 326
        begin
82 daniel-mar 327
          sPluginID := GUIDToString(pluginLoader.pl.PluginGUID);
328
          prevDLL := FGUIDLookup.Values[sPluginID];
329
          if (prevDLL <> '') and (prevDLL <> pluginLoader.pl.PluginDLL) then
330
          begin
331
            Errors.Add(Format(LNG_PLUGINS_SAME_GUID, [prevDLL, pluginLoader.pl.PluginDLL]));
332
            pluginLoader.pl.Free;
333
          end
334
          else
335
          begin
336
            FGUIDLookup.Values[sPluginID] := pluginLoader.pl.PluginDLL;
337
            LoadedPlugins.Add(pluginLoader.pl);
338
          end;
69 daniel-mar 339
        end;
68 daniel-mar 340
      end;
70 daniel-mar 341
      {$ENDIF}
342
      pluginLoader.Free;
68 daniel-mar 343
    end;
344
  finally
69 daniel-mar 345
    tob.free;
68 daniel-mar 346
  end;
347
end;
348
 
349
destructor TUD2.Destroy;
350
begin
351
  FIniFile.Free;
352
  FLoadedPlugins.Free;
70 daniel-mar 353
  {$IFDEF CHECK_FOR_SAME_PLUGIN_GUID}
68 daniel-mar 354
  FGUIDLookup.Free;
70 daniel-mar 355
  {$ENDIF}
68 daniel-mar 356
  FErrors.Free;
357
end;
358
 
359
constructor TUD2.Create(AIniFileName: string);
360
begin
361
  FIniFileName := AIniFileName;
362
  FLoadedPlugins := TObjectList{<TUD2Plugin>}.Create(true);
363
  FIniFile := TMemIniFile.Create(IniFileName);
70 daniel-mar 364
  {$IFDEF CHECK_FOR_SAME_PLUGIN_GUID}
68 daniel-mar 365
  FGUIDLookup := TStringList.Create;
70 daniel-mar 366
  {$ENDIF}
68 daniel-mar 367
  FErrors := TStringList.Create;
368
end;
369
 
370
function TUD2.GetTaskName(AShortTaskName: string): string;
69 daniel-mar 371
resourcestring
372
  LNG_NO_DESCRIPTION = '(%s)';
68 daniel-mar 373
begin
69 daniel-mar 374
  result := FIniFile.ReadString(AShortTaskName, 'Description', Format(LNG_NO_DESCRIPTION, [AShortTaskName]));
68 daniel-mar 375
end;
376
 
377
procedure TUD2.GetTaskListing(outSL: TStrings);
378
var
379
  sl: TStringList;
380
  i: integer;
381
  desc: string;
382
begin
383
  sl := TStringList.Create;
384
  try
385
    FIniFile.ReadSections(sl);
386
    for i := 0 to sl.Count-1 do
387
    begin
388
      desc := GetTaskName(sl.Strings[i]);
389
      outSL.Values[sl.Strings[i]] := desc;
390
    end;
391
  finally
392
    sl.Free;
393
  end;
394
end;
395
 
396
function TUD2.TaskExists(ShortTaskName: string): boolean;
397
begin
398
  result := FIniFile.SectionExists(ShortTaskName);
399
end;
400
 
401
function TUD2.ReadMetatagString(ShortTaskName, MetatagName: string;
402
  DefaultVal: string): string;
403
begin
404
  result := IniFile.ReadString(ShortTaskName, MetatagName, DefaultVal);
405
end;
406
 
407
function TUD2.ReadMetatagBool(ShortTaskName, MetatagName: string;
408
  DefaultVal: string): boolean;
409
begin
410
  // DefaultVal is a string, because we want to allow an empty string, in case the
411
  // user wishes an Exception in case the string is not a valid boolean string
412
  result := BetterInterpreteBool(IniFile.ReadString(ShortTaskName, MetatagName, DefaultVal));
413
end;
414
 
415
(*
416
 
84 daniel-mar 417
NAMING EXAMPLE: $CASESENSITIVE$ComputerName(dynXYZ):ABC&&User:John=calc.exe$RIOD$
68 daniel-mar 418
 
84 daniel-mar 419
        idTerm:       ComputerName(dynXYZ):ABC&&User:John
68 daniel-mar 420
        idName:       ComputerName:ABC
421
        IdMethodName: ComputerName
422
        IdStr         ABC
423
        cmd:          calc.exe
83 daniel-mar 424
        dynamicData:  dynXYZ
68 daniel-mar 425
 
426
*)
427
 
84 daniel-mar 428
procedure TUD2.GetAllDetectedIDs(outSL: TStrings);
68 daniel-mar 429
var
430
  i, j: integer;
431
  pl: TUD2Plugin;
432
  ude: TUD2IdentificationEntry;
433
begin
81 daniel-mar 434
  for i := 0 to LoadedPlugins.Count-1 do
435
  begin
436
    pl := LoadedPlugins.Items[i] as TUD2Plugin;
437
    for j := 0 to pl.DetectedIdentifications.Count-1 do
438
    begin
439
      ude := pl.DetectedIdentifications.Items[j] as TUD2IdentificationEntry;
440
      ude.GetIdNames(outSL);
441
    end;
442
  end;
443
end;
68 daniel-mar 444
 
81 daniel-mar 445
function TUD2.FulfilsEverySubterm(idTerm: WideString; slIdNames: TStrings=nil): boolean;
82 daniel-mar 446
const
447
  CASE_SENSITIVE_FLAG = '$CASESENSITIVE$';
81 daniel-mar 448
var
84 daniel-mar 449
  x, a, b: TArrayOfString;
81 daniel-mar 450
  i: integer;
83 daniel-mar 451
  p: TUD2Plugin;
81 daniel-mar 452
  idName: WideString;
453
  cleanUpStringList: boolean;
82 daniel-mar 454
  caseSensitive: boolean;
83 daniel-mar 455
  dynamicData: string;
456
  idMethodName: string;
81 daniel-mar 457
begin
458
  cleanUpStringList := slIdNames = nil;
68 daniel-mar 459
  try
81 daniel-mar 460
    if cleanUpStringList then
68 daniel-mar 461
    begin
81 daniel-mar 462
      slIdNames := TStringList.Create;
84 daniel-mar 463
      GetAllDetectedIDs(slIdNames);
81 daniel-mar 464
    end;
465
 
466
    SetLength(x, 0);
467
    if Pos(':', idTerm) = 0 then
468
    begin
83 daniel-mar 469
      // Exclude stuff like "Description"
81 daniel-mar 470
      result := false;
471
      Exit;
472
    end;
473
    x := SplitString('&&', idTerm);
474
    result := true;
475
    for i := Low(x) to High(x) do
476
    begin
477
      idName := x[i];
478
 
83 daniel-mar 479
      /// --- Start Dynamic Extension
480
 
84 daniel-mar 481
      // xxxxxx ( xxxxx ):  xxxxxxxxxxxx
482
      // xxxxx  ( xx:xx ):  xxxxx:xxx(x)
483
      // xxxxxxxxxxxx    :  xxxxx(xxx)xx
83 daniel-mar 484
 
84 daniel-mar 485
      SetLength(a, 0);
486
      a := SplitString('(', idName);
487
      if (Length(a) >= 2) and (Pos(':', a[0]) = 0) then
83 daniel-mar 488
      begin
84 daniel-mar 489
        SetLength(b, 0);
490
        b := SplitString('):', a[1]);
491
        if Length(b) >= 2 then
492
        begin
493
          dynamicData := b[0];
494
          idMethodName := a[0];
83 daniel-mar 495
 
84 daniel-mar 496
          p := FindPluginByMethodNameOrGuid(idMethodName);
497
          if Assigned(p) then
83 daniel-mar 498
          begin
84 daniel-mar 499
            if p.InvokeDynamicCheck(dynamicData) then
500
            begin
501
              // Reload the identifications
502
              slIdNames.Clear;
503
              GetAllDetectedIDs(slIdNames);
504
            end;
83 daniel-mar 505
          end;
506
        end;
507
      end;
508
 
509
      /// --- End Dynamic Extension
510
 
82 daniel-mar 511
      if Pos(CASE_SENSITIVE_FLAG, idName) >= 1 then
68 daniel-mar 512
      begin
82 daniel-mar 513
        idName := StringReplace(idName, CASE_SENSITIVE_FLAG, '', [rfReplaceAll]);
514
        caseSensitive := true;
515
      end
516
      else
517
      begin
518
        caseSensitive := false;
519
      end;
520
 
521
      if (not caseSensitive and (slIdNames.IndexOf(idName) = -1)) or
522
         (caseSensitive and (IndexOf_CS(slIdNames, idName) = -1)) then
523
      begin
81 daniel-mar 524
        result := false;
525
        break;
68 daniel-mar 526
      end;
527
    end;
81 daniel-mar 528
  finally
529
    if cleanUpStringList and Assigned(slIdNames) then
530
      slIdNames.Free;
531
  end;
532
end;
68 daniel-mar 533
 
83 daniel-mar 534
function TUD2.FindPluginByMethodNameOrGuid(idMethodName: string): TUD2Plugin;
535
var
536
  i: integer;
537
  p: TUD2Plugin;
538
begin
539
  result := nil;
540
  for i := 0 to LoadedPlugins.Count-1 do
541
  begin
542
    p := LoadedPlugins.Items[i] as TUD2Plugin;
543
 
544
    if p.EqualsMethodNameOrGuid(idMethodName) then
545
    begin
546
      result := p;
547
      Exit;
548
    end;
549
  end;
550
end;
551
 
81 daniel-mar 552
procedure TUD2.GetCommandList(ShortTaskName: string; outSL: TStrings);
553
var
554
  i: integer;
555
  slSV, slIdNames: TStrings;
556
begin
557
  slIdNames := TStringList.Create;
558
  try
84 daniel-mar 559
    GetAllDetectedIDs(slIdNames);
81 daniel-mar 560
 
68 daniel-mar 561
    slSV := TStringList.Create;
562
    try
563
      FIniFile.ReadSectionValues(ShortTaskName, slSV);
81 daniel-mar 564
      for i := 0 to slSV.Count-1 do
68 daniel-mar 565
      begin
83 daniel-mar 566
        CheckTerm(slSV.Strings[i], outSL, slIdNames);
68 daniel-mar 567
      end;
568
    finally
569
      slSV.Free;
570
    end;
571
  finally
572
    slIdNames.Free;
573
  end;
574
end;
575
 
83 daniel-mar 576
procedure TUD2.CheckTerm(idTermAndCmd: string; commandSLout: TStrings; slIdNames: TStrings=nil);
577
var
578
  nameVal: TArrayOfString;
579
  idTerm, cmd: string;
580
  slIdNamesCreated: boolean;
581
begin
582
  slIdNamesCreated := false;
583
  try
584
    if not Assigned(slIdNames) then
585
    begin
586
      slIdNamesCreated := true;
587
      slIdNames := TStringList.Create;
84 daniel-mar 588
      GetAllDetectedIDs(slIdNames);
83 daniel-mar 589
    end;
590
 
591
    SetLength(nameVal, 0);
592
 
593
    // We are doing the interpretation of the line ourselves, because
594
    // TStringList.Values[] would not allow multiple command lines with the
595
    // same key (idTerm)
596
    // TODO xxx: big problem when we want to check environment variables, since our idTerm would contain '=' !
597
    nameVal := SplitString('=', idTermAndCmd);
598
    if Length(nameVal) < 2 then exit;
599
    idTerm := nameVal[0];
600
    cmd    := nameVal[1];
601
 
602
    if FulfilsEverySubterm(idTerm, slIdNames) then commandSLout.Add(cmd);
603
  finally
604
    if slIdNamesCreated then slIdNames.Free;
605
  end;
606
end;
607
 
69 daniel-mar 608
{ TUD2PluginLoader }
609
 
610
procedure TUD2PluginLoader.Execute;
611
begin
612
  inherited;
613
 
614
  HandleDLL;
615
end;
616
 
83 daniel-mar 617
constructor TUD2PluginLoader.Create(Suspended: boolean; DLL: string; alngid: LANGID; useDynamicData: boolean; dynamicData: WideString);
69 daniel-mar 618
begin
619
  inherited Create(Suspended);
620
  dllfile := dll;
621
  pl := nil;
622
  Errors := TStringList.Create;
623
  lngid := alngid;
83 daniel-mar 624
  self.useDynamicData := useDynamicData;
625
  Self.dynamicData := dynamicData;
69 daniel-mar 626
end;
627
 
628
destructor TUD2PluginLoader.Destroy;
629
begin
630
  Errors.Free;
631
  inherited;
632
end;
633
 
70 daniel-mar 634
function TUD2PluginLoader.HandleDLL: boolean;
69 daniel-mar 635
var
636
  sIdentifier: WideString;
637
  buf: array[0..cchBufferSize-1] of WideChar;
638
  pluginInterfaceID: TGUID;
70 daniel-mar 639
  dllHandle: Cardinal;
69 daniel-mar 640
  fPluginInterfaceID: TFuncPluginInterfaceID;
641
  fPluginIdentifier: TFuncPluginIdentifier;
642
  fPluginNameW: TFuncPluginNameW;
643
  fPluginVendorW: TFuncPluginVendorW;
644
  fPluginVersionW: TFuncPluginVersionW;
645
  fIdentificationMethodNameW: TFuncIdentificationMethodNameW;
646
  fIdentificationStringW: TFuncIdentificationStringW;
83 daniel-mar 647
  fDynamicIdentificationStringW: TFuncDynamicIdentificationStringW;
69 daniel-mar 648
  fCheckLicense: TFuncCheckLicense;
70 daniel-mar 649
  fDescribeOwnStatusCodeW: TFuncDescribeOwnStatusCodeW;
69 daniel-mar 650
  statusCode: UD2_STATUS;
651
  i: integer;
652
  starttime, endtime, time: cardinal;
82 daniel-mar 653
  bakErrorMode: DWORD;
654
  err: DWORD;
70 daniel-mar 655
 
656
  function _ErrorLookup(statusCode: UD2_STATUS): WideString;
657
  var
658
    ret: BOOL;
83 daniel-mar 659
    buf: array[0..cchBufferSize-1] of WideChar;
70 daniel-mar 660
  begin
82 daniel-mar 661
    if Assigned(fDescribeOwnStatusCodeW) then
70 daniel-mar 662
    begin
82 daniel-mar 663
      ZeroMemory(@buf, cchBufferSize);
664
      ret := fDescribeOwnStatusCodeW(@buf, cchBufferSize, statusCode, lngID);
665
      if ret then
666
      begin
667
        result := PWideChar(@buf);
668
        Exit;
669
      end;
70 daniel-mar 670
    end;
671
    result := TUD2.GenericErrorLookup(statusCode);
672
  end;
673
 
82 daniel-mar 674
  function _ApplyCompatibilityGUID: boolean;
675
  var
676
    iniConfig: TIniFile;
677
    sOverrideGUID: string;
678
    sPluginConfigFile: string;
69 daniel-mar 679
  begin
82 daniel-mar 680
    result := false;
69 daniel-mar 681
    sPluginConfigFile := ChangeFileExt(dllFile, '.ini');
682
    if FileExists(sPluginConfigFile) then
683
    begin
684
      iniConfig := TIniFile.Create(sPluginConfigFile);
685
      try
686
        sOverrideGUID := iniConfig.ReadString('Compatibility', 'OverrideGUID', '');
687
        if sOverrideGUID <> '' then
688
        begin
689
          pl.PluginGUID := StringToGUID(sOverrideGUID);
82 daniel-mar 690
          result := true;
69 daniel-mar 691
        end;
692
      finally
693
        iniConfig.Free;
694
      end;
695
    end;
82 daniel-mar 696
  end;
69 daniel-mar 697
 
82 daniel-mar 698
  function _AutoOSNotSupportedMode: integer;
699
  var
700
    iniConfig: TIniFile;
701
    sPluginConfigFile: string;
702
  begin
703
    result := 0;
704
    sPluginConfigFile := ChangeFileExt(dllFile, '.ini');
705
    if FileExists(sPluginConfigFile) then
69 daniel-mar 706
    begin
82 daniel-mar 707
      iniConfig := TIniFile.Create(sPluginConfigFile);
708
      try
709
        result := iniConfig.ReadInteger('Compatibility', 'AutoOSNotSupported', 0);
710
      finally
711
        iniConfig.Free;
69 daniel-mar 712
      end;
713
    end;
82 daniel-mar 714
  end;
69 daniel-mar 715
 
82 daniel-mar 716
  procedure _OverwriteStatusToOSNotSupported;
717
  begin
718
    pl := TUD2Plugin.Create;
719
    pl.PluginDLL := dllFile;
720
    statusCode := UD2_STATUS_NOTAVAIL_OS_NOT_SUPPORTED;
721
    pl.IdentificationProcedureStatusCode := statusCode;
722
    pl.IdentificationProcedureStatusCodeDescribed := _ErrorLookup(statusCode);
723
    (*
724
    if not _ApplyCompatibilityGUID then
69 daniel-mar 725
    begin
82 daniel-mar 726
      CreateGUID(pl.PluginGUID); // to avoid the "double GUID" error
69 daniel-mar 727
    end;
82 daniel-mar 728
    *)
729
    pl.OSNotSupportedEnforced := true; // to avoid the "double GUID" error
730
    result := true;
731
  end;
69 daniel-mar 732
 
82 daniel-mar 733
resourcestring
734
  LNG_DLL_NOT_LOADED = 'Plugin DLL "%s" could not be loaded: %s';
735
  LNG_METHOD_NOT_FOUND = 'Method "%s" not found in plugin "%s". The DLL is probably not a valid plugin DLL.';
736
  LNG_INVALID_PLUGIN = 'The plugin "%s" is not a valid plugin for this application.';
737
  LNG_METHOD_FAILURE = 'Error "%s" at method "%s" of plugin "%s".';
738
  LNG_EXCEPTION = 'Fatal error while loading "%s" (%s: %s)';
739
begin
740
  result := false;
741
  startTime := GetTickCount;
69 daniel-mar 742
 
82 daniel-mar 743
  try
744
    bakErrorMode := 0;
745
    UD2_SetThreadErrorMode(SEM_FAILCRITICALERRORS, Pointer(bakErrorMode));
746
    try
747
      dllHandle := LoadLibrary(PChar(dllFile));
748
      if dllHandle = 0 then
749
      begin
750
        err := GetLastError;
69 daniel-mar 751
 
82 daniel-mar 752
        if ((_AutoOSNotSupportedMode = 1) and ((err = ERROR_DLL_NOT_FOUND) or (err = ERROR_PROC_NOT_FOUND))) or
753
           (_AutoOSNotSupportedMode >= 2) then
754
        begin
755
          _OverwriteStatusToOSNotSupported;
756
          Exit;
757
        end;
69 daniel-mar 758
 
82 daniel-mar 759
        Errors.Add(Format(LNG_DLL_NOT_LOADED, [dllFile, SysErrorMessage(err)]));
760
        Exit;
761
      end;
762
      try
763
        @fPluginInterfaceID := GetProcAddress(dllHandle, mnPluginInterfaceID);
764
        if not Assigned(fPluginInterfaceID) then
765
        begin
766
          Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnPluginInterfaceID, dllFile]));
767
          Exit;
768
        end;
769
        pluginInterfaceID := fPluginInterfaceID();
770
        if not IsEqualGUID(pluginInterfaceID, GUID_USERDETECT2_IDPLUGIN_V1) then
771
        begin
772
          Errors.Add(Format(LNG_INVALID_PLUGIN, [dllFile]));
773
          Exit;
774
        end;
69 daniel-mar 775
 
83 daniel-mar 776
        fDynamicIdentificationStringW := nil;
777
        fIdentificationStringW := nil;
778
        if useDynamicData then
69 daniel-mar 779
        begin
83 daniel-mar 780
          @fDynamicIdentificationStringW := GetProcAddress(dllHandle, mnDynamicIdentificationStringW);
781
          if not Assigned(fDynamicIdentificationStringW) then
782
          begin
783
            // TODO xxx: Darf hier ein fataler Fehler entstehen, obwohl dieses Szenario nur durch die INI file auftreten kann?
784
            // TODO (allgemein): In der Modulübersicht soll auch gezeigt werden, ob dieses Modul dynamischen Content erlaubt.
785
            // TODO (allgemein): doku
786
            Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnDynamicIdentificationStringW, dllFile]));
787
            Exit;
788
          end;
789
        end
790
        else
791
        begin
792
          @fIdentificationStringW := GetProcAddress(dllHandle, mnIdentificationStringW);
793
          if not Assigned(fIdentificationStringW) then
794
          begin
795
            Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnIdentificationStringW, dllFile]));
796
            Exit;
797
          end;
69 daniel-mar 798
        end;
82 daniel-mar 799
 
800
        @fPluginNameW := GetProcAddress(dllHandle, mnPluginNameW);
801
        if not Assigned(fPluginNameW) then
802
        begin
803
          Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnPluginNameW, dllFile]));
804
          Exit;
805
        end;
806
 
807
        @fPluginVendorW := GetProcAddress(dllHandle, mnPluginVendorW);
808
        if not Assigned(fPluginVendorW) then
809
        begin
810
          Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnPluginVendorW, dllFile]));
811
          Exit;
812
        end;
813
 
814
        @fPluginVersionW := GetProcAddress(dllHandle, mnPluginVersionW);
815
        if not Assigned(fPluginVersionW) then
816
        begin
817
          Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnPluginVersionW, dllFile]));
818
          Exit;
819
        end;
820
 
821
        @fCheckLicense := GetProcAddress(dllHandle, mnCheckLicense);
822
        if not Assigned(fCheckLicense) then
823
        begin
824
          Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnCheckLicense, dllFile]));
825
          Exit;
826
        end;
827
 
828
        @fIdentificationMethodNameW := GetProcAddress(dllHandle, mnIdentificationMethodNameW);
829
        if not Assigned(fIdentificationMethodNameW) then
830
        begin
831
          Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnIdentificationMethodNameW, dllFile]));
832
          Exit;
833
        end;
834
 
835
        @fDescribeOwnStatusCodeW := GetProcAddress(dllHandle, mnDescribeOwnStatusCodeW);
836
        if not Assigned(fDescribeOwnStatusCodeW) then
837
        begin
838
          Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnDescribeOwnStatusCodeW, dllFile]));
839
          Exit;
840
        end;
841
 
842
        pl := TUD2Plugin.Create;
843
        pl.PluginDLL := dllFile;
844
 
845
        if not _ApplyCompatibilityGUID then
846
        begin
847
          @fPluginIdentifier := GetProcAddress(dllHandle, mnPluginIdentifier);
848
          if not Assigned(fPluginIdentifier) then
849
          begin
850
            Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnPluginIdentifier, dllFile]));
851
            Exit;
852
          end;
853
          pl.PluginGUID := fPluginIdentifier();
854
        end;
855
 
856
        statusCode := fCheckLicense(nil);
857
        if statusCode.wCategory = UD2_STATUSCAT_FAILED then
858
        begin
859
          Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnCheckLicense, dllFile]));
860
          Exit;
861
        end;
862
 
863
        ZeroMemory(@buf, cchBufferSize);
864
        statusCode := fPluginNameW(@buf, cchBufferSize, lngID);
865
             if statusCode.wCategory = UD2_STATUSCAT_SUCCESS   then pl.PluginName := PWideChar(@buf)
866
        else if statusCode.wCategory = UD2_STATUSCAT_NOT_AVAIL then pl.PluginName := ''
867
        else
868
        begin
869
          Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnPluginNameW, dllFile]));
870
          Exit;
871
        end;
872
 
873
        ZeroMemory(@buf, cchBufferSize);
874
        statusCode := fPluginVendorW(@buf, cchBufferSize, lngID);
875
             if statusCode.wCategory = UD2_STATUSCAT_SUCCESS   then pl.PluginVendor := PWideChar(@buf)
876
        else if statusCode.wCategory = UD2_STATUSCAT_NOT_AVAIL then pl.PluginVendor := ''
877
        else
878
        begin
879
          Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnPluginVendorW, dllFile]));
880
          Exit;
881
        end;
882
 
883
        ZeroMemory(@buf, cchBufferSize);
884
        statusCode := fPluginVersionW(@buf, cchBufferSize, lngID);
885
             if statusCode.wCategory = UD2_STATUSCAT_SUCCESS   then pl.PluginVersion := PWideChar(@buf)
886
        else if statusCode.wCategory = UD2_STATUSCAT_NOT_AVAIL then pl.PluginVersion := ''
887
        else
888
        begin
889
          Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnPluginVersionW, dllFile]));
890
          Exit;
891
        end;
892
 
893
        ZeroMemory(@buf, cchBufferSize);
894
        statusCode := fIdentificationMethodNameW(@buf, cchBufferSize);
895
             if statusCode.wCategory = UD2_STATUSCAT_SUCCESS   then pl.IdentificationMethodName := PWideChar(@buf)
896
        else if statusCode.wCategory = UD2_STATUSCAT_NOT_AVAIL then pl.IdentificationMethodName := ''
897
        else
898
        begin
899
          Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnIdentificationMethodNameW, dllFile]));
900
          Exit;
901
        end;
902
 
903
        ZeroMemory(@buf, cchBufferSize);
904
        statusCode := UD2_STATUS_FAILURE_NO_RETURNED_VALUE; // This status will be used when the DLL does not return anything (which is an error by the developer)
83 daniel-mar 905
        if useDynamicData then
906
        begin
907
          statusCode := fDynamicIdentificationStringW(@buf, cchBufferSize, PWideChar(dynamicData));
908
        end
909
        else
910
        begin
911
          statusCode := fIdentificationStringW(@buf, cchBufferSize);
912
        end;
82 daniel-mar 913
        pl.IdentificationProcedureStatusCode := statusCode;
914
        pl.IdentificationProcedureStatusCodeDescribed := _ErrorLookup(statusCode);
915
        if statusCode.wCategory = UD2_STATUSCAT_SUCCESS then
916
        begin
917
          sIdentifier := PWideChar(@buf);
918
          if UD2_STATUS_Equal(statusCode, UD2_STATUS_OK_MULTILINE, false) then
919
          begin
920
            // Multiple identifiers (e.g. multiple MAC addresses are delimited via UD2_MULTIPLE_ITEMS_DELIMITER)
83 daniel-mar 921
            SetLength(ResultIdentifiers, 0);
922
            ResultIdentifiers := SplitString(UD2_MULTIPLE_ITEMS_DELIMITER, sIdentifier);
923
            for i := Low(ResultIdentifiers) to High(ResultIdentifiers) do
82 daniel-mar 924
            begin
83 daniel-mar 925
              pl.AddIdentification(ResultIdentifiers[i]);
82 daniel-mar 926
            end;
927
          end
928
          else
929
          begin
930
            pl.AddIdentification(sIdentifier);
83 daniel-mar 931
 
932
            SetLength(ResultIdentifiers, 1);
933
            ResultIdentifiers[0] := sIdentifier;
82 daniel-mar 934
          end;
935
        end
936
        else if statusCode.wCategory <> UD2_STATUSCAT_NOT_AVAIL then
937
        begin
938
          if _AutoOSNotSupportedMode >= 3 then
939
          begin
940
            _OverwriteStatusToOSNotSupported;
941
            Exit;
942
          end;
943
 
944
          // Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnIdentificationStringW, dllFile]));
945
          Errors.Add(Format(LNG_METHOD_FAILURE, [pl.IdentificationProcedureStatusCodeDescribed, mnIdentificationStringW, dllFile]));
946
          Exit;
947
        end;
948
 
949
        result := true;
950
      finally
951
        if not result and Assigned(pl) then FreeAndNil(pl);
952
        FreeLibrary(dllHandle);
953
      end;
954
    finally
955
      UD2_SetThreadErrorMode(bakErrorMode, nil);
956
 
957
      if result then
69 daniel-mar 958
      begin
82 daniel-mar 959
        endtime := GetTickCount;
960
        time := endtime - starttime;
961
        if endtime < starttime then time := High(Cardinal) - time;
962
        pl.time := time;
69 daniel-mar 963
      end;
82 daniel-mar 964
    end;
965
  except
966
    // TODO: when an exception happens in a cdecl DLL, then this code is somehow not
967
    // executed. Probably the memory is corrupted. Anyway, a cdecl DLL shall NEVER
968
    // raise an Exception.
969
    on E: Exception do
69 daniel-mar 970
    begin
82 daniel-mar 971
      Errors.Add(Format(LNG_EXCEPTION, [dllFile, E.ClassName, E.Message]));
69 daniel-mar 972
      Exit;
973
    end;
974
  end;
975
end;
976
 
68 daniel-mar 977
end.