Merged revision(s) 47516, 47518-47519 from trunk:

* correctly mask the argument type of a dispatch parameter (only the top most bit needs to be removed, not the top most *two* bits)
........
+ add support for dispatching UnicodeString parameters (in addition to AnsiString parameters)
........
+ add test to check whether ComObj correctly dispatches Ansi-, Unicode- and WideString arguments
........

git-svn-id: branches/fixes_3_2@47591 -

.gitattributes

@@ -13847,6 +13847,7 @@ tests/test/packages/webtbs/tw14265.pp svneol=native#text/plain
 tests/test/packages/webtbs/tw1808.pp svneol=native#text/plain
 tests/test/packages/webtbs/tw3820.pp svneol=native#text/plain
 tests/test/packages/win-base/tdispvar1.pp svneol=native#text/plain
+tests/test/packages/win-base/tdispvar2.pp svneol=native#text/pascal
 tests/test/packages/zlib/tzlib1.pp svneol=native#text/plain
 tests/test/t4cc1.pp svneol=native#text/plain
 tests/test/t4cc2.pp svneol=native#text/plain

packages/winunits-base/src/comobj.pp

@@ -1184,7 +1184,7 @@ HKCR
         { we can't pass pascal ansistrings to COM routines so we've to convert them
           to/from widestring. This array contains the mapping to do so
         }
-        StringMap : array[0..255] of record passtr : pansistring; comstr : pwidechar; end;
+        StringMap : array[0..255] of record passtr : pansistring; paswstr : punicodestring; comstr : pwidechar; end;
         invokekind,
         i : longint;
         invokeresult : HResult;
@@ -1210,7 +1210,7 @@ HKCR
               writeln('DispatchInvoke: Params = ',hexstr(Params));
 {$endif DEBUG_COMDISPATCH}
               { get plain type }
