From a46d41bd77d585176dbf6dd0398fe8cc381d2328 Mon Sep 17 00:00:00 2001
From: paul <paul@3ad0048d-3df7-0310-abae-a5850022a9f2>
Date: Tue, 19 Jan 2010 09:28:54 +0000
Subject: comobj: fix DoDispCallByID. Now it works fine for
 DISPATCH_PROPERTYPUT, DISPATCH_PROPERTYGET.

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@14745 3ad0048d-3df7-0310-abae-a5850022a9f2
---
 packages/winunits-base/src/comobj.pp | 31 +++++++++++++++++++------------
 1 file changed, 19 insertions(+), 12 deletions(-)

(limited to 'packages/winunits-base')

diff --git a/packages/winunits-base/src/comobj.pp b/packages/winunits-base/src/comobj.pp
index ef79e47938..c89972a174 100644
--- a/packages/winunits-base/src/comobj.pp
+++ b/packages/winunits-base/src/comobj.pp
@@ -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; }
-- 
cgit v1.2.1