فهرست منبع

Load oleaut32.dll for widestrings on demand.

Most of the applications don’t and shouldn’t use widestrings, as unicodestrings are superior.
Rika Ichinose 2 سال پیش
والد
کامیت
48815baef6
3فایلهای تغییر یافته به همراه48 افزوده شده و 6 حذف شده
  1. 38 6
      rtl/win/sysos.inc
  2. 5 0
      rtl/win32/system.pp
  3. 5 0
      rtl/win64/system.pp

+ 38 - 6
rtl/win/sysos.inc

@@ -359,12 +359,44 @@ var
    function GetOEMCP: UINT;
      stdcall; external KernelDLL name 'GetOEMCP';
 
-   function SysAllocStringLen(psz:pointer;len:dword):pointer;
-     stdcall; external 'oleaut32.dll' name 'SysAllocStringLen';
-   procedure SysFreeString(bstr:pointer);
-     stdcall; external 'oleaut32.dll' name 'SysFreeString';
-   function SysReAllocStringLen(var bstr:pointer;psz: pointer;
-     len:dword): Integer; stdcall;external 'oleaut32.dll' name 'SysReAllocStringLen';
+   function FirstSysAllocStringLen(psz:pointer;len:dword):pointer; stdcall; forward;
+   procedure FirstSysFreeString(bstr:pointer); stdcall; forward;
+   function FirstSysReAllocStringLen(var bstr:pointer;psz: pointer;len:dword): Integer; stdcall; forward;
+
+var
+   OleAut32Dll: THandle = 0; { Unloaded at win32 & win64 system_exit. }
+   SysAllocStringLen: function(psz:pointer;len:dword):pointer; stdcall; = @FirstSysAllocStringLen;
+   SysFreeString: procedure(bstr:pointer); stdcall; = @FirstSysFreeString;
+   SysReAllocStringLen: function(var bstr:pointer;psz: pointer;len:dword): Integer; stdcall; = @FirstSysReAllocStringLen;
+
+   function EnsureOleAut32Dll: THandle;
+   begin
+     if OleAut32Dll = 0 then
+       begin
+         Result := WinLoadLibraryW('oleaut32.dll');
+         if InterlockedCompareExchange(Pointer(OleAut32Dll), Pointer(Result), nil) <> nil then
+           WinFreeLibrary(Result);
+       end;
+     Result := OleAut32Dll;
+   end;
+
+   function FirstSysAllocStringLen(psz:pointer;len:dword):pointer; stdcall;
+   begin
+     CodePointer(SysAllocStringLen) := WinGetProcAddress(EnsureOleAut32Dll, 'SysAllocStringLen');
+     Result := SysAllocStringLen(psz,len);
+   end;
+
+   procedure FirstSysFreeString(bstr:pointer); stdcall;
+   begin
+     CodePointer(SysFreeString) := WinGetProcAddress(EnsureOleAut32Dll, 'SysFreeString');
+     SysFreeString(bstr);
+   end;
+
+   function FirstSysReAllocStringLen(var bstr:pointer;psz: pointer;len:dword): Integer; stdcall;
+   begin
+     CodePointer(SysReAllocStringLen) := WinGetProcAddress(EnsureOleAut32Dll, 'SysReAllocStringLen');
+     Result := SysReAllocStringLen(bstr,psz,len);
+   end;
 {$endif WINCE}
 
    Procedure Errno2InOutRes(oserror: longword);

+ 5 - 0
rtl/win32/system.pp

@@ -122,6 +122,11 @@ begin
       WinFreeLibrary(Ole32Dll); { Careful, FreeLibrary should not be called from DllMain. }
       Ole32Dll := 0;
     end;
+  if OleAut32Dll <> 0 then
+    begin
+      WinFreeLibrary(OleAut32Dll);
+      OleAut32Dll := 0;
+    end;
 {$ifndef FPC_USE_WIN32_SEH}
   if not IsLibrary then
     remove_exception_handlers;

+ 5 - 0
rtl/win64/system.pp

@@ -122,6 +122,11 @@ begin
       WinFreeLibrary(Ole32Dll); { Careful, FreeLibrary should not be called from DllMain. }
       Ole32Dll := 0;
     end;
+  if OleAut32Dll <> 0 then
+    begin
+      WinFreeLibrary(OleAut32Dll);
+      OleAut32Dll := 0;
+    end;
 
   { call exitprocess, with cleanup as required }
   ExitProcess(exitcode);