-              CurrType:=CallDesc^.ArgTypes[i] and $3f;
+              CurrType:=CallDesc^.ArgTypes[i] and $7f;
               { a skipped parameter? Don't increment Params pointer if so. }
               if CurrType=varError then
                 begin
@@ -1230,6 +1230,21 @@ HKCR
 {$endif DEBUG_COMDISPATCH}
                         StringMap[NextString].ComStr:=StringToOleStr(PString(Params^)^);
                         StringMap[NextString].PasStr:=PString(Params^);
+                        StringMap[NextString].PasWStr:=Nil;
+                        Arguments[i].VType:=varOleStr or varByRef;
+                        Arguments[i].VPointer:=@StringMap[NextString].ComStr;
+                        inc(NextString);
+                        inc(PPointer(Params));
+                      end;
+                    varUStrArg:
+                      begin
+{$ifdef DEBUG_COMDISPATCH}
+                        if printcom then
+                        writeln('Translating var unicodestring argument ',PUnicodeString(Params^)^);
+{$endif DEBUG_COMDISPATCH}
+                        StringMap[NextString].ComStr:=StringToOleStr(PUnicodeString(Params^)^);
+                        StringMap[NextString].PasStr:=Nil;
+                        StringMap[NextString].PasWStr:=PUnicodeString(Params^);
                         Arguments[i].VType:=varOleStr or varByRef;
                         Arguments[i].VPointer:=@StringMap[NextString].ComStr;
                         inc(NextString);
@@ -1282,6 +1297,22 @@ HKCR
 {$endif DEBUG_COMDISPATCH}
                       StringMap[NextString].ComStr:=StringToOleStr(PString(Params)^);
                       StringMap[NextString].PasStr:=nil;
+                      StringMap[NextString].PasWStr:=nil;
+                      Arguments[i].VType:=varOleStr;
+                      Arguments[i].VPointer:=StringMap[NextString].ComStr;
+                      inc(NextString);
+                      inc(PPointer(Params));
+                    end;
+
+                  varUStrArg:
+                    begin
+{$ifdef DEBUG_COMDISPATCH}
+                    if printcom then
+                      writeln('Translating unicodestring argument ',PUnicodeString(Params)^);
+{$endif DEBUG_COMDISPATCH}
+                      StringMap[NextString].ComStr:=StringToOleStr(PUnicodeString(Params)^);
+                      StringMap[NextString].PasStr:=nil;
+                      StringMap[NextString].PasWStr:=nil;
                       Arguments[i].VType:=varOleStr;
                       Arguments[i].VPointer:=StringMap[NextString].ComStr;
                       inc(NextString);
@@ -1373,9 +1404,12 @@ HKCR
             DispatchInvokeError(invokeresult,exceptioninfo);
 
           { translate strings back }
-          for i:=0 to NextString-1 do
+          for i:=0 to NextString-1 do begin
             if assigned(StringMap[i].passtr) then
-              OleStrToStrVar(StringMap[i].comstr,StringMap[i].passtr^);
+              OleStrToStrVar(StringMap[i].comstr,StringMap[i].passtr^)
+            else if assigned(StringMap[i].paswstr) then
+              OleStrToStrVar(StringMap[i].comstr,StringMap[i].paswstr^);
+          end;
         finally
           for i:=0 to NextString-1 do
             SysFreeString(StringMap[i].ComStr);

tests/test/packages/win-base/tdispvar2.pp

@@ -0,0 +1,151 @@
+{ %TARGET = win32,win64,wince }
+{ tests that the different string types are converted correctly when dispatching }
+
+program tdispvar2;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils, Variants, ComObj, ActiveX, Windows;
+
+type
+  { TTest }
+
+  TTest = class(TInterfacedObject, IDispatch)
+    function GetTypeInfoCount(out count : longint) : HResult;stdcall;
+    function GetTypeInfo(Index,LocaleID : longint;
+      out TypeInfo): HResult;stdcall;
+    function GetIDsOfNames(const iid: TGUID; names: Pointer;
+      NameCount, LocaleID: LongInt; DispIDs: Pointer) : HResult;stdcall;
+    function Invoke(DispID: LongInt;const iid : TGUID;
+      LocaleID : longint; Flags: Word;var params;
+      VarResult,ExcepInfo,ArgErr : pointer) : HResult;stdcall;
+  end;
+
+var
+  TestStr: WideString;
+
+{ TTest }
+
+function TTest.GetTypeInfoCount(out count: longint): HResult; stdcall;
+begin
+  Count := 0;
+  Result := S_OK;
+end;
+
+function TTest.GetTypeInfo(Index, LocaleID: longint; out TypeInfo): HResult;
+  stdcall;
+begin
+  Result := E_NOTIMPL;
+end;
+
+function TTest.GetIDsOfNames(const iid: TGUID; names: Pointer; NameCount,
+  LocaleID: LongInt; DispIDs: Pointer): HResult; stdcall;
+var
+  n: ^PWideChar absolute names;
+  d: PDispIDList absolute DispIDs;
+begin
+  if (WideString(n^) = 'SomeFunction') then begin
+    d^[0] := 1;
+    Result := S_OK;
+  end else
+    Result := DISP_E_UNKNOWNNAME;
+end;
+
+function TTest.Invoke(DispID: LongInt; const iid: TGUID; LocaleID: longint;
+  Flags: Word; var params; VarResult, ExcepInfo, ArgErr: pointer): HResult;
+  stdcall;
+var
+  args: TDispParams absolute params;
+  i: UINT;
+begin
+  //Writeln('Call to Invoke');
+  if (DispID = 1) then begin
+    //Writeln(HexStr(Flags, 4));
+    //Writeln(args.cArgs, ' ', args.cNamedArgs);
+    for i := 0 to args.cArgs - 1 do begin
+      //Writeln(HexStr(args.rgvarg^[i].vt, 4));
+      if args.rgvarg^[i].vt = VT_BSTR then begin
+        //Writeln(WideString(args.rgvarg^[i].bstrVal));
+        TestStr := WideString(args.rgvarg^[i].bstrVal);
+      end else if args.rgvarg^[i].vt = VT_BSTR or VT_BYREF then begin
+        //Writeln(args.rgvarg^[i].pbstrVal^);
+        TestStr := args.rgvarg^[i].pbstrVal^;
+      end;
+    end;
+    Result := S_OK;
+  end else
+    Result := E_NOTIMPL;
+end;
+
+procedure Test;
+{$push}
+{$J-}
+const
+  cs: AnsiString = 'Constant AnsiString';
+  cus: UnicodeString = 'Constant UnicodeString';
+  cws: WideString = 'Constant WideString';
+{$pop}
+var
+  i: IDispatch;
+  w: OleVariant;
+  s: AnsiString;
+  us: UnicodeString;
+  ws: WideString;
+begin
+  w := Null;
+  i := TTest.Create;
+  try
+    s := 'AnsiString';
+    us := 'UnicodeString';
+    ws := 'WideString';
+    w := i;
+
+    TestStr := '';
+    w.SomeFunction('Constant');
+    if TestStr <> 'Constant' then
+      Halt(1);
+
+    TestStr := '';
+    w.SomeFunction(s);
+    if TestStr <> 'AnsiString' then
+      Halt(2);
+
+    TestStr := '';
+    w.SomeFunction(us);
+    if TestStr <> 'UnicodeString' then
+      Halt(3);
+
+    TestStr := '';
+    w.SomeFunction(ws);
+    if TestStr <> 'WideString' then
+      Halt(4);
+
+    TestStr := '';
+    w.SomeFunction(cs);
+    if TestStr <> 'Constant AnsiString' then
+      Halt(5);
+
+    TestStr := '';
+    w.SomeFunction(cus);
+    if TestStr <> 'Constant UnicodeString' then
+      Halt(6);
+
+    TestStr := '';
+    w.SomeFunction(cws);
+    if TestStr <> 'Constant WideString' then
+      Halt(7);
+  finally
+    w := Null;
+    i := Nil;
+  end;
+end;
+
+begin
+  CoInitializeEx(Nil, COINIT_MULTITHREADED);
+  try
+    Test;
+  finally
+    CoUninitialize;
+  end;
+end.