Subversion Repositories userdetect2

Rev

Rev 80 | Rev 82 | 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
 
81 daniel-mar 11
{$WARN UNSAFE_CODE OFF}
12
{$WARN UNSAFE_TYPE OFF}
13
 
68 daniel-mar 14
uses
71 daniel-mar 15
  Windows, SysUtils, Classes, IniFiles, Contnrs, Dialogs, UD2_PluginIntf,
16
  UD2_PluginStatus;
68 daniel-mar 17
 
18
const
69 daniel-mar 19
  cchBufferSize = 32768;
68 daniel-mar 20
 
21
type
22
  TUD2Plugin = class(TObject)
23
  protected
24
    FDetectedIdentifications: TObjectList{<TUD2IdentificationEntry>};
25
  public
26
    PluginDLL: string;
27
    PluginGUID: TGUID;
28
    PluginName: WideString;
29
    PluginVendor: WideString;
30
    PluginVersion: WideString;
31
    IdentificationMethodName: WideString;
70 daniel-mar 32
 
33
    // ONLY contains the non-failure status code of IdentificationStringW
34
    IdentificationProcedureStatusCode: UD2_STATUS;
35
    IdentificationProcedureStatusCodeDescribed: WideString;
36
 
69 daniel-mar 37
    Time: Cardinal;
68 daniel-mar 38
    function PluginGUIDString: string;
39
    property DetectedIdentifications: TObjectList{<TUD2IdentificationEntry>}
40
      read FDetectedIdentifications;
41
    destructor Destroy; override;
42
    constructor Create;
43
    procedure AddIdentification(IdStr: WideString);
44
  end;
45
 
46
  TUD2IdentificationEntry = class(TObject)
47
  private
48
    FIdentificationString: WideString;
49
    FPlugin: TUD2Plugin;
50
  public
51
    property IdentificationString: WideString read FIdentificationString;
52
    property Plugin: TUD2Plugin read FPlugin;
53
    function GetPrimaryIdName: WideString;
54
    procedure GetIdNames(sl: TStrings);
55
    constructor Create(AIdentificationString: WideString; APlugin: TUD2Plugin);
56
  end;
57
 
58
  TUD2 = class(TObject)
59
  private
70 daniel-mar 60
    {$IFDEF CHECK_FOR_SAME_PLUGIN_GUID}
68 daniel-mar 61
    FGUIDLookup: TStrings;
70 daniel-mar 62
    {$ENDIF}
68 daniel-mar 63
  protected
64
    FLoadedPlugins: TObjectList{<TUD2Plugin>};
65
    FIniFile: TMemIniFile;
66
    FErrors: TStrings;
67
    FIniFileName: string;
68
  public
69
    property IniFileName: string read FIniFileName;
70
    property Errors: TStrings read FErrors;
71
    property LoadedPlugins: TObjectList{<TUD2Plugin>} read FLoadedPlugins;
72
    property IniFile: TMemIniFile read FIniFile;
81 daniel-mar 73
 
74
procedure GetAllIdNames(outSL: TStrings);
75
function FulfilsEverySubterm(idTerm: WideString; slIdNames: TStrings=nil): boolean;
76
 
77
 
68 daniel-mar 78
    procedure GetCommandList(ShortTaskName: string; outSL: TStrings);
80 daniel-mar 79
    procedure HandlePluginDir(APluginDir, AFileMask: string);
68 daniel-mar 80
    procedure GetTaskListing(outSL: TStrings);
81
    constructor Create(AIniFileName: string);
82
    destructor Destroy; override;
83
    function TaskExists(ShortTaskName: string): boolean;
80 daniel-mar 84
    function ReadMetatagString(ShortTaskName, MetatagName: string; DefaultVal: string): string;
85
    function ReadMetatagBool(ShortTaskName, MetatagName: string; DefaultVal: string): boolean;
68 daniel-mar 86
    function GetTaskName(AShortTaskName: string): string;
71 daniel-mar 87
    class function GenericErrorLookup(grStatus: UD2_STATUS): string;
68 daniel-mar 88
  end;
89
 
90
implementation
91
 
92
uses
70 daniel-mar 93
  UD2_Utils;
68 daniel-mar 94
 
