WebSVN – userdetect2 – Diff – /trunk/UserDetect2/UD2_Obj.pas

 unit UD2_Obj;
 interface
 {$IF CompilerVersion >= 25.0}
 {$LEGACYIFEND ON}
 {$IFEND}
 {$INCLUDE 'UserDetect2.inc'}
-{$WARN UNSAFE_CODE OFF}
-{$WARN UNSAFE_TYPE OFF}
 uses
   Windows, SysUtils, Classes, IniFiles, Contnrs, Dialogs, UD2_PluginIntf,
   UD2_PluginStatus;
 const
   cchBufferSize = 32768;
 type
   TUD2Plugin = class(TObject)
   protected
     FDetectedIdentifications: TObjectList{<TUD2IdentificationEntry>};
   public
+    // This flag will be set if "AutoOSNotSupportedCompatibility" of the INI manifest had to be enforced/used
+    OSNotSupportedEnforced: boolean;
     PluginDLL: string;
     PluginGUID: TGUID;
     PluginName: WideString;
     PluginVendor: WideString;
     PluginVersion: WideString;
     IdentificationMethodName: WideString;
     // ONLY contains the non-failure status code of IdentificationStringW
     IdentificationProcedureStatusCode: UD2_STATUS;
     IdentificationProcedureStatusCodeDescribed: WideString;
     Time: Cardinal;
     function PluginGUIDString: string;
     property DetectedIdentifications: TObjectList{<TUD2IdentificationEntry>}
       read FDetectedIdentifications;
     destructor Destroy; override;
     constructor Create;
     procedure AddIdentification(IdStr: WideString);
   end;
   TUD2IdentificationEntry = class(TObject)
   private
     FIdentificationString: WideString;
     FPlugin: TUD2Plugin;
   public
     property IdentificationString: WideString read FIdentificationString;
     property Plugin: TUD2Plugin read FPlugin;
     function GetPrimaryIdName: WideString;
     procedure GetIdNames(sl: TStrings);
     constructor Create(AIdentificationString: WideString; APlugin: TUD2Plugin);
   end;
   TUD2 = class(TObject)
   private
     {$IFDEF CHECK_FOR_SAME_PLUGIN_GUID}
     FGUIDLookup: TStrings;
     {$ENDIF}
   protected
     FLoadedPlugins: TObjectList{<TUD2Plugin>};
     FIniFile: TMemIniFile;
     FErrors: TStrings;
     FIniFileName: string;
   public
     property IniFileName: string read FIniFileName;
     property Errors: TStrings read FErrors;
     property LoadedPlugins: TObjectList{<TUD2Plugin>} read FLoadedPlugins;
     property IniFile: TMemIniFile read FIniFile;
-procedure GetAllIdNames(outSL: TStrings);
+    procedure GetAllIdNames(outSL: TStrings);
-function FulfilsEverySubterm(idTerm: WideString; slIdNames: TStrings=nil): boolean;
+    function FulfilsEverySubterm(idTerm: WideString; slIdNames: TStrings=nil): boolean;
     procedure GetCommandList(ShortTaskName: string; outSL: TStrings);
     procedure HandlePluginDir(APluginDir, AFileMask: string);
     procedure GetTaskListing(outSL: TStrings);
     constructor Create(AIniFileName: string);
     destructor Destroy; override;
     function TaskExists(ShortTaskName: string): boolean;
     function ReadMetatagString(ShortTaskName, MetatagName: string; DefaultVal: string): string;
     function ReadMetatagBool(ShortTaskName, MetatagName: string; DefaultVal: string): boolean;
     function GetTaskName(AShortTaskName: string): string;
     class function GenericErrorLookup(grStatus: UD2_STATUS): string;
   end;
 implementation
 uses
   UD2_Utils;
 type
   TUD2PluginLoader = class(TThread)
   protected
     dllFile: string;
     lngID: LANGID;
     procedure Execute; override;
     function HandleDLL: boolean;
   public
     pl: TUD2Plugin;
     Errors: TStringList;
     constructor Create(Suspended: boolean; DLL: string; alngid: LANGID);
     destructor Destroy; override;
   end;
 class function TUD2.GenericErrorLookup(grStatus: UD2_STATUS): string;
 resourcestring
   LNG_STATUS_OK_UNSPECIFIED               = 'Success (Unspecified)';
   LNG_STATUS_OK_SINGLELINE                = 'Success (One identifier returned)';
   LNG_STATUS_OK_MULTILINE                 = 'Success (Multiple identifiers returned)';
   LNG_UNKNOWN_SUCCESS                     = 'Success (Unknown status code %s)';
   LNG_STATUS_NOTAVAIL_UNSPECIFIED         = 'Not available (Unspecified)';
   LNG_STATUS_NOTAVAIL_OS_NOT_SUPPORTED    = 'Not available (Operating system not supported)';
   LNG_STATUS_NOTAVAIL_HW_NOT_SUPPORTED    = 'Not available (Hardware not supported)';
   LNG_STATUS_NOTAVAIL_NO_ENTITIES         = 'Not available (No entities to identify)';
   LNG_STATUS_NOTAVAIL_WINAPI_CALL_FAILURE = 'Not available (A Windows API call failed. Message: %s)';
   LNG_UNKNOWN_NOTAVAIL                    = 'Not available (Unknown status code %s)';
