Subversion Repositories userdetect2

Rev

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