69 daniel-mar 95
type
96
  TUD2PluginLoader = class(TThread)
97
  protected
98
    dllFile: string;
99
    lngID: LANGID;
100
    procedure Execute; override;
70 daniel-mar 101
    function HandleDLL: boolean;
69 daniel-mar 102
  public
103
    pl: TUD2Plugin;
104
    Errors: TStringList;
105
    constructor Create(Suspended: boolean; DLL: string; alngid: LANGID);
106
    destructor Destroy; override;
107
  end;
108
 
71 daniel-mar 109
class function TUD2.GenericErrorLookup(grStatus: UD2_STATUS): string;
68 daniel-mar 110
resourcestring
80 daniel-mar 111
  LNG_STATUS_OK_UNSPECIFIED               = 'Success (Unspecified)';
112
  LNG_STATUS_OK_SINGLELINE                = 'Success (One identifier returned)';
113
  LNG_STATUS_OK_MULTILINE                 = 'Success (Multiple identifiers returned)';
114
  LNG_UNKNOWN_SUCCESS                     = 'Success (Unknown status code %s)';
69 daniel-mar 115
 
80 daniel-mar 116
  LNG_STATUS_NOTAVAIL_UNSPECIFIED         = 'Not available (Unspecified)';
117
  LNG_STATUS_NOTAVAIL_OS_NOT_SUPPORTED    = 'Not available (Operating system not supported)';
118
  LNG_STATUS_NOTAVAIL_HW_NOT_SUPPORTED    = 'Not available (Hardware not supported)';
119
  LNG_STATUS_NOTAVAIL_NO_ENTITIES         = 'Not available (No entities to identify)';
120
  LNG_STATUS_NOTAVAIL_WINAPI_CALL_FAILURE = 'Not available (A Windows API call failed. Message: %s)';
121
  LNG_UNKNOWN_NOTAVAIL                    = 'Not available (Unknown status code %s)';
69 daniel-mar 122
 
80 daniel-mar 123
  LNG_STATUS_ERROR_UNSPECIFIED            = 'Error (Unspecified)';
124
  LNG_STATUS_ERROR_BUFFER_TOO_SMALL       = 'Error (The provided buffer is too small!)';
125
  LNG_STATUS_ERROR_INVALID_ARGS           = 'Error (The function received invalid arguments!)';
126
  LNG_STATUS_ERROR_PLUGIN_NOT_LICENSED    = 'Error (The plugin is not licensed)';
127
  LNG_UNKNOWN_FAILED                      = 'Error (Unknown status code %s)';
69 daniel-mar 128
 
71 daniel-mar 129
  LNG_UNKNOWN_STATUS                      = 'Unknown status code with unexpected category: %s';
68 daniel-mar 130
begin
71 daniel-mar 131
       if UD2_STATUS_Equal(grStatus, UD2_STATUS_OK_UNSPECIFIED, false)               then result := LNG_STATUS_OK_UNSPECIFIED
132
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_OK_SINGLELINE, false)                then result := LNG_STATUS_OK_SINGLELINE
133
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_OK_MULTILINE, false)                 then result := LNG_STATUS_OK_MULTILINE
69 daniel-mar 134
 
71 daniel-mar 135
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_NOTAVAIL_UNSPECIFIED, false)         then result := LNG_STATUS_NOTAVAIL_UNSPECIFIED
136
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_NOTAVAIL_OS_NOT_SUPPORTED, false)    then result := LNG_STATUS_NOTAVAIL_OS_NOT_SUPPORTED
137
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_NOTAVAIL_HW_NOT_SUPPORTED, false)    then result := LNG_STATUS_NOTAVAIL_HW_NOT_SUPPORTED
138
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_NOTAVAIL_NO_ENTITIES, false)         then result := LNG_STATUS_NOTAVAIL_NO_ENTITIES
139
  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)])
69 daniel-mar 140
 
71 daniel-mar 141
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_FAILURE_UNSPECIFIED, false)          then result := LNG_STATUS_ERROR_UNSPECIFIED
142
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_FAILURE_BUFFER_TOO_SMALL, false)     then result := LNG_STATUS_ERROR_BUFFER_TOO_SMALL
143
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_FAILURE_INVALID_ARGS, false)         then result := LNG_STATUS_ERROR_INVALID_ARGS
144
  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_FAILURE_PLUGIN_NOT_LICENSED, false)  then result := LNG_STATUS_ERROR_PLUGIN_NOT_LICENSED
