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

* extended patch from Roozbeh Gholizadeh, resolving #8376

Browse Source 
- adding some helpers to activex.pp
  - wince fixes for comobj

git-svn-id: trunk@6620 -
This commit is contained in:
florian 2007-02-23 19:10:10 +00:00
parent 25576b49ac
commit 7afe679a99
2 changed files with 55 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
packages/base/winunits/activex.pp
View File

@ -3316,6 +3316,49 @@ type
function RevokeActiveObject(dwRegister: culong; pvReserved: Pointer) : HResult; external oleaut32dll name 'RevokeActiveObject';
function GetActiveObject(const clsid: TCLSID; pvReserved: Pointer; out unk: IUnknown) : HResult; external oleaut32dll name 'GetActiveObject';
function Succeeded(Res: HResult) : Boolean;inline;
function Failed(Res: HResult) : Boolean;inline;
function ResultCode(Res: HResult) : Longint;inline;
function ResultFacility(Res: HResult): Longint;inline;
function ResultSeverity(Res: HResult): Longint;inline;
function MakeResult(Severity, Facility, Code: Longint): HResult;inline;
implementation
function Succeeded(Res: HResult) : Boolean;inline;
begin
Result := Res and $80000000 = 0;
end;
function Failed(Res: HResult) : Boolean;inline;
begin
Result := Res and $80000000 <> 0;
end;
function ResultCode(Res: HResult) : Longint;inline;
begin
Result := Res and $0000FFFF;
end;
function ResultFacility(Res: HResult): Longint;inline;
begin
Result := (Res shr 16) and $00001FFF;
end;
function ResultSeverity(Res: HResult): Longint;inline;
begin
Result := Res shr 31;
end;
function MakeResult(Severity, Facility, Code: Longint): HResult;inline;
begin
Result := (Severity shl 31) or (Facility shl 16) or Code;
end;
end.

14
packages/base/winunits/comobj.pp
View File

@ -192,11 +192,14 @@ implementation
flags:=CLSCTX_LOCAL_SERVER or CLSCTX_REMOTE_SERVER or CLSCTX_INPROC_SERVER;
{ actually a remote call? }
size:=sizeof(localhost);
{$ifndef wince}
//roozbeh although there is a way to retrive computer name...HKLM\Ident\Name..but are they same?
size:=sizeof(localhost);
if (MachineName<>'') and
(not(GetComputerNameW(localhost,size)) or
(WideCompareText(localhost,MachineName)<>0)) then
flags:=CLSCTX_REMOTE_SERVER;
{$endif}
OleCheck(CoCreateInstanceEx(ClassID,nil,flags,@server,1,@mqi));
OleCheck(mqi.hr);
@ -468,7 +471,13 @@ implementation
inc(Names,NameLen+1);
inc(NameCount);
end;
res:=DispatchInterface.GetIDsOfNames(GUID_NULL,NamesArray,NameCount,GetThreadLocale,IDs);
res:=DispatchInterface.GetIDsOfNames(GUID_NULL,NamesArray,NameCount,
{$ifdef wince}
LOCALE_SYSTEM_DEFAULT
{$else wince}
GetThreadLocale
{$endif wince}
,IDs);
{$ifdef DEBUG_COMDISPATCH}
writeln('SearchIDs: GetIDsOfNames result = ',hexstr(res,SizeOf(HRESULT)*2));
for i:=0 to Count-1 do
@ -636,3 +645,4 @@ finalization
CoUninitialize;
end.