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

 {$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
 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;
   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;
   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_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;
 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
       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]));
-        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;
 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
     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;
 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;
   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
-    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]));
-    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
-        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