69 daniel-mar 145
 
71 daniel-mar 146
  else if grStatus.wCategory = UD2_STATUSCAT_SUCCESS   then result := Format(LNG_UNKNOWN_SUCCESS,  [UD2_STATUS_FormatStatusCode(grStatus)])
147
  else if grStatus.wCategory = UD2_STATUSCAT_NOT_AVAIL then result := Format(LNG_UNKNOWN_NOTAVAIL, [UD2_STATUS_FormatStatusCode(grStatus)])
148
  else if grStatus.wCategory = UD2_STATUSCAT_FAILED    then result := Format(LNG_UNKNOWN_FAILED,   [UD2_STATUS_FormatStatusCode(grStatus)])
149
  else                                                      result := Format(LNG_UNKNOWN_STATUS,   [UD2_STATUS_FormatStatusCode(grStatus)]);
68 daniel-mar 150
end;
151
 
152
{ TUD2Plugin }
153
 
154
function TUD2Plugin.PluginGUIDString: string;
155
begin
156
  result := UpperCase(GUIDToString(PluginGUID));
157
end;
158
 
159
procedure TUD2Plugin.AddIdentification(IdStr: WideString);
160
begin
161
  DetectedIdentifications.Add(TUD2IdentificationEntry.Create(IdStr, Self))
162
end;
163
 
164
destructor TUD2Plugin.Destroy;
165
begin
166
  DetectedIdentifications.Free;
167
  inherited;
168
end;
169
 
170
constructor TUD2Plugin.Create;
171
begin
172
  inherited Create;
173
  FDetectedIdentifications := TObjectList{<TUD2IdentificationEntry>}.Create(true);
174
end;
175
 
176
{ TUD2IdentificationEntry }
177
 
178
function TUD2IdentificationEntry.GetPrimaryIdName: WideString;
179
begin
180
  result := Plugin.IdentificationMethodName+':'+IdentificationString;
181
end;
182
 
183
procedure TUD2IdentificationEntry.GetIdNames(sl: TStrings);
184
begin
185
  sl.Add(GetPrimaryIdName);
186
  sl.Add(UpperCase(Plugin.IdentificationMethodName)+':'+IdentificationString);
187
  sl.Add(LowerCase(Plugin.IdentificationMethodName)+':'+IdentificationString);
188
  sl.Add(UpperCase(Plugin.PluginGUIDString)+':'+IdentificationString);
189
  sl.Add(LowerCase(Plugin.PluginGUIDString)+':'+IdentificationString);
190
end;
191
 
192
constructor TUD2IdentificationEntry.Create(AIdentificationString: WideString;
193
  APlugin: TUD2Plugin);
194
begin
195
  inherited Create;
196
  FIdentificationString := AIdentificationString;
197
  FPlugin := APlugin;
198
end;
199
 
200
{ TUD2 }
201
 
80 daniel-mar 202
procedure TUD2.HandlePluginDir(APluginDir, AFileMask: string);
69 daniel-mar 203
Var
204
  SR: TSearchRec;
205
  path: string;
70 daniel-mar 206
  pluginLoader: TUD2PluginLoader;
69 daniel-mar 207
  tob: TObjectList;
68 daniel-mar 208
  i: integer;
70 daniel-mar 209
  {$IFDEF CHECK_FOR_SAME_PLUGIN_GUID}
210
  sPluginID, prevDLL: string;
211
  {$ENDIF}
69 daniel-mar 212
  lngid: LANGID;
68 daniel-mar 213
resourcestring
214
  LNG_PLUGINS_SAME_GUID = 'Attention: The plugin "%s" and the plugin "%s" have the same identification GUID. The latter will not be loaded.';
215
begin
69 daniel-mar 216
  tob := TObjectList.Create;
68 daniel-mar 217
  try
69 daniel-mar 218
    tob.OwnsObjects := false;
68 daniel-mar 219
 
69 daniel-mar 220
    lngID := GetSystemDefaultLangID;
68 daniel-mar 221
 
80 daniel-mar 222
    path := APluginDir;