-  LNG_STATUS_ERROR_UNSPECIFIED            = 'Error (Unspecified)';
+  LNG_STATUS_FAILURE_UNSPECIFIED          = 'Error (Unspecified)';
-  LNG_STATUS_ERROR_BUFFER_TOO_SMALL       = 'Error (The provided buffer is too small!)';
+  LNG_STATUS_FAILURE_BUFFER_TOO_SMALL     = 'Error (The provided buffer is too small!)';
-  LNG_STATUS_ERROR_INVALID_ARGS           = 'Error (The function received invalid arguments!)';
+  LNG_STATUS_FAILURE_INVALID_ARGS         = 'Error (The function received invalid arguments!)';
-  LNG_STATUS_ERROR_PLUGIN_NOT_LICENSED    = 'Error (The plugin is not licensed)';
+  LNG_STATUS_FAILURE_PLUGIN_NOT_LICENSED  = 'Error (The plugin is not licensed)';
+  LNG_STATUS_FAILURE_NO_RETURNED_VALUE    = 'Error (Plugin did not return a status)';
+  LNG_STATUS_FAILURE_CATCHED_EXCEPTION    = 'Error (Catched unexpected Exception)';
   LNG_UNKNOWN_FAILED                      = 'Error (Unknown status code %s)';
   LNG_UNKNOWN_STATUS                      = 'Unknown status code with unexpected category: %s';
 begin
        if UD2_STATUS_Equal(grStatus, UD2_STATUS_OK_UNSPECIFIED, false)               then result := LNG_STATUS_OK_UNSPECIFIED
   else if UD2_STATUS_Equal(grStatus, UD2_STATUS_OK_SINGLELINE, false)                then result := LNG_STATUS_OK_SINGLELINE
   else if UD2_STATUS_Equal(grStatus, UD2_STATUS_OK_MULTILINE, false)                 then result := LNG_STATUS_OK_MULTILINE
   else if UD2_STATUS_Equal(grStatus, UD2_STATUS_NOTAVAIL_UNSPECIFIED, false)         then result := LNG_STATUS_NOTAVAIL_UNSPECIFIED
   else if UD2_STATUS_Equal(grStatus, UD2_STATUS_NOTAVAIL_OS_NOT_SUPPORTED, false)    then result := LNG_STATUS_NOTAVAIL_OS_NOT_SUPPORTED
   else if UD2_STATUS_Equal(grStatus, UD2_STATUS_NOTAVAIL_HW_NOT_SUPPORTED, false)    then result := LNG_STATUS_NOTAVAIL_HW_NOT_SUPPORTED
   else if UD2_STATUS_Equal(grStatus, UD2_STATUS_NOTAVAIL_NO_ENTITIES, false)         then result := LNG_STATUS_NOTAVAIL_NO_ENTITIES
   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)])
-  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_FAILURE_UNSPECIFIED, false)          then result := LNG_STATUS_ERROR_UNSPECIFIED
+  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_FAILURE_UNSPECIFIED, false)          then result := LNG_STATUS_FAILURE_UNSPECIFIED
-  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_FAILURE_BUFFER_TOO_SMALL, false)     then result := LNG_STATUS_ERROR_BUFFER_TOO_SMALL
+  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_FAILURE_BUFFER_TOO_SMALL, false)     then result := LNG_STATUS_FAILURE_BUFFER_TOO_SMALL
-  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_FAILURE_INVALID_ARGS, false)         then result := LNG_STATUS_ERROR_INVALID_ARGS
+  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_FAILURE_INVALID_ARGS, false)         then result := LNG_STATUS_FAILURE_INVALID_ARGS
-  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_FAILURE_PLUGIN_NOT_LICENSED, false)  then result := LNG_STATUS_ERROR_PLUGIN_NOT_LICENSED
+  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_FAILURE_PLUGIN_NOT_LICENSED, false)  then result := LNG_STATUS_FAILURE_PLUGIN_NOT_LICENSED
+  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_FAILURE_NO_RETURNED_VALUE, false)    then result := LNG_STATUS_FAILURE_NO_RETURNED_VALUE
+  else if UD2_STATUS_Equal(grStatus, UD2_STATUS_FAILURE_CATCHED_EXCEPTION, false)    then result := LNG_STATUS_FAILURE_CATCHED_EXCEPTION
   else if grStatus.wCategory = UD2_STATUSCAT_SUCCESS   then result := Format(LNG_UNKNOWN_SUCCESS,  [UD2_STATUS_FormatStatusCode(grStatus)])
   else if grStatus.wCategory = UD2_STATUSCAT_NOT_AVAIL then result := Format(LNG_UNKNOWN_NOTAVAIL, [UD2_STATUS_FormatStatusCode(grStatus)])
   else if grStatus.wCategory = UD2_STATUSCAT_FAILED    then result := Format(LNG_UNKNOWN_FAILED,   [UD2_STATUS_FormatStatusCode(grStatus)])
   else                                                      result := Format(LNG_UNKNOWN_STATUS,   [UD2_STATUS_FormatStatusCode(grStatus)]);
 end;
 { TUD2Plugin }
 function TUD2Plugin.PluginGUIDString: string;
 begin
   result := UpperCase(GUIDToString(PluginGUID));
 end;
 procedure TUD2Plugin.AddIdentification(IdStr: WideString);
 begin
   DetectedIdentifications.Add(TUD2IdentificationEntry.Create(IdStr, Self))
 end;
 destructor TUD2Plugin.Destroy;
 begin
   DetectedIdentifications.Free;
   inherited;
 end;
 constructor TUD2Plugin.Create;
 begin
   inherited Create;
   FDetectedIdentifications := TObjectList{<TUD2IdentificationEntry>}.Create(true);
 end;
 { TUD2IdentificationEntry }
 function TUD2IdentificationEntry.GetPrimaryIdName: WideString;
 begin
   result := Plugin.IdentificationMethodName+':'+IdentificationString;
 end;
 procedure TUD2IdentificationEntry.GetIdNames(sl: TStrings);
 begin
   sl.Add(GetPrimaryIdName);
