paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 22:09:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fix for Mantis #37447: add support for HttpUpdateServiceConfiguration which needs to be loaded dynamically, because it's only available in newer versions of Windows 10

Browse Source 
git-svn-id: trunk@45992 -
This commit is contained in:
svenbarth 2020-08-02 15:18:36 +00:00
parent e5308038a9
commit a8ea8eb5d5
1 changed files with 44 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
packages/winunits-base/src/httpapi.pp
View File

@ -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 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 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'; 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 implementation
uses
SysUtils;
function Present(var a : _HTTP_PROPERTY_FLAGS) : ULONG; function Present(var a : _HTTP_PROPERTY_FLAGS) : ULONG;
begin begin
Present:=(a.flag0 and bm__HTTP_PROPERTY_FLAGS_Present) shr bp__HTTP_PROPERTY_FLAGS_Present; 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)); HTTPAPI_VERSION_GREATER_OR_EQUAL := not (HTTPAPI_LESS_VERSION(version,major,minor));
end; 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. end.