223
    if path <> '' then path := IncludeTrailingPathDelimiter(path);
224
 
225
    if FindFirst(path + AFileMask, 0, SR) = 0 then
68 daniel-mar 226
    begin
227
      try
69 daniel-mar 228
        repeat
229
          try
80 daniel-mar 230
            tob.Add(TUD2PluginLoader.Create(false, path + sr.Name, lngid));
69 daniel-mar 231
          except
232
            on E: Exception do
233
            begin
234
              MessageDlg(E.Message, mtError, [mbOK], 0);
235
            end;
236
          end;
237
        until FindNext(SR) <> 0;
68 daniel-mar 238
      finally
69 daniel-mar 239
        FindClose(SR);
68 daniel-mar 240
      end;
241
    end;
242
 
69 daniel-mar 243
    for i := 0 to tob.count-1 do
68 daniel-mar 244
    begin
70 daniel-mar 245
      pluginLoader := tob.items[i] as TUD2PluginLoader;
246
      pluginLoader.WaitFor;
247
      Errors.AddStrings(pluginLoader.Errors);
248
      {$IFDEF CHECK_FOR_SAME_PLUGIN_GUID}
249
      if Assigned(pluginLoader.pl) then
68 daniel-mar 250
      begin
70 daniel-mar 251
        sPluginID := GUIDToString(pluginLoader.pl.PluginGUID);
252
        prevDLL := FGUIDLookup.Values[sPluginID];
253
        if (prevDLL <> '') and (prevDLL <> pluginLoader.pl.PluginDLL) then
69 daniel-mar 254
        begin
70 daniel-mar 255
          Errors.Add(Format(LNG_PLUGINS_SAME_GUID, [prevDLL, pluginLoader.pl.PluginDLL]));
256
          pluginLoader.pl.Free;
69 daniel-mar 257
        end
258
        else
259
        begin
70 daniel-mar 260
          FGUIDLookup.Values[sPluginID] := pluginLoader.pl.PluginDLL;
261
          LoadedPlugins.Add(pluginLoader.pl);
69 daniel-mar 262
        end;
68 daniel-mar 263
      end;
70 daniel-mar 264
      {$ENDIF}
265
      pluginLoader.Free;
68 daniel-mar 266
    end;
267
  finally
69 daniel-mar 268
    tob.free;
68 daniel-mar 269
  end;
270
end;
271
 
272
destructor TUD2.Destroy;
273
begin
274
  FIniFile.Free;
275
  FLoadedPlugins.Free;
70 daniel-mar 276
  {$IFDEF CHECK_FOR_SAME_PLUGIN_GUID}
68 daniel-mar 277
  FGUIDLookup.Free;
70 daniel-mar 278
  {$ENDIF}
68 daniel-mar 279
  FErrors.Free;
280
end;
281
 
282
constructor TUD2.Create(AIniFileName: string);
283
begin
284
  FIniFileName := AIniFileName;
285
  FLoadedPlugins := TObjectList{<TUD2Plugin>}.Create(true);
286
  FIniFile := TMemIniFile.Create(IniFileName);
70 daniel-mar 287
  {$IFDEF CHECK_FOR_SAME_PLUGIN_GUID}
68 daniel-mar 288
  FGUIDLookup := TStringList.Create;
70 daniel-mar 289
  {$ENDIF}
68 daniel-mar 290
  FErrors := TStringList.Create;
291
end;
292
 
293
function TUD2.GetTaskName(AShortTaskName: string): string;
69 daniel-mar 294
resourcestring
295
  LNG_NO_DESCRIPTION = '(%s)';
68 daniel-mar 296
begin
69 daniel-mar 297
  result := FIniFile.ReadString(AShortTaskName, 'Description', Format(LNG_NO_DESCRIPTION, [AShortTaskName]));
68 daniel-mar 298
end;
299
 
300
procedure TUD2.GetTaskListing(outSL: TStrings);
301
var
302
  sl: TStringList;
303
  i: integer;
304
  desc: string;
305
begin
306
  sl := TStringList.Create;
307
  try
308
    FIniFile.ReadSections(sl);
309
    for i := 0 to sl.Count-1 do
310
    begin
311
      desc := GetTaskName(sl.Strings[i]);