-  sl.Add(UpperCase(Plugin.IdentificationMethodName)+':'+IdentificationString);
-  sl.Add(LowerCase(Plugin.IdentificationMethodName)+':'+IdentificationString);
+  sl.Add(Plugin.IdentificationMethodName+':'+IdentificationString);
-  sl.Add(UpperCase(Plugin.PluginGUIDString)+':'+IdentificationString);
-  sl.Add(LowerCase(Plugin.PluginGUIDString)+':'+IdentificationString);
+  sl.Add(Plugin.PluginGUIDString+':'+IdentificationString);
 end;
 constructor TUD2IdentificationEntry.Create(AIdentificationString: WideString;
   APlugin: TUD2Plugin);
 begin
   inherited Create;
   FIdentificationString := AIdentificationString;
   FPlugin := APlugin;
 end;
 { TUD2 }
 procedure TUD2.HandlePluginDir(APluginDir, AFileMask: string);
 Var
   SR: TSearchRec;
   path: string;
   pluginLoader: TUD2PluginLoader;
   tob: TObjectList;
   i: integer;
   {$IFDEF CHECK_FOR_SAME_PLUGIN_GUID}
   sPluginID, prevDLL: string;
   {$ENDIF}
   lngid: LANGID;
 resourcestring
   LNG_PLUGINS_SAME_GUID = 'Attention: The plugin "%s" and the plugin "%s" have the same identification GUID. The latter will not be loaded.';
 begin
   tob := TObjectList.Create;
   try
     tob.OwnsObjects := false;
     lngID := GetSystemDefaultLangID;
     path := APluginDir;
     if path <> '' then path := IncludeTrailingPathDelimiter(path);
     if FindFirst(path + AFileMask, 0, SR) = 0 then
     begin
       try
         repeat
           try
             tob.Add(TUD2PluginLoader.Create(false, path + sr.Name, lngid));
           except
             on E: Exception do
             begin
               MessageDlg(E.Message, mtError, [mbOK], 0);
             end;
           end;
         until FindNext(SR) <> 0;
       finally
         FindClose(SR);
       end;
     end;
     for i := 0 to tob.count-1 do
     begin
       pluginLoader := tob.items[i] as TUD2PluginLoader;
       pluginLoader.WaitFor;
       Errors.AddStrings(pluginLoader.Errors);
       {$IFDEF CHECK_FOR_SAME_PLUGIN_GUID}
       if Assigned(pluginLoader.pl) then
       begin
