paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-17 12:39:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

comobj: fix DoDispCallByID. Now it works fine for DISPATCH_PROPERTYPUT, DISPATCH_PROPERTYGET.

Browse Source 
git-svn-id: trunk@14745 -
This commit is contained in:
paul 2010-01-19 09:28:54 +00:00
parent 58f43def5c
commit 7e0578c569
1 changed files with 19 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1335,9 +1335,8 @@ HKCR
invokeresult : HRESULT;
preallocateddata : array[0..15] of TVarData;
Arguments : ^TVarData;
NamedArguments : PPointer;
CurrType : byte;
namedcount,i : byte;
CurrType, i : byte;
dispidNamed: dispid;
begin
{ use preallocated space, i.e. can we avoid a getmem call? }
if desc^.calldesc.argcount<=Length(preallocateddata) then
@ -1402,16 +1401,24 @@ HKCR
end;
dispparams.cArgs:=desc^.calldesc.argcount;
dispparams.rgvarg:=pointer(Arguments);
dispparams.cNamedArgs:=desc^.calldesc.namedargcount;
dispparams.rgdispidNamedArgs:=@desc^.CallDesc.ArgTypes[desc^.CallDesc.ArgCount];
flags:=desc^.calldesc.calltype;
case flags of
DISPATCH_PROPERTYPUT:
begin
inc(dispparams.cNamedArgs);
if (Arguments[0].VType and varTypeMask) = varDispatch then
flags:=DISPATCH_PROPERTYPUTREF;
dispidNamed:=DISPID_PROPERTYPUT;
DispParams.rgdispidNamedArgs:=@dispidNamed;
end;
DISPATCH_METHOD:
if assigned(res) and (desc^.calldesc.argcount=0) then
flags:=DISPATCH_METHOD or DISPATCH_PROPERTYGET;
end;
{ handle properties properly here ! }
namedcount:=desc^.calldesc.namedargcount;
if desc^.calldesc.calltype=DISPATCH_PROPERTYPUT then
inc(namedcount)
else
NamedArguments:=@desc^.CallDesc.ArgTypes[desc^.CallDesc.ArgCount];
dispparams.cNamedArgs:=namedcount;
dispparams.rgdispidNamedArgs:=pointer(NamedArguments);
flags:=0;
invokeresult:=disp.Invoke(
desc^.DispId, { DispID: LongInt; }
GUID_NULL, { const iid : TGUID; }