312
      outSL.Values[sl.Strings[i]] := desc;
313
    end;
314
  finally
315
    sl.Free;
316
  end;
317
end;
318
 
319
function TUD2.TaskExists(ShortTaskName: string): boolean;
320
begin
321
  result := FIniFile.SectionExists(ShortTaskName);
322
end;
323
 
324
function TUD2.ReadMetatagString(ShortTaskName, MetatagName: string;
325
  DefaultVal: string): string;
326
begin
327
  result := IniFile.ReadString(ShortTaskName, MetatagName, DefaultVal);
328
end;
329
 
330
function TUD2.ReadMetatagBool(ShortTaskName, MetatagName: string;
331
  DefaultVal: string): boolean;
332
begin
333
  // DefaultVal is a string, because we want to allow an empty string, in case the
334
  // user wishes an Exception in case the string is not a valid boolean string
335
  result := BetterInterpreteBool(IniFile.ReadString(ShortTaskName, MetatagName, DefaultVal));
336
end;
337
 
338
(*
339
 
340
NAMING EXAMPLE: ComputerName:ABC&&User:John=calc.exe
341
 
342
        idTerm:       ComputerName:ABC&&User:John
343
        idName:       ComputerName:ABC
344
        IdMethodName: ComputerName
345
        IdStr         ABC
346
        cmd:          calc.exe
347
 
348
*)
349
 
81 daniel-mar 350
procedure TUD2.GetAllIdNames(outSL: TStrings);
68 daniel-mar 351
var
352
  i, j: integer;
353
  pl: TUD2Plugin;
354
  ude: TUD2IdentificationEntry;
355
begin
81 daniel-mar 356
  for i := 0 to LoadedPlugins.Count-1 do
357
  begin
358
    pl := LoadedPlugins.Items[i] as TUD2Plugin;
359
    for j := 0 to pl.DetectedIdentifications.Count-1 do
360
    begin
361
      ude := pl.DetectedIdentifications.Items[j] as TUD2IdentificationEntry;
362
      ude.GetIdNames(outSL);
363
    end;
364
  end;
365
end;
68 daniel-mar 366
 
81 daniel-mar 367
function TUD2.FulfilsEverySubterm(idTerm: WideString; slIdNames: TStrings=nil): boolean;
368
var
369
  x: TArrayOfString;
370
  i: integer;
371
  idName: WideString;
372
  cleanUpStringList: boolean;
373
begin
374
  cleanUpStringList := slIdNames = nil;
68 daniel-mar 375
  try
81 daniel-mar 376
    if cleanUpStringList then
68 daniel-mar 377
    begin
81 daniel-mar 378
      slIdNames := TStringList.Create;
379
      GetAllIdNames(slIdNames);
380
    end;
381
 
382
    SetLength(x, 0);
383
    if Pos(':', idTerm) = 0 then
384
    begin
385
      result := false;
386
      Exit;
387
    end;
388
    x := SplitString('&&', idTerm);
389
    result := true;
390
    for i := Low(x) to High(x) do
391
    begin
392
      idName := x[i];
393
 
394
      if slIdNames.IndexOf(idName) = -1 then
68 daniel-mar 395
      begin
81 daniel-mar 396
        result := false;
397
        break;
68 daniel-mar 398
      end;
399
    end;
81 daniel-mar 400
  finally
401
    if cleanUpStringList and Assigned(slIdNames) then
402
      slIdNames.Free;
403
  end;
404
end;
68 daniel-mar 405
 
81 daniel-mar 406
procedure TUD2.GetCommandList(ShortTaskName: string; outSL: TStrings);
407
var
408
  i: integer;
409
  cmd: string;
410
  idTerm: WideString;
411
  slSV, slIdNames: TStrings;
412
  nameVal: TArrayOfString;
413
begin
414
  SetLength(nameVal, 0);
415
 
416
  slIdNames := TStringList.Create;
417
  try
418
    GetAllIdNames(slIdNames);
419
 
68 daniel-mar 420
    slSV := TStringList.Create;
421
    try
422
      FIniFile.ReadSectionValues(ShortTaskName, slSV);
81 daniel-mar 423
      for i := 0 to slSV.Count-1 do
68 daniel-mar 424
      begin
