Subversion Repositories userdetect2

Rev

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