Subversion Repositories userdetect2

Rev

Rev 80 | Rev 82 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. unit UD2_Obj;
  2.  
  3. interface
  4.  
  5. {$IF CompilerVersion >= 25.0}
  6. {$LEGACYIFEND ON}
  7. {$IFEND}
  8.  
  9. {$INCLUDE 'UserDetect2.inc'}
  10.  
  11. {$WARN UNSAFE_CODE OFF}
  12. {$WARN UNSAFE_TYPE OFF}
  13.  
  14. uses
  15.   Windows, SysUtils, Classes, IniFiles, Contnrs, Dialogs, UD2_PluginIntf,
  16.   UD2_PluginStatus;
  17.  
  18. const
  19.   cchBufferSize = 32768;
  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;
  32.  
  33.     // ONLY contains the non-failure status code of IdentificationStringW
  34.     IdentificationProcedureStatusCode: UD2_STATUS;
  35.     IdentificationProcedureStatusCodeDescribed: WideString;
  36.    
  37.     Time: Cardinal;
  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
  60.     {$IFDEF CHECK_FOR_SAME_PLUGIN_GUID}
  61.     FGUIDLookup: TStrings;
  62.     {$ENDIF}
  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;
  73.  
  74. procedure GetAllIdNames(outSL: TStrings);
  75. function FulfilsEverySubterm(idTerm: WideString; slIdNames: TStrings=nil): boolean;
  76.  
  77.  
  78.     procedure GetCommandList(ShortTaskName: string; outSL: TStrings);
  79.     procedure HandlePluginDir(APluginDir, AFileMask: string);
  80.     procedure GetTaskListing(outSL: TStrings);
  81.     constructor Create(AIniFileName: string);
  82.     destructor Destroy; override;
  83.     function TaskExists(ShortTaskName: string): boolean;
  84.     function ReadMetatagString(ShortTaskName, MetatagName: string; DefaultVal: string): string;
  85.     function ReadMetatagBool(ShortTaskName, MetatagName: string; DefaultVal: string): boolean;
  86.     function GetTaskName(AShortTaskName: string): string;
  87.     class function GenericErrorLookup(grStatus: UD2_STATUS): string;
  88.   end;
  89.  
  90. implementation
  91.  
  92. uses
  93.   UD2_Utils;
  94.  
  95. type
  96.   TUD2PluginLoader = class(TThread)
  97.   protected
  98.     dllFile: string;
  99.     lngID: LANGID;
  100.     procedure Execute; override;
  101.     function HandleDLL: boolean;
  102.   public
  103.     pl: TUD2Plugin;
  104.     Errors: TStringList;
  105.     constructor Create(Suspended: boolean; DLL: string; alngid: LANGID);
  106.     destructor Destroy; override;
  107.   end;
  108.  
  109. class function TUD2.GenericErrorLookup(grStatus: UD2_STATUS): string;
  110. resourcestring
  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)';
  115.  
  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)';
  122.  
  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)';
  128.  
  129.   LNG_UNKNOWN_STATUS                      = 'Unknown status code with unexpected category: %s';
  130. begin
  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
  134.  
  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)])
  140.  
  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
  145.  
  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)]);
  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.  
  202. procedure TUD2.HandlePluginDir(APluginDir, AFileMask: string);
  203. Var
  204.   SR: TSearchRec;
  205.   path: string;
  206.   pluginLoader: TUD2PluginLoader;
  207.   tob: TObjectList;
  208.   i: integer;
  209.   {$IFDEF CHECK_FOR_SAME_PLUGIN_GUID}
  210.   sPluginID, prevDLL: string;
  211.   {$ENDIF}
  212.   lngid: LANGID;
  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
  216.   tob := TObjectList.Create;
  217.   try
  218.     tob.OwnsObjects := false;
  219.  
  220.     lngID := GetSystemDefaultLangID;
  221.  
  222.     path := APluginDir;
  223.     if path <> '' then path := IncludeTrailingPathDelimiter(path);
  224.  
  225.     if FindFirst(path + AFileMask, 0, SR) = 0 then
  226.     begin
  227.       try
  228.         repeat
  229.           try
  230.             tob.Add(TUD2PluginLoader.Create(false, path + sr.Name, lngid));
  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;
  238.       finally
  239.         FindClose(SR);
  240.       end;
  241.     end;
  242.  
  243.     for i := 0 to tob.count-1 do
  244.     begin
  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
  250.       begin
  251.         sPluginID := GUIDToString(pluginLoader.pl.PluginGUID);
  252.         prevDLL := FGUIDLookup.Values[sPluginID];
  253.         if (prevDLL <> '') and (prevDLL <> pluginLoader.pl.PluginDLL) then
  254.         begin
  255.           Errors.Add(Format(LNG_PLUGINS_SAME_GUID, [prevDLL, pluginLoader.pl.PluginDLL]));
  256.           pluginLoader.pl.Free;
  257.         end
  258.         else
  259.         begin
  260.           FGUIDLookup.Values[sPluginID] := pluginLoader.pl.PluginDLL;
  261.           LoadedPlugins.Add(pluginLoader.pl);
  262.         end;
  263.       end;
  264.       {$ENDIF}
  265.       pluginLoader.Free;
  266.     end;
  267.   finally
  268.     tob.free;
  269.   end;
  270. end;
  271.  
  272. destructor TUD2.Destroy;
  273. begin
  274.   FIniFile.Free;
  275.   FLoadedPlugins.Free;
  276.   {$IFDEF CHECK_FOR_SAME_PLUGIN_GUID}
  277.   FGUIDLookup.Free;
  278.   {$ENDIF}
  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);
  287.   {$IFDEF CHECK_FOR_SAME_PLUGIN_GUID}
  288.   FGUIDLookup := TStringList.Create;
  289.   {$ENDIF}
  290.   FErrors := TStringList.Create;
  291. end;
  292.  
  293. function TUD2.GetTaskName(AShortTaskName: string): string;
  294. resourcestring
  295.   LNG_NO_DESCRIPTION = '(%s)';
  296. begin
  297.   result := FIniFile.ReadString(AShortTaskName, 'Description', Format(LNG_NO_DESCRIPTION, [AShortTaskName]));
  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.  
  350. procedure TUD2.GetAllIdNames(outSL: TStrings);
  351. var
  352.   i, j: integer;
  353.   pl: TUD2Plugin;
  354.   ude: TUD2IdentificationEntry;
  355. begin
  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;
  366.  
  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;
  375.   try
  376.     if cleanUpStringList then
  377.     begin
  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
  395.       begin
  396.         result := false;
  397.         break;
  398.       end;
  399.     end;
  400.   finally
  401.     if cleanUpStringList and Assigned(slIdNames) then
  402.       slIdNames.Free;
  403.   end;
  404. end;
  405.  
  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.  
  420.     slSV := TStringList.Create;
  421.     try
  422.       FIniFile.ReadSectionValues(ShortTaskName, slSV);
  423.       for i := 0 to slSV.Count-1 do
  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)
  428.         nameVal := SplitString('=', slSV.Strings[i]);
  429.         idTerm := nameVal[0];
  430.         cmd    := nameVal[1];
  431.  
  432.         if FulfilsEverySubterm(idTerm, slIdNames) then outSL.Add(cmd);
  433.       end;
  434.     finally
  435.       slSV.Free;
  436.     end;
  437.   finally
  438.     slIdNames.Free;
  439.   end;
  440. end;
  441.  
  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.  
  466. function TUD2PluginLoader.HandleDLL: boolean;
  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;
  476.   dllHandle: Cardinal;
  477.   fPluginInterfaceID: TFuncPluginInterfaceID;
  478.   fPluginIdentifier: TFuncPluginIdentifier;
  479.   fPluginNameW: TFuncPluginNameW;
  480.   fPluginVendorW: TFuncPluginVendorW;
  481.   fPluginVersionW: TFuncPluginVersionW;
  482.   fIdentificationMethodNameW: TFuncIdentificationMethodNameW;
  483.   fIdentificationStringW: TFuncIdentificationStringW;
  484.   fCheckLicense: TFuncCheckLicense;
  485.   fDescribeOwnStatusCodeW: TFuncDescribeOwnStatusCodeW;
  486.   statusCode: UD2_STATUS;
  487.   i: integer;
  488.   starttime, endtime, time: cardinal;
  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.  
  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.';
  506.   LNG_INVALID_PLUGIN = 'The plugin "%s" is not a valid plugin for this application.';
  507.   LNG_METHOD_FAILURE = 'Error "%s" at method "%s" of plugin "%s".';
  508. begin
  509.   result := false;
  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.  
  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.  
  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);
  612.     if statusCode.wCategory = UD2_STATUSCAT_FAILED then
  613.     begin
  614.       Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnCheckLicense, dllFile]));
  615.       Exit;
  616.     end;
  617.  
  618.     statusCode := fPluginNameW(@buf, cchBufferSize, lngID);
  619.          if statusCode.wCategory = UD2_STATUSCAT_SUCCESS   then pl.PluginName := PWideChar(@buf)
  620.     else if statusCode.wCategory = UD2_STATUSCAT_NOT_AVAIL then pl.PluginName := ''
  621.     else
  622.     begin
  623.       Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnPluginNameW, dllFile]));
  624.       Exit;
  625.     end;
  626.  
  627.     statusCode := fPluginVendorW(@buf, cchBufferSize, lngID);
  628.          if statusCode.wCategory = UD2_STATUSCAT_SUCCESS   then pl.PluginVendor := PWideChar(@buf)
  629.     else if statusCode.wCategory = UD2_STATUSCAT_NOT_AVAIL then pl.PluginVendor := ''
  630.     else
  631.     begin
  632.       Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnPluginVendorW, dllFile]));
  633.       Exit;
  634.     end;
  635.  
  636.     statusCode := fPluginVersionW(@buf, cchBufferSize, lngID);
  637.          if statusCode.wCategory = UD2_STATUSCAT_SUCCESS   then pl.PluginVersion := PWideChar(@buf)
  638.     else if statusCode.wCategory = UD2_STATUSCAT_NOT_AVAIL then pl.PluginVersion := ''
  639.     else
  640.     begin
  641.       Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnPluginVersionW, dllFile]));
  642.       Exit;
  643.     end;
  644.  
  645.     statusCode := fIdentificationMethodNameW(@buf, cchBufferSize);
  646.          if statusCode.wCategory = UD2_STATUSCAT_SUCCESS   then pl.IdentificationMethodName := PWideChar(@buf)
  647.     else if statusCode.wCategory = UD2_STATUSCAT_NOT_AVAIL then pl.IdentificationMethodName := ''
  648.     else
  649.     begin
  650.       Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnIdentificationMethodNameW, dllFile]));
  651.       Exit;
  652.     end;
  653.  
  654.     statusCode := fIdentificationStringW(@buf, cchBufferSize);
  655.     pl.IdentificationProcedureStatusCode := statusCode;
  656.     pl.IdentificationProcedureStatusCodeDescribed := _ErrorLookup(statusCode);
  657.     if statusCode.wCategory = UD2_STATUSCAT_SUCCESS then
  658.     begin
  659.       sIdentifier := PWideChar(@buf);
  660.       if UD2_STATUS_Equal(statusCode, UD2_STATUS_OK_MULTILINE, false) then
  661.       begin
  662.         // Multiple identifiers (e.g. multiple MAC addresses are delimited via UD2_MULTIPLE_ITEMS_DELIMITER)
  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
  675.     else if statusCode.wCategory <> UD2_STATUSCAT_NOT_AVAIL then
  676.     begin
  677.       // Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnIdentificationStringW, dllFile]));
  678.       Errors.Add(Format(LNG_METHOD_FAILURE, [pl.IdentificationProcedureStatusCodeDescribed, mnIdentificationStringW, dllFile]));
  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.  
  687.     result := true;
  688.   finally
  689.     if not result and Assigned(pl) then FreeAndNil(pl);
  690.     FreeLibrary(dllHandle);
  691.   end;
  692. end;
  693.  
  694. end.
  695.