mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-13 09:39:09 +02:00
# revisions: 42902,45992,46450,46762
git-svn-id: branches/fixes_3_2@46813 -
This commit is contained in:
parent
9739a91133
commit
ccb4cb1a96
@ -13,7 +13,7 @@ begin
|
|||||||
{$endif ALLPACKAGES}
|
{$endif ALLPACKAGES}
|
||||||
|
|
||||||
P:=AddPackage('winunits-base');
|
P:=AddPackage('winunits-base');
|
||||||
P.ShortName:='win';
|
P.ShortName:='wib';
|
||||||
{$ifdef ALLPACKAGES}
|
{$ifdef ALLPACKAGES}
|
||||||
P.Directory:=ADirectory;
|
P.Directory:=ADirectory;
|
||||||
{$endif ALLPACKAGES}
|
{$endif ALLPACKAGES}
|
||||||
|
@ -325,6 +325,7 @@ unit ComObj;
|
|||||||
CoResumeClassObjects : TCoResumeClassObjectsProc = nil;
|
CoResumeClassObjects : TCoResumeClassObjectsProc = nil;
|
||||||
CoSuspendClassObjects : TCoSuspendClassObjectsProc = nil;
|
CoSuspendClassObjects : TCoSuspendClassObjectsProc = nil;
|
||||||
CoInitFlags : Longint = -1;
|
CoInitFlags : Longint = -1;
|
||||||
|
CoInitDisable : Boolean = False;
|
||||||
|
|
||||||
{$ifdef DEBUG_COM}
|
{$ifdef DEBUG_COM}
|
||||||
var printcom : boolean=true;
|
var printcom : boolean=true;
|
||||||
@ -1877,6 +1878,20 @@ const
|
|||||||
Initialized : boolean = false;
|
Initialized : boolean = false;
|
||||||
var
|
var
|
||||||
Ole32Dll : HModule;
|
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
|
initialization
|
||||||
Uninitializing:=false;
|
Uninitializing:=false;
|
||||||
@ -1893,12 +1908,10 @@ initialization
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
if not(IsLibrary) then
|
if not(IsLibrary) then
|
||||||
{$ifndef wince}
|
begin
|
||||||
if (CoInitFlags=-1) or not(assigned(comobj.CoInitializeEx)) then
|
SaveInitProc:=InitProc;
|
||||||
Initialized:=Succeeded(CoInitialize(nil))
|
InitProc:=@InitComObj;
|
||||||
else
|
end;
|
||||||
{$endif wince}
|
|
||||||
Initialized:=Succeeded(comobj.CoInitializeEx(nil, CoInitFlags));
|
|
||||||
|
|
||||||
SafeCallErrorProc:=@SafeCallErrorHandler;
|
SafeCallErrorProc:=@SafeCallErrorHandler;
|
||||||
VarDispProc:=@ComObjDispatchInvoke;
|
VarDispProc:=@ComObjDispatchInvoke;
|
||||||
|
@ -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.
|
||||||
|
@ -692,7 +692,7 @@ Const
|
|||||||
COMPCOLOR = _compcolor;
|
COMPCOLOR = _compcolor;
|
||||||
TCOMPCOLOR = _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
|
_editstream = record
|
||||||
dwCookie : DWORD_PTR;
|
dwCookie : DWORD_PTR;
|
||||||
|
Loading…
Reference in New Issue
Block a user