@@ -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