425
        // We are doing the interpretation of the line ourselves, because
426
        // TStringList.Values[] would not allow multiple command lines with the
427
        // same key (idTerm)
81 daniel-mar 428
        nameVal := SplitString('=', slSV.Strings[i]);
68 daniel-mar 429
        idTerm := nameVal[0];
430
        cmd    := nameVal[1];
431
 
81 daniel-mar 432
        if FulfilsEverySubterm(idTerm, slIdNames) then outSL.Add(cmd);
68 daniel-mar 433
      end;
434
    finally
435
      slSV.Free;
436
    end;
437
  finally
438
    slIdNames.Free;
439
  end;
440
end;
441
 
69 daniel-mar 442
{ TUD2PluginLoader }
443
 
444
procedure TUD2PluginLoader.Execute;
445
begin
446
  inherited;
447
 
448
  HandleDLL;
449
end;
450
 
451
constructor TUD2PluginLoader.Create(Suspended: boolean; DLL: string; alngid: LANGID);
452
begin
453
  inherited Create(Suspended);
454
  dllfile := dll;
455
  pl := nil;
456
  Errors := TStringList.Create;
457
  lngid := alngid;
458
end;
459
 
460
destructor TUD2PluginLoader.Destroy;
461
begin
462
  Errors.Free;
463
  inherited;
464
end;
465
 
70 daniel-mar 466
function TUD2PluginLoader.HandleDLL: boolean;
69 daniel-mar 467
var
468
  sIdentifier: WideString;
469
  sIdentifiers: TArrayOfString;
470
  buf: array[0..cchBufferSize-1] of WideChar;
471
  sPluginConfigFile: string;
472
  iniConfig: TINIFile;
473
  sOverrideGUID: string;
474
  pluginIDfound: boolean;
475
  pluginInterfaceID: TGUID;
70 daniel-mar 476
  dllHandle: Cardinal;
69 daniel-mar 477
  fPluginInterfaceID: TFuncPluginInterfaceID;
478
  fPluginIdentifier: TFuncPluginIdentifier;
479
  fPluginNameW: TFuncPluginNameW;
480
  fPluginVendorW: TFuncPluginVendorW;
481
  fPluginVersionW: TFuncPluginVersionW;
482
  fIdentificationMethodNameW: TFuncIdentificationMethodNameW;
483
  fIdentificationStringW: TFuncIdentificationStringW;
484
  fCheckLicense: TFuncCheckLicense;
70 daniel-mar 485
  fDescribeOwnStatusCodeW: TFuncDescribeOwnStatusCodeW;
69 daniel-mar 486
  statusCode: UD2_STATUS;
487
  i: integer;
488
  starttime, endtime, time: cardinal;
70 daniel-mar 489
 
490
  function _ErrorLookup(statusCode: UD2_STATUS): WideString;
491
  var
492
    ret: BOOL;
493
  begin
494
    ret := fDescribeOwnStatusCodeW(@buf, cchBufferSize, statusCode, lngID);
495
    if ret then
496
    begin
497
      result := PWideChar(@buf);
498
      Exit;
499
    end;
500
    result := TUD2.GenericErrorLookup(statusCode);
501
  end;
502
 
69 daniel-mar 503
resourcestring
504
  LNG_DLL_NOT_LOADED = 'Plugin DLL "%s" could not be loaded.';
505
  LNG_METHOD_NOT_FOUND = 'Method "%s" not found in plugin "%s". The DLL is probably not a valid plugin DLL.';
80 daniel-mar 506
  LNG_INVALID_PLUGIN = 'The plugin "%s" is not a valid plugin for this application.';
69 daniel-mar 507
  LNG_METHOD_FAILURE = 'Error "%s" at method "%s" of plugin "%s".';
508
begin
70 daniel-mar 509
  result := false;
69 daniel-mar 510
  startTime := GetTickCount;
511
 
512
  dllHandle := LoadLibrary(PChar(dllFile));
513
  if dllHandle = 0 then
514
  begin
515
    Errors.Add(Format(LNG_DLL_NOT_LOADED, [dllFile]));
516
  end;
517
  try
518
    @fPluginInterfaceID := GetProcAddress(dllHandle, mnPluginInterfaceID);
