paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 10:19:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

# revisions: 42902,45992,46450,46762

Browse Source 
git-svn-id: branches/fixes_3_2@46813 -
This commit is contained in:
marco 2020-09-09 15:45:43 +00:00
parent 9739a91133
commit ccb4cb1a96
4 changed files with 65 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
packages/winunits-base/fpmake.pp
View File

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

25
packages/winunits-base/src/comobj.pp
View File

@ -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
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 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.

2
packages/winunits-base/src/richedit.pp
View File

@ -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;