+        if not pluginLoader.pl.OSNotSupportedEnforced then
+        begin
-        sPluginID := GUIDToString(pluginLoader.pl.PluginGUID);
+          sPluginID := GUIDToString(pluginLoader.pl.PluginGUID);
-        prevDLL := FGUIDLookup.Values[sPluginID];
+          prevDLL := FGUIDLookup.Values[sPluginID];
-        if (prevDLL <> '') and (prevDLL <> pluginLoader.pl.PluginDLL) then
+          if (prevDLL <> '') and (prevDLL <> pluginLoader.pl.PluginDLL) then
-        begin
+          begin
-          Errors.Add(Format(LNG_PLUGINS_SAME_GUID, [prevDLL, pluginLoader.pl.PluginDLL]));
+            Errors.Add(Format(LNG_PLUGINS_SAME_GUID, [prevDLL, pluginLoader.pl.PluginDLL]));
-          pluginLoader.pl.Free;
+            pluginLoader.pl.Free;
-        end
+          end
-        else
+          else
-        begin
+          begin
-          FGUIDLookup.Values[sPluginID] := pluginLoader.pl.PluginDLL;
+            FGUIDLookup.Values[sPluginID] := pluginLoader.pl.PluginDLL;
-          LoadedPlugins.Add(pluginLoader.pl);
+            LoadedPlugins.Add(pluginLoader.pl);
-        end;
+          end;
-      end;
+        end;
+      end;
       {$ENDIF}
       pluginLoader.Free;
     end;
   finally
     tob.free;
   end;
 end;
 destructor TUD2.Destroy;
 begin
   FIniFile.Free;
   FLoadedPlugins.Free;
   {$IFDEF CHECK_FOR_SAME_PLUGIN_GUID}
   FGUIDLookup.Free;
   {$ENDIF}
   FErrors.Free;
 end;
 constructor TUD2.Create(AIniFileName: string);
 begin
   FIniFileName := AIniFileName;
   FLoadedPlugins := TObjectList{<TUD2Plugin>}.Create(true);
   FIniFile := TMemIniFile.Create(IniFileName);
   {$IFDEF CHECK_FOR_SAME_PLUGIN_GUID}
   FGUIDLookup := TStringList.Create;
   {$ENDIF}
   FErrors := TStringList.Create;
 end;
 function TUD2.GetTaskName(AShortTaskName: string): string;
 resourcestring
   LNG_NO_DESCRIPTION = '(%s)';
 begin
   result := FIniFile.ReadString(AShortTaskName, 'Description', Format(LNG_NO_DESCRIPTION, [AShortTaskName]));
 end;
 procedure TUD2.GetTaskListing(outSL: TStrings);
 var
   sl: TStringList;
   i: integer;
   desc: string;
 begin
   sl := TStringList.Create;
   try
     FIniFile.ReadSections(sl);
     for i := 0 to sl.Count-1 do
     begin
       desc := GetTaskName(sl.Strings[i]);
       outSL.Values[sl.Strings[i]] := desc;
     end;
   finally
     sl.Free;
   end;
 end;
 function TUD2.TaskExists(ShortTaskName: string): boolean;
 begin
   result := FIniFile.SectionExists(ShortTaskName);
 end;
 function TUD2.ReadMetatagString(ShortTaskName, MetatagName: string;
   DefaultVal: string): string;
 begin
   result := IniFile.ReadString(ShortTaskName, MetatagName, DefaultVal);
 end;
 function TUD2.ReadMetatagBool(ShortTaskName, MetatagName: string;
   DefaultVal: string): boolean;
 begin
   // DefaultVal is a string, because we want to allow an empty string, in case the
   // user wishes an Exception in case the string is not a valid boolean string
   result := BetterInterpreteBool(IniFile.ReadString(ShortTaskName, MetatagName, DefaultVal));
 end;
 (*
 NAMING EXAMPLE: ComputerName:ABC&&User:John=calc.exe
         idTerm:       ComputerName:ABC&&User:John
         idName:       ComputerName:ABC
         IdMethodName: ComputerName
         IdStr         ABC
         cmd:          calc.exe
 *)
 procedure TUD2.GetAllIdNames(outSL: TStrings);
 var
   i, j: integer;
   pl: TUD2Plugin;
   ude: TUD2IdentificationEntry;
 begin
   for i := 0 to LoadedPlugins.Count-1 do
   begin
     pl := LoadedPlugins.Items[i] as TUD2Plugin;
     for j := 0 to pl.DetectedIdentifications.Count-1 do
     begin
       ude := pl.DetectedIdentifications.Items[j] as TUD2IdentificationEntry;
       ude.GetIdNames(outSL);
     end;
   end;
 end;
 function TUD2.FulfilsEverySubterm(idTerm: WideString; slIdNames: TStrings=nil): boolean;
+const
+  CASE_SENSITIVE_FLAG = '$CASESENSITIVE$';
 var
   x: TArrayOfString;
   i: integer;
   idName: WideString;
   cleanUpStringList: boolean;
+  caseSensitive: boolean;
 begin
   cleanUpStringList := slIdNames = nil;
   try
     if cleanUpStringList then
     begin
       slIdNames := TStringList.Create;
       GetAllIdNames(slIdNames);
     end;
     SetLength(x, 0);
     if Pos(':', idTerm) = 0 then
     begin
       result := false;
       Exit;
     end;
     x := SplitString('&&', idTerm);
     result := true;
     for i := Low(x) to High(x) do
     begin
       idName := x[i];
+      if Pos(CASE_SENSITIVE_FLAG, idName) >= 1 then
+      begin
+        idName := StringReplace(idName, CASE_SENSITIVE_FLAG, '', [rfReplaceAll]);
+        caseSensitive := true;
+      end
+      else
+      begin
+        caseSensitive := false;
+      end;
-      if slIdNames.IndexOf(idName) = -1 then
+      if (not caseSensitive and (slIdNames.IndexOf(idName) = -1)) or
+         (caseSensitive and (IndexOf_CS(slIdNames, idName) = -1)) then
       begin
         result := false;
         break;
       end;
     end;
   finally
     if cleanUpStringList and Assigned(slIdNames) then
       slIdNames.Free;
   end;
 end;
 procedure TUD2.GetCommandList(ShortTaskName: string; outSL: TStrings);
 var
   i: integer;
   cmd: string;
   idTerm: WideString;
   slSV, slIdNames: TStrings;
   nameVal: TArrayOfString;
 begin
   SetLength(nameVal, 0);
   slIdNames := TStringList.Create;
   try
     GetAllIdNames(slIdNames);
     slSV := TStringList.Create;
     try
       FIniFile.ReadSectionValues(ShortTaskName, slSV);
       for i := 0 to slSV.Count-1 do
       begin
         // We are doing the interpretation of the line ourselves, because
         // TStringList.Values[] would not allow multiple command lines with the
         // same key (idTerm)
         nameVal := SplitString('=', slSV.Strings[i]);
         idTerm := nameVal[0];
         cmd    := nameVal[1];
         if FulfilsEverySubterm(idTerm, slIdNames) then outSL.Add(cmd);
       end;
     finally
       slSV.Free;
     end;
   finally
     slIdNames.Free;
   end;
 end;
 { TUD2PluginLoader }
 procedure TUD2PluginLoader.Execute;
 begin
   inherited;
   HandleDLL;
 end;
 constructor TUD2PluginLoader.Create(Suspended: boolean; DLL: string; alngid: LANGID);
 begin
   inherited Create(Suspended);
   dllfile := dll;
   pl := nil;
   Errors := TStringList.Create;
   lngid := alngid;
 end;
 destructor TUD2PluginLoader.Destroy;
 begin
   Errors.Free;
   inherited;
 end;
 function TUD2PluginLoader.HandleDLL: boolean;
 var
   sIdentifier: WideString;
   sIdentifiers: TArrayOfString;
   buf: array[0..cchBufferSize-1] of WideChar;
