Browse Source

# revisions: 42902,45992,46450,46762

git-svn-id: branches/fixes_3_2@46813 -
marco 4 years ago
parent
commit
ccb4cb1a96

+ 1 - 1
packages/winunits-base/fpmake.pp

@@ -13,7 +13,7 @@ begin
 {$endif ALLPACKAGES}
 
     P:=AddPackage('winunits-base');
-    P.ShortName:='win';
+    P.ShortName:='wib';
 {$ifdef ALLPACKAGES}
     P.Directory:=ADirectory;
 {$endif ALLPACKAGES}

+ 19 - 6
packages/winunits-base/src/comobj.pp

@@ -325,6 +325,7 @@ unit ComObj;
       CoResumeClassObjects : TCoResumeClassObjectsProc = nil;
       CoSuspendClassObjects : TCoSuspendClassObjectsProc = nil;
       CoInitFlags : Longint = -1;
+      CoInitDisable : Boolean = False;
 
   {$ifdef DEBUG_COM}
      var printcom : boolean=true;
@@ -1877,6 +1878,20 @@ const
   Initialized : boolean = false;
 var
   Ole32Dll : HModule;
+  SaveInitProc : CodePointer;
+
+procedure InitComObj;
+begin
+  if SaveInitProc<>nil then
+    TProcedure(SaveInitProc)();
+  if not CoInitDisable then
+{$ifndef wince}
+    if (CoInitFlags=-1) or not(assigned(ComObj.CoInitializeEx)) then
+      Initialized:=Succeeded(CoInitialize(nil))
+    else
+{$endif wince}
+      Initialized:=Succeeded(ComObj.CoInitializeEx(nil, CoInitFlags));
+end;
 
 initialization
   Uninitializing:=false;
@@ -1893,12 +1908,10 @@ initialization
     end;
 
   if not(IsLibrary) then
-{$ifndef wince}
-    if (CoInitFlags=-1) or not(assigned(comobj.CoInitializeEx)) then
-      Initialized:=Succeeded(CoInitialize(nil))
-    else
-{$endif wince}
-      Initialized:=Succeeded(comobj.CoInitializeEx(nil, CoInitFlags));
+    begin
+      SaveInitProc:=InitProc;
+      InitProc:=@InitComObj;
+    end;
 
   SafeCallErrorProc:=@SafeCallErrorHandler;
   VarDispProc:=@ComObjDispatchInvoke;

+ 44 - 0
packages/winunits-base/src/httpapi.pp

@@ -1259,9 +1259,15 @@ function HttpReadFragmentFromCache(RequestQueueHandle: HANDLE; UrlPrefix: PCWSTR
 function HttpSetServiceConfiguration(ServiceHandle: HANDLE; ConfigId: HTTP_SERVICE_CONFIG_ID; pConfigInformation: PVOID; ConfigInformationLength: ULONG; pOverlapped: LPOVERLAPPED): ULONG; WinApi; external External_library name 'HttpSetServiceConfiguration';
 function HttpDeleteServiceConfiguration(ServiceHandle: HANDLE; ConfigId: HTTP_SERVICE_CONFIG_ID; pConfigInformation: PVOID; ConfigInformationLength: ULONG; pOverlapped: LPOVERLAPPED): ULONG; WinApi; external External_library name 'HttpDeleteServiceConfiguration';
 function HttpQueryServiceConfiguration(ServiceHandle: HANDLE; ConfigId: HTTP_SERVICE_CONFIG_ID; pInput: PVOID; InputLength: ULONG; pOutput: PVOID; OutputLength: ULONg; pReturnLength: PULONG; pOverlapped: LPOVERLAPPED): ULONG; WinApi; external External_library name 'HttpQueryServiceConfiguration';
+{ this is only available from Windows 10 version 1703 on, so handle that in the
+  implementation; ideally this would be marked with "delayed" }
+function HttpUpdateServiceConfiguration(ServiceHandle: HANDLE; ConfigId: HTTP_SERVICE_CONFIG_ID; ConfigInfo: PVOID; ConfigInfoLength: ULONG; Overlapped: LPOVERLAPPED): ULONG; WinApi;
 
 implementation
 
+  uses
+    SysUtils;
+
   function Present(var a : _HTTP_PROPERTY_FLAGS) : ULONG;
     begin
       Present:=(a.flag0 and bm__HTTP_PROPERTY_FLAGS_Present) shr bp__HTTP_PROPERTY_FLAGS_Present;
@@ -1338,5 +1344,43 @@ implementation
       HTTPAPI_VERSION_GREATER_OR_EQUAL := not (HTTPAPI_LESS_VERSION(version,major,minor));
     end;
 
+  type
+    TUpdateServiceConfigurationFunc = function(ServiceHandle: HANDLE; ConfigId: HTTP_SERVICE_CONFIG_ID; ConfigInfo: PVOID; ConfigInfoLength: ULONG; Overlapped: LPOVERLAPPED): ULONG; WinApi;
+
+  var
+    gLibCS: CRITICAL_SECTION;
+    gLibHandle: THandle = NilHandle;
+    gUpdateServiceConfigurationChecked: Boolean = False;
+    gUpdateServiceConfigurationFunc: TUpdateServiceConfigurationFunc = Nil;
+
+  function HttpUpdateServiceConfiguration(ServiceHandle: HANDLE; ConfigId: HTTP_SERVICE_CONFIG_ID; ConfigInfo: PVOID; ConfigInfoLength: ULONG; Overlapped: LPOVERLAPPED): ULONG; WinApi;
+    begin
+      if not gUpdateServiceConfigurationChecked then begin
+        EnterCriticalSection(gLibCS);
+        try
+          if not gUpdateServiceConfigurationChecked then begin
+            gLibHandle := LoadLibrary(External_library);
+            if gLibHandle <> NilHandle then
+              gUpdateServiceConfigurationFunc := TUpdateServiceConfigurationFunc(GetProcAddress(gLibHandle, 'HttpUpdateServiceConfiguration'))
+            else begin
+              FreeLibrary(gLibHandle);
+              gLibHandle := NilHandle;
+            end;
+            gUpdateServiceConfigurationChecked := True;
+          end;
+        finally
+          LeaveCriticalSection(gLibCS);
+        end;
+      end;
+      if not Assigned(gUpdateServiceConfigurationFunc) then
+        raise EOSError.Create(SysErrorMessage(ERROR_PROC_NOT_FOUND));
+      Result := gUpdateServiceConfigurationFunc(ServiceHandle, ConfigId, ConfigInfo, ConfigInfoLength, Overlapped);
+    end;
 
+initialization
+  InitializeCriticalSection(gLibCS);
+finalization
+  DoneCriticalSection(gLibCS);
+  if gLibHandle <> NilHandle then
+    FreeLibrary(gLibHandle);
 end.

+ 1 - 1
packages/winunits-base/src/richedit.pp

@@ -692,7 +692,7 @@ Const
      COMPCOLOR = _compcolor;
      TCOMPCOLOR = _compcolor;
 
-     EDITSTREAMCALLBACK = function (dwCookie:PDWORD; pbBuff:LPBYTE; cb:LONG; var pcb:LONG):DWORD;
+     EDITSTREAMCALLBACK = function (dwCookie:DWORD_PTR; pbBuff:LPBYTE; cb:LONG; var pcb:LONG):DWORD;
 
      _editstream = record
           dwCookie : DWORD_PTR;