From 69a90199f213e66262908b0f6c7ea7520b4fa9eb Mon Sep 17 00:00:00 2001
From: TetzkatLipHoka <TLH@freenet.de>
Date: Sat, 11 Jul 2026 11:21:40 +0200
Subject: [PATCH] IDispatchInvoke: pass IDispatch arguments as VT_DISPATCH

Variant parameters holding an IDispatch reference were marshaled like
every other variant: wrapped as VT_VARIANT or VT_BYREF pointing at a
copy of the variant. Lenient automation servers (e.g. the Scripting.*
classes) accept that form, but strict marshalers - most prominently
.NET COM interop - reject it, and assigning an object to an IDispatch
property only works with a plain dispatch argument.

Such arguments are now passed as VT_DISPATCH with the interface pointer
itself (deliberately WITHOUT VT_BYREF, which is known to crash several
COM servers). The variant in Par keeps the reference alive for the
duration of the Invoke call, so no AddRef is needed.

Also replaces the repeated rgvarg[i] indexing with a PVariantArg local
(FPC needs rgvarg^[i]) and the cleanup check with a VT_BYREF mask test
so VT_DISPATCH entries are skipped correctly.

Originally found and fixed in the TetzkatLipHoka fork during .NET
interop testing.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
---
 Source/uPSRuntime.pas | 61 +++++++++++++++++++++++--------------------
 1 file changed, 33 insertions(+), 28 deletions(-)

diff --git a/Source/uPSRuntime.pas b/Source/uPSRuntime.pas
index d22c6182..a4acffc8 100644
--- a/Source/uPSRuntime.pas
+++ b/Source/uPSRuntime.pas
@@ -13820,12 +13820,14 @@ procedure TPSStack.SetWideString(ItemNo: Longint;
 function IDispatchInvoke(Self: IDispatch; PropertySet: Boolean; const Name: tbtString; const Par: array of Variant): Variant;
 var
   Param: Word;
-  i, ArgErr: Longint;
+  i, ArgErr, aSize: Longint;
   DispatchId: Longint;
   DispParam: TDispParams;
   ExceptInfo: TExcepInfo;
   aName: PWideChar;
   WSFreeList: TPSList;
+  ArgType: Word;
+  DispArg: PVariantArg;
 begin
   if Self = nil then begin
     raise EPSException.Create('Variant is null, cannot invoke', nil, 0, 0);
@@ -13858,44 +13860,46 @@ function IDispatchInvoke(Self: IDispatch; PropertySet: Boolean; const Name: tbtS
 
   WSFreeList := TPSList.Create;
   try
-    GetMem(DispParam.rgvarg, sizeof(TVariantArg) * (High(Par) + 1));
-    FillCHar(DispParam.rgvarg^, sizeof(TVariantArg) * (High(Par) + 1), 0);
+    aSize := SizeOf(TVariantArg) * (High(Par) + 1);
+    GetMem(DispParam.rgvarg, aSize);
+    FillChar(DispParam.rgvarg^, aSize, 0);
     try
       for i := 0 to High(Par)  do
       begin
-        if PVarData(@Par[High(Par)-i]).VType = varString then
+        ArgType := PVarData(@Par[High(Par)-i]).VType;
+        DispArg := @(DispParam.rgvarg{$IFDEF FPC}^{$ENDIF}[i]);
+        if ArgType = varString then
         begin
-          DispParam.rgvarg[i].vt := VT_BSTR;
-          DispParam.rgvarg[i].bstrVal := StringToOleStr(AnsiString(Par[High(Par)-i]));
-          WSFreeList.Add(DispParam.rgvarg[i].bstrVal);
+          DispArg.vt := VT_BSTR;
+          DispArg.bstrVal := StringToOleStr(AnsiString(Par[High(Par)-i]));
+          WSFreeList.Add(DispArg.bstrVal);
         {$IFDEF UNICODE}
-        end else if (PVarData(@Par[High(Par)-i]).VType = varOleStr) or (PVarData(@Par[High(Par)-i]).VType = varUString) then
+        end else if (ArgType = varOleStr) or (ArgType = varUString) then
         begin
-          DispParam.rgvarg[i].vt := VT_BSTR;
-          DispParam.rgvarg[i].bstrVal := StringToOleStr(UnicodeString(Par[High(Par)-i]));
-          WSFreeList.Add(DispParam.rgvarg[i].bstrVal);
+          DispArg.vt := VT_BSTR;
+          DispArg.bstrVal := StringToOleStr(UnicodeString(Par[High(Par)-i]));
+          WSFreeList.Add(DispArg.bstrVal);
         {$ENDIF}
+        end else if ArgType = varDispatch then
+        begin
+          // pass COM objects as plain VT_DISPATCH instead of a by-ref
+          // variant: strict marshalers (e.g. .NET COM interop) reject the
+          // wrapped form, and property assignments of IDispatch values only
+          // work this way. Deliberately without VT_BYREF, which is known to
+          // crash several COM servers.
+          DispArg.vt := VT_DISPATCH;
+          DispArg.dispVal := PVarData(@Par[High(Par)-i]).VDispatch;
         end else
         begin
-          DispParam.rgvarg[i].vt := VT_VARIANT or VT_BYREF;
+          DispArg.vt := VT_VARIANT or VT_BYREF;
           New(
           {$IFDEF DELPHI4UP}
           POleVariant
           {$ELSE}
           PVariant{$ENDIF}
-           (DispParam.rgvarg[i].pvarVal));
-
-          (*
-          {$IFDEF DELPHI4UP}
-            POleVariant
-          {$ELSE}
-            PVariant
-          {$ENDIF}
-           (DispParam.rgvarg[i].pvarVal)^ := Par[High(Par)-i];
-          *)
-          Move(Par[High(Par)-i],Pointer(DispParam.rgvarg[i].pvarVal)^,
+           (DispArg.pvarVal));
+          Move(Par[High(Par)-i],Pointer(DispArg.pvarVal)^,
            Sizeof({$IFDEF DELPHI4UP}OleVariant{$ELSE}Variant{$ENDIF}));
-
         end;
       end;
       i :=Self.Invoke(DispatchId, GUID_NULL, LOCALE_SYSTEM_DEFAULT, Param, DispParam, @Result, @ExceptInfo, @ArgErr);
@@ -13929,20 +13933,21 @@ function IDispatchInvoke(Self: IDispatch; PropertySet: Boolean; const Name: tbtS
     finally
       for i := 0 to High(Par)  do
       begin
-        if DispParam.rgvarg[i].vt = (VT_VARIANT or VT_BYREF) then
+        DispArg := @(DispParam.rgvarg{$IFDEF FPC}^{$ENDIF}[i]);
+        if (DispArg.vt and VT_BYREF) = VT_BYREF then
         begin
           if{$IFDEF DELPHI4UP}POleVariant{$ELSE}PVariant{$ENDIF}
-            (DispParam.rgvarg[i].pvarVal) <> nil then
+            (DispArg.pvarVal) <> nil then
             Dispose(
             {$IFDEF DELPHI4UP}
              POleVariant
             {$ELSE}
              PVariant
             {$ENDIF}
-             (DispParam.rgvarg[i].pvarVal));
+             (DispArg.pvarVal));
         end;
       end;
-      FreeMem(DispParam.rgvarg, sizeof(TVariantArg) * (High(Par) + 1));
+      FreeMem(DispParam.rgvarg, aSize);
     end;
   finally
     for i := WSFreeList.Count -1 downto 0 do