-  sPluginConfigFile: string;
-  iniConfig: TINIFile;
-  sOverrideGUID: string;
-  pluginIDfound: boolean;
   pluginInterfaceID: TGUID;
   dllHandle: Cardinal;
   fPluginInterfaceID: TFuncPluginInterfaceID;
   fPluginIdentifier: TFuncPluginIdentifier;
   fPluginNameW: TFuncPluginNameW;
   fPluginVendorW: TFuncPluginVendorW;
   fPluginVersionW: TFuncPluginVersionW;
   fIdentificationMethodNameW: TFuncIdentificationMethodNameW;
   fIdentificationStringW: TFuncIdentificationStringW;
   fCheckLicense: TFuncCheckLicense;
   fDescribeOwnStatusCodeW: TFuncDescribeOwnStatusCodeW;
   statusCode: UD2_STATUS;
   i: integer;
   starttime, endtime, time: cardinal;
+  bakErrorMode: DWORD;
+  err: DWORD;
   function _ErrorLookup(statusCode: UD2_STATUS): WideString;
   var
     ret: BOOL;
   begin
+    if Assigned(fDescribeOwnStatusCodeW) then
+    begin
+      ZeroMemory(@buf, cchBufferSize);
-    ret := fDescribeOwnStatusCodeW(@buf, cchBufferSize, statusCode, lngID);
+      ret := fDescribeOwnStatusCodeW(@buf, cchBufferSize, statusCode, lngID);
-    if ret then
+      if ret then
-    begin
+      begin
-      result := PWideChar(@buf);
+        result := PWideChar(@buf);
-      Exit;
+        Exit;
-    end;
+      end;
+    end;
     result := TUD2.GenericErrorLookup(statusCode);
   end;
+  function _ApplyCompatibilityGUID: boolean;
+  var
+    iniConfig: TIniFile;
+    sOverrideGUID: string;
+    sPluginConfigFile: string;
+  begin
+    result := false;
+    sPluginConfigFile := ChangeFileExt(dllFile, '.ini');
+    if FileExists(sPluginConfigFile) then
+    begin
+      iniConfig := TIniFile.Create(sPluginConfigFile);
+      try
+        sOverrideGUID := iniConfig.ReadString('Compatibility', 'OverrideGUID', '');
+        if sOverrideGUID <> '' then
+        begin
+          pl.PluginGUID := StringToGUID(sOverrideGUID);
+          result := true;
+        end;
+      finally
+        iniConfig.Free;
+      end;
+    end;
+  end;
+  function _AutoOSNotSupportedMode: integer;
+  var
+    iniConfig: TIniFile;
+    sPluginConfigFile: string;
+  begin
+    result := 0;
+    sPluginConfigFile := ChangeFileExt(dllFile, '.ini');
+    if FileExists(sPluginConfigFile) then
+    begin
+      iniConfig := TIniFile.Create(sPluginConfigFile);
+      try
+        result := iniConfig.ReadInteger('Compatibility', 'AutoOSNotSupported', 0);
+      finally
+        iniConfig.Free;
+      end;
+    end;
+  end;
+  procedure _OverwriteStatusToOSNotSupported;
+  begin
+    pl := TUD2Plugin.Create;
+    pl.PluginDLL := dllFile;
+    statusCode := UD2_STATUS_NOTAVAIL_OS_NOT_SUPPORTED;
+    pl.IdentificationProcedureStatusCode := statusCode;
+    pl.IdentificationProcedureStatusCodeDescribed := _ErrorLookup(statusCode);
+    (*
+    if not _ApplyCompatibilityGUID then
+    begin
+      CreateGUID(pl.PluginGUID); // to avoid the "double GUID" error
+    end;
+    *)
+    pl.OSNotSupportedEnforced := true; // to avoid the "double GUID" error
+    result := true;
+  end;
 resourcestring
-  LNG_DLL_NOT_LOADED = 'Plugin DLL "%s" could not be loaded.';
+  LNG_DLL_NOT_LOADED = 'Plugin DLL "%s" could not be loaded: %s';
   LNG_METHOD_NOT_FOUND = 'Method "%s" not found in plugin "%s". The DLL is probably not a valid plugin DLL.';
   LNG_INVALID_PLUGIN = 'The plugin "%s" is not a valid plugin for this application.';
   LNG_METHOD_FAILURE = 'Error "%s" at method "%s" of plugin "%s".';
+  LNG_EXCEPTION = 'Fatal error while loading "%s" (%s: %s)';
 begin
   result := false;
   startTime := GetTickCount;
