@@ -150,14 +150,8 @@   TNamedParamDesc = record
150150  end ;
151151  TNamedParamArray = array  of  TNamedParamDesc;
152152
153- { $IFDEF DELPHIXE2_OR_HIGHER} 
154-   { $DEFINE USESYSTEMDISPINVOKE} // Delphi 2010 DispInvoke is buggy
155-   { $IF defined(OSX64) or defined(LINUX) or not defined(DELPHI10_4_OR_HIGHER)} 
156-     { $DEFINE PATCHEDSYSTEMDISPINVOKE} // To correct memory leaks
157-   { $IFEND} 
158- { $ENDIF} 
159- { $IF DEFINED(FPC_FULLVERSION) and (FPC_FULLVERSION >= 20500)} 
160-   { $DEFINE USESYSTEMDISPINVOKE} 
153+ { $IF not defined(FPC) and (defined(OSX64) or defined(LINUX) or not defined(DELPHI10_4_OR_HIGHER))} 
154+   { $DEFINE PATCHEDSYSTEMDISPINVOKE} // To correct memory leaks
161155{ $IFEND} 
162156
163157  {  Python variant type handler } 
@@ -173,20 +167,13 @@   TPythonVariantType = class(TInvokeableVariantType, IVarInstanceReference)
173167      const  Arguments: TVarDataArray): PPyObject;
174168    function   VarDataToPythonObject ( AVarData : TVarData ) : PPyObject;
175169    procedure  PyhonVarDataCreate ( var  Dest : TVarData; AObject : PPyObject );
176-     { $IFNDEF USESYSTEMDISPINVOKE} 
177-     procedure  DoDispInvoke (Dest: PVarData; var  Source: TVarData;
178-       CallDesc: PCallDesc; Params: Pointer); virtual ;
179-     function  GetPropertyWithArg (var  Dest: TVarData; const  V: TVarData;
180-       const  AName: AnsiString; AArg : TVarData): Boolean; virtual ;
181-     { $ENDIF USESYSTEMDISPINVOKE} 
182-     { $IFNDEF FPC} 
183-     function  FixupIdent (const  AText: string): string; override;
184-     { $ENDIF FPC} 
185170    { $IFDEF FPC} 
186171    procedure  VarDataClear (var  Dest: TVarData);
187172    procedure  VarDataCopyNoInd (var  Dest: TVarData; const  Source: TVarData);
188173    procedure  VarDataCastTo (var  Dest: TVarData; const  Source: TVarData;
189174      const  AVarType: TVarType); overload;
175+     { $ELSE} 
176+     function  FixupIdent (const  AText: string): string; override;
190177    { $ENDIF FPC} 
191178  public 
192179    procedure  Clear (var  V: TVarData); override;
@@ -1158,7 +1145,6 @@ procedure TPythonVariantType.DispInvoke(Dest: PVarData;
11581145procedure  TPythonVariantType.DispInvoke (Dest: PVarData;
11591146   var  Source: TVarData; CallDesc: PCallDesc; Params: Pointer);
11601147{ $ENDIF} 
1161- { $IFDEF USESYSTEMDISPINVOKE} 
11621148{ $IFDEF PATCHEDSYSTEMDISPINVOKE} 
11631149  //   Modified to correct memory leak QC102387 / RSP-23093
11641150  procedure  PatchedFinalizeDispatchInvokeArgs (CallDesc: PCallDesc; const  Args: TVarDataArray; OrderLTR : Boolean);
@@ -1336,283 +1322,6 @@ procedure TPythonVariantType.DispInvoke(Dest: PVarData;
13361322  end ;
13371323end ;
13381324
1339- { $ELSE USESYSTEMDISPINVOKE} 
1340- begin 
1341-   DoDispInvoke(Dest, Source, CallDesc, Params);
1342- end ;
1343- 
1344- procedure  TPythonVariantType.DoDispInvoke (Dest: PVarData;
1345-   var  Source: TVarData; CallDesc: PCallDesc; Params: Pointer);
1346- type 
1347-   PParamRec = ^TParamRec;
1348-   TParamRec = array [0 ..3 ] of  Integer;
1349-   TStringDesc = record 
1350-     BStr: WideString;
1351-     PStr: PAnsiString;
1352-   end ;
1353- var 
1354-   LArguments: TVarDataArray;
1355-   LStrings: array  of  TStringDesc;
1356-   LStrCount: Integer;
1357-   LParamPtr: Pointer;
1358-   LNamedArgStart : Integer;     // arg position of 1st named argument (if any)
1359-   LNamePtr: PAnsiChar;
1360- 
1361-   procedure  ParseParam (I: Integer);
1362-   const 
1363-     CArgTypeMask    = $7F ;
1364-     CArgByRef       = $80 ;
1365-   var 
1366-     LArgType: Integer;
1367-     LArgByRef: Boolean;
1368-   begin 
1369-     LArgType := CallDesc^.ArgTypes[I] and  CArgTypeMask;
1370-     LArgByRef := (CallDesc^.ArgTypes[I] and  CArgByRef) <> 0 ;
1371- 
1372-     if  I >= LNamedArgStart then 
1373-     begin 
1374-       LNamePtr := LNamePtr + Succ(StrLen(LNamePtr));
1375-       fNamedParams[I-LNamedArgStart].Index := I;
1376-       fNamedParams[I-LNamedArgStart].Name   := AnsiString(LNamePtr);
1377-     end ;
1378- 
1379-     //  error is an easy expansion
1380-     if  LArgType = varError then 
1381-       SetClearVarToEmptyParam(LArguments[I])
1382- 
1383-     //  literal string
1384-     else  if  LArgType = varStrArg then 
1385-     begin 
1386-       with  LStrings[LStrCount] do 
1387-         if  LArgByRef then 
1388-         begin 
1389-           // BStr := StringToOleStr(PAnsiString(ParamPtr^)^);
1390-           BStr := WideString(System.Copy(PAnsiString(LParamPtr^)^, 1 , MaxInt));
1391-           PStr := PAnsiString(LParamPtr^);
1392-           LArguments[I].VType := varOleStr or  varByRef;
1393-           LArguments[I].VOleStr := @BStr;
1394-         end 
1395-         else 
1396-         begin 
1397-           // BStr := StringToOleStr(PAnsiString(LParamPtr)^);
1398-           BStr := WideString(System.Copy(PAnsiString(LParamPtr)^, 1 , MaxInt));
1399-           PStr := nil ;
1400-           LArguments[I].VType := varOleStr;
1401-           if  BStr = ' ' then 
1402-             LArguments[I].VOleStr := nil 
1403-           else 
1404-             LArguments[I].VOleStr := PWideChar(BStr);
1405-         end ;
1406-       Inc(LStrCount);
1407-     end 
1408- 
1409-     //  value is by ref
1410-     else  if  LArgByRef then 
1411-     begin 
1412-       if  (LArgType = varVariant) and 
1413-          (PVarData(LParamPtr^)^.VType = varString)
1414-            or  (PVarData(LParamPtr)^.VType = varUString)
1415-       then 
1416-         // VarCast(PVariant(ParamPtr^)^, PVariant(ParamPtr^)^, varOleStr);
1417-         VarDataCastTo(PVarData(LParamPtr^)^, PVarData(LParamPtr^)^, varOleStr);
1418-       LArguments[I].VType := LArgType or  varByRef;
1419-       LArguments[I].VPointer := Pointer(LParamPtr^);
1420-     end 
1421- 
1422-     //  value is a variant
1423-     else  if  LArgType = varVariant then 
1424-       if  (PVarData(LParamPtr)^.VType = varString)
1425-         or  (PVarData(LParamPtr)^.VType = varUString)
1426-       then 
1427-       begin 
1428-         with  LStrings[LStrCount] do 
1429-         begin 
1430-           // BStr := StringToOleStr(AnsiString(PVarData(LParamPtr)^.VString));
1431-           if  (PVarData(LParamPtr)^.VType = varString) then 
1432-             BStr := WideString(System.Copy(AnsiString(PVarData(LParamPtr)^.VString), 1 , MaxInt))
1433-           else 
1434-             { $IFDEF FPC} 
1435-             BStr := System.Copy(UnicodeString(PVarData(LParamPtr)^.VString), 1 , MaxInt);
1436-             { $ELSE} 
1437-             BStr := System.Copy(UnicodeString(PVarData(LParamPtr)^.VUString), 1 , MaxInt);
1438-             { $ENDIF} 
1439-           PStr := nil ;
1440-           LArguments[I].VType := varOleStr;
1441-           LArguments[I].VOleStr := PWideChar(BStr);
1442-         end ;
1443-         Inc(LStrCount);
1444-         Inc(NativeInt(LParamPtr), SizeOf(TVarData) - SizeOf(Pointer));
1445-       end 
1446-       else 
1447-       begin 
1448-         LArguments[I] := PVarData(LParamPtr)^;
1449-         Inc(NativeInt(LParamPtr), SizeOf(TVarData) - SizeOf(Pointer));
1450-       end 
1451-     else 
1452-     begin 
1453-       LArguments[I].VType := LArgType;
1454-       case  CVarTypeToElementInfo[LArgType].Size of 
1455-         1 , 2 , 4 :
1456-         begin 
1457-           LArguments[I].VLongs[1 ] := PParamRec(LParamPtr)^[0 ];
1458-         end ;
1459-         8 :
1460-         begin 
1461-           LArguments[I].VLongs[1 ] := PParamRec(LParamPtr)^[0 ];
1462-           LArguments[I].VLongs[2 ] := PParamRec(LParamPtr)^[1 ];
1463-           Inc(NativeInt(LParamPtr), 8  - SizeOf(Pointer));
1464-         end ;
1465-       else 
1466-         RaiseDispError;
1467-       end ;
1468-     end ;
1469-     Inc(NativeInt(LParamPtr), SizeOf(Pointer));
1470-   end ;
1471- 
1472- var 
1473-   I, LArgCount: Integer;
1474-   LIdent: AnsiString;
1475-   LTemp: TVarData;
1476- begin 
1477-   // ------------------------------------------------------------------------------------
1478-   //  Note that this method is mostly a copy&paste from  TInvokeableVariantType.DispInvoke
1479-   //  because Borland assumes that the names are not case sensitive, whereas Python has
1480-   //  case sensitive symbols.
1481-   //  We modified the property get to allow the use of indexed properties.
1482-   // ------------------------------------------------------------------------------------
1483- 
1484-   //  Grab the identifier
1485-   LArgCount := CallDesc^.ArgCount;
1486-   // After arg types, method name and named arg names are stored
1487-   // Position pointer on method name
1488-   LNamePtr := PAnsiChar(@CallDesc^.ArgTypes[LArgCount]);
1489-   LIdent := AnsiString(LNamePtr);
1490-   // Named params must be after positional params
1491-   LNamedArgStart := CallDesc^.ArgCount - CallDesc^.NamedArgCount;
1492-   SetLength(fNamedParams, CallDesc^.NamedArgCount);
1493- 
1494-   //  Parse the arguments
1495-   LParamPtr := Params;
1496-   SetLength(LArguments, LArgCount);
1497-   LStrCount := 0 ;
1498-   SetLength(LStrings, LArgCount);
1499-   for  I := 0  to  LArgCount - 1  do 
1500-     ParseParam(I);
1501- 
1502-   //  What type of invoke is this?
1503-   case  CallDesc^.CallType of 
1504-     CDoMethod:
1505-       //  procedure with N arguments
1506-       if  Dest = nil  then 
1507-       begin 
1508-         if  not  DoProcedure(Source, string(LIdent), LArguments) then 
1509-         begin 
1510- 
1511-           //  ok maybe its a function but first we must make room for a result
1512-           VarDataInit(LTemp);
1513-           try 
1514- 
1515-             //  notate that the destination shouldn't be bothered with
1516-             //  functions can still return stuff, we just do this so they
1517-             //   can tell that they don't need to if they don't want to
1518-             SetClearVarToEmptyParam(LTemp);
1519- 
1520-             //  ok lets try for that function
1521-             if  not  DoFunction(LTemp, Source, string(LIdent), LArguments) then 
1522-               RaiseDispError;
1523-           finally 
1524-             VarDataClear(LTemp);
1525-           end ;
1526-         end 
1527-       end 
1528- 
1529-       //  property get or function with 0 argument
1530-       else  if  LArgCount = 0  then 
1531-       begin 
1532-         if  not  GetProperty(Dest^, Source, string(LIdent)) and 
1533-            not  DoFunction(Dest^, Source, string(LIdent), LArguments) then 
1534-           RaiseDispError;
1535-       end 
1536- 
1537-       //  function with N arguments
1538-       else  if  not  DoFunction(Dest^, Source, string(LIdent), LArguments) then 
1539-         RaiseDispError;
1540- 
1541-     CPropertyGet:
1542-     begin 
1543-       //  here that code has been changed to allow the indexed properties.
1544- 
1545-       if  Dest = nil  then  //  there must be a dest
1546-         RaiseDispError;
1547-       if  LArgCount = 0  then  //  no args
1548-       begin 
1549-         if  not  GetProperty(Dest^, Source, string(LIdent)) then    //  get op be valid
1550-           RaiseDispError;
1551-       end 
1552-       else  if  LArgCount = 1  then  //  only one arg
1553-       begin 
1554-         if  not  GetPropertyWithArg(Dest^, Source, LIdent, LArguments[0 ]) then    //  get op be valid
1555-           RaiseDispError;
1556-       end 
1557-       else 
1558-         raise Exception.Create( SMultiDimensionalPropsNotSupported );
1559-     end ;
1560- 
1561-     CPropertySet:
1562-       if  not  ((Dest = nil ) and                          //  there can't be a dest
1563-               (LArgCount = 1 ) and                        //  can only be one arg
1564-               SetProperty(Source, string(LIdent), LArguments[0 ])) then  //  set op be valid
1565-         RaiseDispError;
1566-   else 
1567-     RaiseDispError;
1568-   end ;
1569- 
1570-   //  copy back the string info
1571-   I := LStrCount;
1572-   while  I <> 0  do 
1573-   begin 
1574-     Dec(I);
1575-     with  LStrings[I] do 
1576-       if  Assigned(PStr) then 
1577-         PStr^ := AnsiString(System.Copy(BStr, 1 , MaxInt));
1578-   end ;
1579- end ;
1580- 
1581- function  TPythonVariantType.GetPropertyWithArg (var  Dest: TVarData;
1582-   const  V: TVarData; const  AName: AnsiString; AArg: TVarData): Boolean;
1583- var 
1584-   _prop, _result : PPyObject;
1585- begin 
1586-   with  GetPythonEngine do 
1587-   begin 
1588-     _result := nil ;
1589-     _prop := PyObject_GetAttrString(TPythonVarData(V).VPython.PyObject, PAnsiChar(AName));
1590-     CheckError;
1591-     if  Assigned(_prop) then 
1592-     begin 
1593-       //  here we check only sequences, as Delphi does not allow a type different from Integer
1594-       //  to be used within brackets.
1595-       //  But you can still access a dictionary with parenthesis, like: myObj.MyDict('MyKey')
1596-       //  Note that we can't use the brackets on a Python variant that contains a list,
1597-       //  because Delphi thinks it's a variant array, whereas it is not, of course!
1598-       //  So: myList[0] won't work, but myObj.MyList[0] will!!!
1599-       if  PySequence_Check(_prop) <> 0  then 
1600-       begin 
1601-         _result := PySequence_GetItem(_prop, Variant(AArg));
1602-         CheckError;
1603-       end ; //  of if
1604-     end ; //  of if
1605-     Result := Assigned(_result);
1606-     if  Result then 
1607-       try 
1608-         PyhonVarDataCreate(Dest, _result);
1609-       finally 
1610-         Py_XDecRef(_prop);
1611-       end ; //  of try
1612-   end ; //  of with
1613- end ;
1614- { $ENDIF USESYSTEMDISPINVOKE} 
1615- 
16161325function  TPythonVariantType.DoFunction (var  Dest: TVarData;
16171326  const  V: TVarData; const  AName: string;
16181327  const  Arguments: TVarDataArray): Boolean;
0 commit comments