519
    if not Assigned(fPluginInterfaceID) then
520
    begin
521
      Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnPluginInterfaceID, dllFile]));
522
      Exit;
523
    end;
524
    pluginInterfaceID := fPluginInterfaceID();
525
    if not IsEqualGUID(pluginInterfaceID, GUID_USERDETECT2_IDPLUGIN_V1) then
526
    begin
527
      Errors.Add(Format(LNG_INVALID_PLUGIN, [dllFile]));
528
      Exit;
529
    end;
530
 
531
    @fIdentificationStringW := GetProcAddress(dllHandle, mnIdentificationStringW);
532
    if not Assigned(fIdentificationStringW) then
533
    begin
534
      Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnIdentificationStringW, dllFile]));
535
      Exit;
536
    end;
537
 
538
    @fPluginNameW := GetProcAddress(dllHandle, mnPluginNameW);
539
    if not Assigned(fPluginNameW) then
540
    begin
541
      Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnPluginNameW, dllFile]));
542
      Exit;
543
    end;
544
 
545
    @fPluginVendorW := GetProcAddress(dllHandle, mnPluginVendorW);
546
    if not Assigned(fPluginVendorW) then
547
    begin
548
      Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnPluginVendorW, dllFile]));
549
      Exit;
550
    end;
551
 
552
    @fPluginVersionW := GetProcAddress(dllHandle, mnPluginVersionW);
553
    if not Assigned(fPluginVersionW) then
554
    begin
555
      Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnPluginVersionW, dllFile]));
556
      Exit;
557
    end;
558
 
559
    @fCheckLicense := GetProcAddress(dllHandle, mnCheckLicense);
560
    if not Assigned(fCheckLicense) then
561
    begin
562
      Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnCheckLicense, dllFile]));
563
      Exit;
564
    end;
565
 
566
    @fIdentificationMethodNameW := GetProcAddress(dllHandle, mnIdentificationMethodNameW);
567
    if not Assigned(fIdentificationMethodNameW) then
568
    begin
569
      Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnIdentificationMethodNameW, dllFile]));
570
      Exit;
571
    end;
572
 
70 daniel-mar 573
    @fDescribeOwnStatusCodeW := GetProcAddress(dllHandle, mnDescribeOwnStatusCodeW);
574
    if not Assigned(fDescribeOwnStatusCodeW) then
575
    begin
576
      Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnDescribeOwnStatusCodeW, dllFile]));
577
      Exit;
578
    end;
579
 
69 daniel-mar 580
    pl := TUD2Plugin.Create;
581
    pl.PluginDLL := dllFile;
582
 
583
    pluginIDfound := false;
584
    sPluginConfigFile := ChangeFileExt(dllFile, '.ini');
585
    if FileExists(sPluginConfigFile) then
586
    begin
587
      iniConfig := TIniFile.Create(sPluginConfigFile);
588
      try
589
        sOverrideGUID := iniConfig.ReadString('Compatibility', 'OverrideGUID', '');
590
        if sOverrideGUID <> '' then
591
        begin
592
          pl.PluginGUID := StringToGUID(sOverrideGUID);
593
          pluginIDfound := true;
594
        end;
595
      finally
596
        iniConfig.Free;
597
      end;
598
    end;
599
 
600
    if not pluginIDfound then
601
    begin
602
      @fPluginIdentifier := GetProcAddress(dllHandle, mnPluginIdentifier);
603
      if not Assigned(fPluginIdentifier) then
604
      begin
605
        Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnPluginIdentifier, dllFile]));
606
        Exit;
607
      end;
608
      pl.PluginGUID := fPluginIdentifier();
609
    end;
610
 
611
    statusCode := fCheckLicense(nil);
71 daniel-mar 612
    if statusCode.wCategory = UD2_STATUSCAT_FAILED then
69 daniel-mar 613
    begin
70 daniel-mar 614
      Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnCheckLicense, dllFile]));
69 daniel-mar 615
      Exit;
616
    end;
617
 
618
    statusCode := fPluginNameW(@buf, cchBufferSize, lngID);
71 daniel-mar 619
         if statusCode.wCategory = UD2_STATUSCAT_SUCCESS   then pl.PluginName := PWideChar(@buf)
620
    else if statusCode.wCategory = UD2_STATUSCAT_NOT_AVAIL then pl.PluginName := ''