+  try
+    bakErrorMode := 0;
+    UD2_SetThreadErrorMode(SEM_FAILCRITICALERRORS, Pointer(bakErrorMode));
+    try
-  dllHandle := LoadLibrary(PChar(dllFile));
+      dllHandle := LoadLibrary(PChar(dllFile));
-  if dllHandle = 0 then
+      if dllHandle = 0 then
-  begin
+      begin
+        err := GetLastError;
+        if ((_AutoOSNotSupportedMode = 1) and ((err = ERROR_DLL_NOT_FOUND) or (err = ERROR_PROC_NOT_FOUND))) or
+           (_AutoOSNotSupportedMode >= 2) then
+        begin
+          _OverwriteStatusToOSNotSupported;
+          Exit;
+        end;
-    Errors.Add(Format(LNG_DLL_NOT_LOADED, [dllFile]));
+        Errors.Add(Format(LNG_DLL_NOT_LOADED, [dllFile, SysErrorMessage(err)]));
+        Exit;
-  end;
+      end;
-  try
+      try
-    @fPluginInterfaceID := GetProcAddress(dllHandle, mnPluginInterfaceID);
+        @fPluginInterfaceID := GetProcAddress(dllHandle, mnPluginInterfaceID);
-    if not Assigned(fPluginInterfaceID) then
+        if not Assigned(fPluginInterfaceID) then
-    begin
+        begin
-      Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnPluginInterfaceID, dllFile]));
+          Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnPluginInterfaceID, dllFile]));
-      Exit;
+          Exit;
-    end;
+        end;
-    pluginInterfaceID := fPluginInterfaceID();
+        pluginInterfaceID := fPluginInterfaceID();
-    if not IsEqualGUID(pluginInterfaceID, GUID_USERDETECT2_IDPLUGIN_V1) then
+        if not IsEqualGUID(pluginInterfaceID, GUID_USERDETECT2_IDPLUGIN_V1) then
-    begin
+        begin
-      Errors.Add(Format(LNG_INVALID_PLUGIN, [dllFile]));
+          Errors.Add(Format(LNG_INVALID_PLUGIN, [dllFile]));
-      Exit;
+          Exit;
-    end;
+        end;
-    @fIdentificationStringW := GetProcAddress(dllHandle, mnIdentificationStringW);
+        @fIdentificationStringW := GetProcAddress(dllHandle, mnIdentificationStringW);
-    if not Assigned(fIdentificationStringW) then
+        if not Assigned(fIdentificationStringW) then
-    begin
+        begin
-      Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnIdentificationStringW, dllFile]));
+          Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnIdentificationStringW, dllFile]));
-      Exit;
+          Exit;
-    end;
+        end;
-    @fPluginNameW := GetProcAddress(dllHandle, mnPluginNameW);
+        @fPluginNameW := GetProcAddress(dllHandle, mnPluginNameW);
-    if not Assigned(fPluginNameW) then
+        if not Assigned(fPluginNameW) then
-    begin
+        begin
-      Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnPluginNameW, dllFile]));
+          Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnPluginNameW, dllFile]));
-      Exit;
+          Exit;
-    end;
+        end;
-    @fPluginVendorW := GetProcAddress(dllHandle, mnPluginVendorW);
+        @fPluginVendorW := GetProcAddress(dllHandle, mnPluginVendorW);
-    if not Assigned(fPluginVendorW) then
+        if not Assigned(fPluginVendorW) then
-    begin
+        begin
-      Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnPluginVendorW, dllFile]));
+          Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnPluginVendorW, dllFile]));
-      Exit;
+          Exit;
-    end;
+        end;
-    @fPluginVersionW := GetProcAddress(dllHandle, mnPluginVersionW);
+        @fPluginVersionW := GetProcAddress(dllHandle, mnPluginVersionW);
-    if not Assigned(fPluginVersionW) then
+        if not Assigned(fPluginVersionW) then
-    begin
+        begin
-      Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnPluginVersionW, dllFile]));
+          Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnPluginVersionW, dllFile]));
-      Exit;
+          Exit;
-    end;
+        end;
-    @fCheckLicense := GetProcAddress(dllHandle, mnCheckLicense);
+        @fCheckLicense := GetProcAddress(dllHandle, mnCheckLicense);
-    if not Assigned(fCheckLicense) then
+        if not Assigned(fCheckLicense) then
-    begin
+        begin
-      Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnCheckLicense, dllFile]));
+          Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnCheckLicense, dllFile]));
-      Exit;
+          Exit;
-    end;
+        end;
-    @fIdentificationMethodNameW := GetProcAddress(dllHandle, mnIdentificationMethodNameW);
+        @fIdentificationMethodNameW := GetProcAddress(dllHandle, mnIdentificationMethodNameW);
-    if not Assigned(fIdentificationMethodNameW) then
+        if not Assigned(fIdentificationMethodNameW) then
-    begin
+        begin
-      Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnIdentificationMethodNameW, dllFile]));
+          Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnIdentificationMethodNameW, dllFile]));
-      Exit;
+          Exit;
-    end;
+        end;
-    @fDescribeOwnStatusCodeW := GetProcAddress(dllHandle, mnDescribeOwnStatusCodeW);
+        @fDescribeOwnStatusCodeW := GetProcAddress(dllHandle, mnDescribeOwnStatusCodeW);
-    if not Assigned(fDescribeOwnStatusCodeW) then
+        if not Assigned(fDescribeOwnStatusCodeW) then
-    begin
+        begin
-      Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnDescribeOwnStatusCodeW, dllFile]));
+          Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnDescribeOwnStatusCodeW, dllFile]));
-      Exit;
+          Exit;
-    end;
+        end;
-    pl := TUD2Plugin.Create;
+        pl := TUD2Plugin.Create;
-    pl.PluginDLL := dllFile;
+        pl.PluginDLL := dllFile;
-    pluginIDfound := false;
-    sPluginConfigFile := ChangeFileExt(dllFile, '.ini');
-    if FileExists(sPluginConfigFile) then
-    begin
-      iniConfig := TIniFile.Create(sPluginConfigFile);
-      try
-        sOverrideGUID := iniConfig.ReadString('Compatibility', 'OverrideGUID', '');
-        if sOverrideGUID <> '' then
-        begin
-          pl.PluginGUID := StringToGUID(sOverrideGUID);
-          pluginIDfound := true;
-        end;
-      finally
-        iniConfig.Free;
-      end;
-    end;
-    if not pluginIDfound then
+        if not _ApplyCompatibilityGUID then
-    begin
+        begin
-      @fPluginIdentifier := GetProcAddress(dllHandle, mnPluginIdentifier);
+          @fPluginIdentifier := GetProcAddress(dllHandle, mnPluginIdentifier);
-      if not Assigned(fPluginIdentifier) then
+          if not Assigned(fPluginIdentifier) then
-      begin
+          begin
-        Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnPluginIdentifier, dllFile]));
+            Errors.Add(Format(LNG_METHOD_NOT_FOUND, [mnPluginIdentifier, dllFile]));
-        Exit;
+            Exit;
-      end;
+          end;
-      pl.PluginGUID := fPluginIdentifier();
+          pl.PluginGUID := fPluginIdentifier();
-    end;
+        end;
-    statusCode := fCheckLicense(nil);
+        statusCode := fCheckLicense(nil);
-    if statusCode.wCategory = UD2_STATUSCAT_FAILED then
+        if statusCode.wCategory = UD2_STATUSCAT_FAILED then
-    begin
+        begin
-      Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnCheckLicense, dllFile]));
+          Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnCheckLicense, dllFile]));
-      Exit;
+          Exit;
-    end;
+        end;
+        ZeroMemory(@buf, cchBufferSize);
-    statusCode := fPluginNameW(@buf, cchBufferSize, lngID);
+        statusCode := fPluginNameW(@buf, cchBufferSize, lngID);
-         if statusCode.wCategory = UD2_STATUSCAT_SUCCESS   then pl.PluginName := PWideChar(@buf)
+             if statusCode.wCategory = UD2_STATUSCAT_SUCCESS   then pl.PluginName := PWideChar(@buf)
-    else if statusCode.wCategory = UD2_STATUSCAT_NOT_AVAIL then pl.PluginName := ''
+        else if statusCode.wCategory = UD2_STATUSCAT_NOT_AVAIL then pl.PluginName := ''
-    else
+        else
-    begin
+        begin
-      Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnPluginNameW, dllFile]));
+          Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnPluginNameW, dllFile]));
-      Exit;
+          Exit;
-    end;
+        end;
+        ZeroMemory(@buf, cchBufferSize);
-    statusCode := fPluginVendorW(@buf, cchBufferSize, lngID);
+        statusCode := fPluginVendorW(@buf, cchBufferSize, lngID);
-         if statusCode.wCategory = UD2_STATUSCAT_SUCCESS   then pl.PluginVendor := PWideChar(@buf)
+             if statusCode.wCategory = UD2_STATUSCAT_SUCCESS   then pl.PluginVendor := PWideChar(@buf)
-    else if statusCode.wCategory = UD2_STATUSCAT_NOT_AVAIL then pl.PluginVendor := ''
+        else if statusCode.wCategory = UD2_STATUSCAT_NOT_AVAIL then pl.PluginVendor := ''
-    else
+        else
-    begin
+        begin
-      Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnPluginVendorW, dllFile]));
+          Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnPluginVendorW, dllFile]));
-      Exit;
+          Exit;
-    end;
+        end;
+        ZeroMemory(@buf, cchBufferSize);
-    statusCode := fPluginVersionW(@buf, cchBufferSize, lngID);
+        statusCode := fPluginVersionW(@buf, cchBufferSize, lngID);
-         if statusCode.wCategory = UD2_STATUSCAT_SUCCESS   then pl.PluginVersion := PWideChar(@buf)
+             if statusCode.wCategory = UD2_STATUSCAT_SUCCESS   then pl.PluginVersion := PWideChar(@buf)
-    else if statusCode.wCategory = UD2_STATUSCAT_NOT_AVAIL then pl.PluginVersion := ''
+        else if statusCode.wCategory = UD2_STATUSCAT_NOT_AVAIL then pl.PluginVersion := ''
-    else
+        else
-    begin
+        begin
-      Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnPluginVersionW, dllFile]));
+          Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnPluginVersionW, dllFile]));
-      Exit;
+          Exit;
-    end;
+        end;
+        ZeroMemory(@buf, cchBufferSize);
-    statusCode := fIdentificationMethodNameW(@buf, cchBufferSize);
+        statusCode := fIdentificationMethodNameW(@buf, cchBufferSize);
-         if statusCode.wCategory = UD2_STATUSCAT_SUCCESS   then pl.IdentificationMethodName := PWideChar(@buf)
+             if statusCode.wCategory = UD2_STATUSCAT_SUCCESS   then pl.IdentificationMethodName := PWideChar(@buf)
-    else if statusCode.wCategory = UD2_STATUSCAT_NOT_AVAIL then pl.IdentificationMethodName := ''
+        else if statusCode.wCategory = UD2_STATUSCAT_NOT_AVAIL then pl.IdentificationMethodName := ''
-    else
+        else
-    begin
+        begin
-      Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnIdentificationMethodNameW, dllFile]));
+          Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnIdentificationMethodNameW, dllFile]));
-      Exit;
+          Exit;
-    end;
+        end;
+        ZeroMemory(@buf, cchBufferSize);
+        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)
-    statusCode := fIdentificationStringW(@buf, cchBufferSize);
+        statusCode := fIdentificationStringW(@buf, cchBufferSize);
-    pl.IdentificationProcedureStatusCode := statusCode;
+        pl.IdentificationProcedureStatusCode := statusCode;
-    pl.IdentificationProcedureStatusCodeDescribed := _ErrorLookup(statusCode);
+        pl.IdentificationProcedureStatusCodeDescribed := _ErrorLookup(statusCode);
-    if statusCode.wCategory = UD2_STATUSCAT_SUCCESS then
+        if statusCode.wCategory = UD2_STATUSCAT_SUCCESS then
-    begin
+        begin
-      sIdentifier := PWideChar(@buf);
+          sIdentifier := PWideChar(@buf);
-      if UD2_STATUS_Equal(statusCode, UD2_STATUS_OK_MULTILINE, false) then
+          if UD2_STATUS_Equal(statusCode, UD2_STATUS_OK_MULTILINE, false) then
-      begin
+          begin
-        // Multiple identifiers (e.g. multiple MAC addresses are delimited via UD2_MULTIPLE_ITEMS_DELIMITER)
+            // Multiple identifiers (e.g. multiple MAC addresses are delimited via UD2_MULTIPLE_ITEMS_DELIMITER)
-        SetLength(sIdentifiers, 0);
+            SetLength(sIdentifiers, 0);
-        sIdentifiers := SplitString(UD2_MULTIPLE_ITEMS_DELIMITER, sIdentifier);
+            sIdentifiers := SplitString(UD2_MULTIPLE_ITEMS_DELIMITER, sIdentifier);
-        for i := Low(sIdentifiers) to High(sIdentifiers) do
+            for i := Low(sIdentifiers) to High(sIdentifiers) do
-        begin
+            begin
-          pl.AddIdentification(sIdentifiers[i]);
+              pl.AddIdentification(sIdentifiers[i]);
-        end;
+            end;
-      end
+          end
-      else
+          else
-      begin
+          begin
-        pl.AddIdentification(sIdentifier);
+            pl.AddIdentification(sIdentifier);
-      end;
+          end;
-    end
+        end
-    else if statusCode.wCategory <> UD2_STATUSCAT_NOT_AVAIL then
+        else if statusCode.wCategory <> UD2_STATUSCAT_NOT_AVAIL then
-    begin
+        begin
+          if _AutoOSNotSupportedMode >= 3 then
+          begin
+            _OverwriteStatusToOSNotSupported;
+            Exit;
+          end;
-      // Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnIdentificationStringW, dllFile]));
+          // Errors.Add(Format(LNG_METHOD_FAILURE, [_ErrorLookup(statusCode), mnIdentificationStringW, dllFile]));
-      Errors.Add(Format(LNG_METHOD_FAILURE, [pl.IdentificationProcedureStatusCodeDescribed, mnIdentificationStringW, dllFile]));
+          Errors.Add(Format(LNG_METHOD_FAILURE, [pl.IdentificationProcedureStatusCodeDescribed, mnIdentificationStringW, dllFile]));
-      Exit;
+          Exit;
-    end;
+        end;
-    endtime := GetTickCount;
-    time := endtime - starttime;
-    if endtime < starttime then time := High(Cardinal) - time;
-    pl.time := time;
-    result := true;
+        result := true;
-  finally
+      finally
-    if not result and Assigned(pl) then FreeAndNil(pl);
+        if not result and Assigned(pl) then FreeAndNil(pl);
-    FreeLibrary(dllHandle);
+        FreeLibrary(dllHandle);
-  end;
+      end;
+    finally
+      UD2_SetThreadErrorMode(bakErrorMode, nil);
+      if result then
+      begin
+        endtime := GetTickCount;
+        time := endtime - starttime;
+        if endtime < starttime then time := High(Cardinal) - time;
+        pl.time := time;
+      end;
+    end;
+  except
+    // TODO: when an exception happens in a cdecl DLL, then this code is somehow not
+    // executed. Probably the memory is corrupted. Anyway, a cdecl DLL shall NEVER
+    // raise an Exception.
+    on E: Exception do
+    begin
+      Errors.Add(Format(LNG_EXCEPTION, [dllFile, E.ClassName, E.Message]));
+      Exit;
+    end;
+  end;
 end;
 end.

Subversion Repositories userdetect2

userdetect2/trunk/UserDetect2/UD2_Obj.pas – Rev 81 → 82