69 daniel-mar 621
    else
622
    begin
70 daniel-mar 623
      Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnPluginNameW, dllFile]));
69 daniel-mar 624
      Exit;
625
    end;
626
 
627
    statusCode := fPluginVendorW(@buf, cchBufferSize, lngID);
71 daniel-mar 628
         if statusCode.wCategory = UD2_STATUSCAT_SUCCESS   then pl.PluginVendor := PWideChar(@buf)
629
    else if statusCode.wCategory = UD2_STATUSCAT_NOT_AVAIL then pl.PluginVendor := ''
69 daniel-mar 630
    else
631
    begin
70 daniel-mar 632
      Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnPluginVendorW, dllFile]));
69 daniel-mar 633
      Exit;
634
    end;
635
 
636
    statusCode := fPluginVersionW(@buf, cchBufferSize, lngID);
71 daniel-mar 637
         if statusCode.wCategory = UD2_STATUSCAT_SUCCESS   then pl.PluginVersion := PWideChar(@buf)
638
    else if statusCode.wCategory = UD2_STATUSCAT_NOT_AVAIL then pl.PluginVersion := ''
69 daniel-mar 639
    else
640
    begin
70 daniel-mar 641
      Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnPluginVersionW, dllFile]));
69 daniel-mar 642
      Exit;
643
    end;
644
 
645
    statusCode := fIdentificationMethodNameW(@buf, cchBufferSize);
71 daniel-mar 646
         if statusCode.wCategory = UD2_STATUSCAT_SUCCESS   then pl.IdentificationMethodName := PWideChar(@buf)
647
    else if statusCode.wCategory = UD2_STATUSCAT_NOT_AVAIL then pl.IdentificationMethodName := ''
69 daniel-mar 648
    else
649
    begin
70 daniel-mar 650
      Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnIdentificationMethodNameW, dllFile]));
69 daniel-mar 651
      Exit;
652
    end;
653
 
654
    statusCode := fIdentificationStringW(@buf, cchBufferSize);
70 daniel-mar 655
    pl.IdentificationProcedureStatusCode := statusCode;
656
    pl.IdentificationProcedureStatusCodeDescribed := _ErrorLookup(statusCode);
71 daniel-mar 657
    if statusCode.wCategory = UD2_STATUSCAT_SUCCESS then
69 daniel-mar 658
    begin
659
      sIdentifier := PWideChar(@buf);
71 daniel-mar 660
      if UD2_STATUS_Equal(statusCode, UD2_STATUS_OK_MULTILINE, false) then
69 daniel-mar 661
      begin
70 daniel-mar 662
        // Multiple identifiers (e.g. multiple MAC addresses are delimited via UD2_MULTIPLE_ITEMS_DELIMITER)
69 daniel-mar 663
        SetLength(sIdentifiers, 0);
664
        sIdentifiers := SplitString(UD2_MULTIPLE_ITEMS_DELIMITER, sIdentifier);
665
        for i := Low(sIdentifiers) to High(sIdentifiers) do
666
        begin
667
          pl.AddIdentification(sIdentifiers[i]);
668
        end;
669
      end
670
      else
671
      begin
672
        pl.AddIdentification(sIdentifier);
673
      end;
674
    end
71 daniel-mar 675
    else if statusCode.wCategory <> UD2_STATUSCAT_NOT_AVAIL then
69 daniel-mar 676
    begin
70 daniel-mar 677
      // Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnIdentificationStringW, dllFile]));
678
      Errors.Add(Format(LNG_METHOD_FAILURE, [pl.IdentificationProcedureStatusCodeDescribed, mnIdentificationStringW, dllFile]));
69 daniel-mar 679
      Exit;
680
    end;
681
 
682
    endtime := GetTickCount;
683
    time := endtime - starttime;
684
    if endtime < starttime then time := High(Cardinal) - time;
685
    pl.time := time;
686
 
70 daniel-mar 687
    result := true;
69 daniel-mar 688
  finally
70 daniel-mar 689
    if not result and Assigned(pl) then FreeAndNil(pl);
69 daniel-mar 690
    FreeLibrary(dllHandle);
691
  end;
692
end;
693
 
68 daniel-mar 694
end.