unit WrapFireDAC;

System.Classes,

System.SysUtils,

System.Variants,

System.AnsiStrings,

System.Rtti,

WrapDelphiClasses,

Data.DB,

FireDAC.Stan.Intf,

FireDAC.Stan.Option,

FireDAC.Stan.Error,

FireDAC.UI.Intf,

FireDAC.Phys.Intf,

FireDAC.Stan.Def,

FireDAC.Stan.Pool,

FireDAC.Stan.Async,

FireDAC.Phys,

FireDAC.Stan.Param,

FireDAC.DatS,

FireDAC.DApt.Intf,

FireDAC.DApt,

FireDAC.Comp.Client,

FireDAC.Comp.DataSet,

FireDAC.Comp.UI,

FireDAC.Stan.ExprFuncs,

PythonEngine,

WrapDelphi;

TPyDBCommon = class(TPyDelphiComponent)

function GetProperties : PPyObject;

procedure AppendProperties( List : PPyObject ); virtual;

procedure AppendProp( List : PPyObject; const prop : string );

function GetAttrO(key: PPyObject) : PPyObject; override;

procedure RaiseDBError( E : Exception );

end;

TPyDBField = class(TPyDBCommon)

function GetDelphiObject: TField;

procedure SetDelphiObject(const Value: TField);

function GetAttrO(key: PPyObject) : PPyObject; override;

function SetAttrO(key, value: PPyObject) : Integer; override;

class function DelphiObjectClass : TClass; override;

class procedure RegisterMethods( PythonType : TPythonType ); override;

function CheckField : Boolean;

procedure AppendProperties( List : PPyObject ); override;

// Do-Methods

function Do_Clear( args : PPyObject ) : PPyObject; cdecl;

function Do_FocusControl( args : PPyObject ) : PPyObject; cdecl;

function Do_IsValidChar( args : PPyObject ) : PPyObject; cdecl;

function Do_RefreshLookupList( args : PPyObject ) : PPyObject; cdecl;

property DelphiObject: TField read GetDelphiObject write SetDelphiObject;

end;

TDSRowsAccess = class(TContainerAccess)

function GetContainer: TFDDataset;

function GetItem(AIndex : Integer) : PPyObject; override;

function GetSize : Integer; override;

class function ExpectedContainerClass : TClass; override;

class function Name : string; override;

end;

TPyDBDataset = class (TPyDelphiComponent)

function GetDelphiObject: TFDDataset;

procedure SetDelphiObject(const Value: TFDDataset);

procedure RaiseDBError( E : Exception );

// Class methodes

class function DelphiObjectClass : TClass; override;

class function GetContainerAccessClass : TContainerAccessClass; override;

class procedure RegisterGetSets( PythonType : TPythonType ); override;

class procedure RegisterMethods( PythonType : TPythonType ); override;

class procedure SetupType( PythonType : TPythonType ); override;

//

// Property Getters

function Get_RowsCount( AContext : Pointer) : PPyObject; cdecl;

function Get_Rows( AContext : Pointer) : PPyObject; cdecl;

//

// Attributes

function GetAttrO(key: PPyObject) : PPyObject; override;

function SetAttrO(key, value: PPyObject) : Integer; override;

//

// Methods

function Do_Fields( args : PPyObject ): PPyObject; cdecl;

function Do_FieldByName( args : PPyObject ): PPyObject; cdecl;

function Do_FieldNamesAsTuple( args: PPyObject): PPyObject; cdecl;

function Do_FieldsAsTuple( args: PPyObject): PPyObject; cdecl;

function Do_FieldsAsDict( args: PPyObject): PPyObject; cdecl;

function Do_First( args : PPyObject ) : PPyObject; cdecl;

function Do_Last( args : PPyObject ) : PPyObject; cdecl;

function Do_Next( args : PPyObject ) : PPyObject; cdecl;

function Do_Prior( args : PPyObject ) : PPyObject; cdecl;

function Do_Locate( args : PPyObject ) : PPyObject; cdecl;

function Do_Lookup( args : PPyObject ) : PPyObject; cdecl;

function Do_Refresh( args : PPyObject ) : PPyObject; cdecl;

function Do_FindKey( args : PPyObject ) : PPyObject; cdecl;

function Do_FindNearest( args : PPyObject ) : PPyObject; cdecl;

//

property DelphiObject: TFDDataset read GetDelphiObject write SetDelphiObject;

end;

TPyDBTable = class (TPyDBDataset)

function CheckActiveDBTable(aMustOpen: Boolean): Boolean;

destructor Destroy; override;

function GetDelphiObject: TFDTable;

procedure SetDelphiObject(const Value: TFDTable);

//

class function DelphiObjectClass : TClass; override;

class procedure RegisterMethods( PythonType : TPythonType ); override;

// Attributes

function GetAttrO(key: PPyObject) : PPyObject; override;

function SetAttrO(key, value: PPyObject) : Integer; override;

// Methods

function Do_Open( args : PPyObject ) : PPyObject; cdecl;

function Do_Close( args : PPyObject ) : PPyObject; cdecl;

function Do_Edit( args : PPyObject ) : PPyObject; cdecl;

function Do_Insert( args : PPyObject ) : PPyObject; cdecl;

function Do_Append( args : PPyObject ) : PPyObject; cdecl;

function Do_Post( args : PPyObject ) : PPyObject; cdecl;

function Do_Cancel( args : PPyObject ) : PPyObject; cdecl;

function Do_Delete( args : PPyObject ) : PPyObject; cdecl;

function Do_SetRangeStart( args : PPyObject ) : PPyObject; cdecl;

function Do_EditRangeStart( args : PPyObject ) : PPyObject; cdecl;

function Do_SetRangeEnd( args : PPyObject ) : PPyObject; cdecl;

function Do_EditRangeEnd( args : PPyObject ) : PPyObject; cdecl;

function Do_ApplyRange( args : PPyObject ) : PPyObject; cdecl;

function Do_SetRange( args : PPyObject ) : PPyObject; cdecl;

function Do_CancelRange( args : PPyObject ) : PPyObject; cdecl;

function Do_GetIndexNames( args : PPyObject ) : PPyObject; cdecl;

property DelphiObject: TFDTable read GetDelphiObject write SetDelphiObject;

end;

TPyDBQuery = class (TPyDBDataset)

function CheckActiveDBQuery(aMustOpen: Boolean): Boolean;

destructor Destroy; override;

function GetDelphiObject: TFDQuery;

procedure SetDelphiObject(const Value: TFDQuery);

//

class function DelphiObjectClass : TClass; override;

class procedure RegisterMethods( PythonType : TPythonType ); override;

// Attributes

function GetAttrO(key: PPyObject) : PPyObject; override;

function SetAttrO(key, value: PPyObject) : Integer; override;

// Methods

function Do_Open( args : PPyObject ) : PPyObject; cdecl;

function Do_Close( args : PPyObject ) : PPyObject; cdecl;

function Do_Prepare( args : PPyObject ) : PPyObject; cdecl;

function Do_Unprepare( args : PPyObject ) : PPyObject; cdecl;

function Do_ExecSQL( args : PPyObject ) : PPyObject; cdecl;

//

property DelphiObject: TFDQuery read GetDelphiObject write SetDelphiObject;

end;

TPyFireDACRegistration = class(TRegisteredUnit)

function Name(): string; override;

procedure RegisterWrappers(aPyDelphiWrapper: TPyDelphiWrapper); override;

procedure DefineVars(APyDelphiWrapper : TPyDelphiWrapper); override;

end;

function SqlTimeToVarDate(const V : Variant) : Variant;

Data.SqlTimSt;

function TPyDBCommon.GetProperties : PPyObject;

with GetPythonEngine do begin

Result := PyList_New(0);

AppendProperties( Result );

PyList_Sort(Result);

end;

end;

procedure TPyDBCommon.AppendProperties( List : PPyObject );

// Override this method in the subclasses and add your

// properties to the list

end;

procedure TPyDBCommon.AppendProp( List : PPyObject; const prop : string );

obj : PPyObject;

with GetPythonEngine do begin

obj := PyUnicodeFromString(prop);

PyList_Append( List, obj );

Py_XDecRef(obj);

end;

end;

function TPyDBCommon.GetAttrO(key: PPyObject) : PPyObject;

SKey : string;

try

SKey := LowerCase(GetPythonEngine.PyObjectAsString(Key));

if (SKey = '__properties__' ) or

(SKey = '__members__' ) then

Result := GetProperties

else

Result := inherited GetAttrO(key);

except // Remap Delphi exception to a Python exception

on E : Exception do begin

RaiseDBError( E );

Result := nil;

end;

end;

end;

procedure TPyDBCommon.RaiseDBError( E : Exception );

if GetModule <> nil then

GetModule.RaiseError( AnsiString('DBError'), AnsiString(E.Message) );

end;

class function TPyDBField.DelphiObjectClass: TClass;

Result := TField;

end;

function TPyDBField.GetAttrO(key: PPyObject) : PPyObject;

l_sUpperKey: string;

with GetPythonEngine do begin

if not CheckField then begin

Result := nil;

Exit;

end;

try

l_sUpperKey := UpperCase(PyObjectAsString(Key));

if l_sUpperKey = 'ALIGNMENT' then

Result := VariantAsPyObject( Integer(DelphiObject.Alignment) )

else if l_sUpperKey = 'ASBOOLEAN' then

Result := VariantAsPyObject( DelphiObject.AsBoolean )

else if l_sUpperKey = 'ASDATETIME' then

Result := VariantAsPyObject( DelphiObject.AsDateTime )

else if l_sUpperKey = 'ASFLOAT' then

Result := VariantAsPyObject( DelphiObject.AsFloat )

else if l_sUpperKey = 'ASINTEGER' then

Result := VariantAsPyObject( DelphiObject.AsInteger )

else if l_sUpperKey = 'ASSTRING' then

Result := VariantAsPyObject( DelphiObject.AsString )

else if l_sUpperKey = 'CANMODIFY' then

Result := VariantAsPyObject( DelphiObject.CanModify )

else if l_sUpperKey = 'ConstraintErrorMessage' then

Result := VariantAsPyObject( DelphiObject.ConstraintErrorMessage )

else if l_sUpperKey = 'CurValue' then

Result := VariantAsPyObject( DelphiObject.CurValue )

else if l_sUpperKey = 'CustomConstraint' then

Result := VariantAsPyObject( DelphiObject.CustomConstraint )

else if l_sUpperKey = 'DATASIZE' then

Result := VariantAsPyObject( DelphiObject.DataSize )

else if l_sUpperKey = 'DATATYPE' then

Result := VariantAsPyObject( DelphiObject.DataType )

else if l_sUpperKey = 'DefaultExpression' then

Result := VariantAsPyObject( DelphiObject.DefaultExpression )

else if l_sUpperKey = 'DISPLAYLABEL' then

Result := VariantAsPyObject( DelphiObject.DisplayLabel )

else if l_sUpperKey = 'DISPLAYNAME' then

Result := VariantAsPyObject( DelphiObject.DisplayName )

else if l_sUpperKey = 'DISPLAYTEXT' then

Result := VariantAsPyObject( DelphiObject.DisplayText )

else if l_sUpperKey = 'DISPLAYWIDTH' then

Result := VariantAsPyObject( DelphiObject.DisplayWidth )

else if l_sUpperKey = 'EDITMASK' then

Result := VariantAsPyObject( DelphiObject.EditMask )

else if l_sUpperKey = 'FIELDKIND' then

Result := VariantAsPyObject( DelphiObject.FieldKind )

else if l_sUpperKey = 'FIELDNAME' then

Result := VariantAsPyObject( DelphiObject.FieldName)

else if l_sUpperKey = 'FIELDNO' then

Result := VariantAsPyObject( DelphiObject.FieldNo )

else if l_sUpperKey = 'HASCONSTRAINTS' then

Result := VariantAsPyObject( DelphiObject.HasConstraints )

else if l_sUpperKey = 'IMPORTEDCONSTRAINT' then

Result := VariantAsPyObject( DelphiObject.ImportedConstraint )

else if l_sUpperKey = 'INDEX' then

Result := VariantAsPyObject( DelphiObject.Index )

else if l_sUpperKey = 'ISBLOB' then

Result := VariantAsPyObject( DelphiObject.IsBlob)

else if l_sUpperKey = 'ISINDEXFIELD' then

Result := VariantAsPyObject( DelphiObject.IsIndexField )

else if l_sUpperKey = 'ISNULL' then

Result := VariantAsPyObject( DelphiObject.IsNull )

else if l_sUpperKey = 'KEYFFIELDS' then

Result := VariantAsPyObject( DelphiObject.KeyFields )

else if l_sUpperKey = 'LOOKUP' then

Result := VariantAsPyObject( DelphiObject.Lookup )

else if l_sUpperKey = 'LOOKUPCACHE' then

Result := VariantAsPyObject( DelphiObject.LookupCache )

else if l_sUpperKey = 'LOOKUPKeyFields' then

Result := VariantAsPyObject( DelphiObject.LookupKeyFields )

else if l_sUpperKey = 'LOOKUPLIST' then

Result := ReturnNone

else if l_sUpperKey = 'LOOKUPRESULTFIELD' then

Result := VariantAsPyObject( DelphiObject.LookupResultField )

else if l_sUpperKey = 'NEWVALUE' then

Result := VariantAsPyObject( DelphiObject.NewValue )

else if l_sUpperKey = 'OFFSET' then

Result := VariantAsPyObject( DelphiObject.Offset )

else if l_sUpperKey = 'OLDVALUE' then

Result := VariantAsPyObject( DelphiObject.OldValue )

else if l_sUpperKey = 'ORIGIN' then

Result := VariantAsPyObject( DelphiObject.Origin )

else if l_sUpperKey = 'READONLY' then

Result := VariantAsPyObject( DelphiObject.ReadOnly )

else if l_sUpperKey = 'REQUIRED' then

Result := VariantAsPyObject( DelphiObject.Required )

else if l_sUpperKey = 'SIZE' then

Result := VariantAsPyObject( DelphiObject.Size )

else if l_sUpperKey = 'TEXT' then

Result := VariantAsPyObject( DelphiObject.Text )

else if l_sUpperKey = 'VALIDCHARS' then

Result := ReturnNone

else if l_sUpperKey = 'VALUE' then begin

Result := VariantAsPyObject( SqlTimeToVarDate(DelphiObject.Value) );

end

else if l_sUpperKey = 'VISIBLE' then

Result := VariantAsPyObject( DelphiObject.Visible )

else

Result := inherited GetAttrO(key);

except

on E : Exception do begin

RaiseDBError( E );

Result := nil;

end;

end;

end;

end;

function TPyDBField.GetDelphiObject: TField;

Result := TField(inherited DelphiObject);

end;

function TPyDBField.SetAttrO(key, value: PPyObject) : Integer;

l_sUpperKey: string;

Result := -1;

with GetPythonEngine do begin

if not CheckField then

Exit;

try

l_sUpperKey := UpperCase(PyObjectAsString(Key));

if l_sUpperKey = 'ALIGNMENT' then begin

DelphiObject.Alignment := TAlignment(PyObjectAsVariant( value ));

Result := 0;

end

else if l_sUpperKey = 'ASBOOLEAN' then begin

DelphiObject.AsBoolean := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'ASDATETIME' then begin

DelphiObject.AsDateTime := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'ASFLOAT' then begin

DelphiObject.AsFloat := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'ASINTEGER' then begin

DelphiObject.AsInteger := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'ASSTRING' then begin

DelphiObject.AsString := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'CANMODIFY' then begin

Result := 0;

end

else if l_sUpperKey = 'CONSTRAINTERRORMESSAGE' then begin

DelphiObject.ConstraintErrorMessage := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'CURVALUE' then begin

Result := 0;

end

else if l_sUpperKey = 'CUSTOMCONSTRAINT' then begin

DelphiObject.CustomConstraint := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'DATASIZE' then begin

Result := 0;

end

else if l_sUpperKey = 'DATATYPE' then begin

Result := 0;

end

else if l_sUpperKey = 'DEFAULTEXPRESSION' then begin

DelphiObject.DefaultExpression := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'DISPLAYLABEL' then begin

DelphiObject.DisplayLabel := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'DISPLAYNAME' then begin

Result := 0;

end

else if l_sUpperKey = 'DISPLAYTEXT' then begin

Result := 0;

end

else if l_sUpperKey = 'DISPLAYWIDTH' then begin

DelphiObject.DisplayWidth := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'EDITMASK' then begin

DelphiObject.EditMask := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'FIELDKIND' then begin

DelphiObject.FieldKind := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'FIELDNAME' then begin

DelphiObject.FieldName:= PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'FIELDNO' then begin

Result := 0;

end

else if l_sUpperKey = 'HASCONSTRAINTS' then begin

Result := 0;

end

else if l_sUpperKey = 'IMPORTEDCONSTRAINT' then begin

DelphiObject.ImportedConstraint := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'INDEX' then begin

DelphiObject.Index := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'ISBLOB' then begin

Result := 0;

end

else if l_sUpperKey = 'ISINDEXFIELD' then begin

Result := 0;

end

else if l_sUpperKey = 'ISNULL' then begin

Result := 0;

end

else if l_sUpperKey = 'KEYFIELDS' then begin

DelphiObject.KeyFields := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'LOOKUP' then begin

DelphiObject.Lookup := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'LOOKUPCACHE' then begin

DelphiObject.LookupCache := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'LOOKUPKEYFIELDS' then begin

DelphiObject.LookupKeyFields := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'LOOKUPLIST' then begin

Result := 0;

end

else if l_sUpperKey = 'LOOKUPRESULTFIELD' then begin

DelphiObject.LookupResultField := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'NEWVALUE' then begin

DelphiObject.NewValue := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'OFFSET' then begin

Result := 0;

end

else if l_sUpperKey = 'OLDVALUE' then begin

Result := 0;

end

else if l_sUpperKey = 'ORIGIN' then begin

DelphiObject.Origin := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'READONLY' then begin

DelphiObject.ReadOnly := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'REQUIRED' then begin

DelphiObject.Required := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'SIZE' then begin

DelphiObject.Size := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'TEXT' then begin

DelphiObject.Text := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'VALIDCHARS' then begin

Result := 0;

end

else if l_sUpperKey = 'VALUE' then begin

DelphiObject.Value := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'VISIBLE' then begin

DelphiObject.Visible := PyObjectAsVariant( value );

Result := 0;

end

else

Result := inherited SetAttrO(key, value);

except

on E : Exception do begin

RaiseDBError( E );

Result := -1;

end;

end;

end;

end;

procedure TPyDBField.SetDelphiObject(const Value: TField);

inherited DelphiObject := Value;

end;

class procedure TPyDBField.RegisterMethods( PythonType : TPythonType );

with PythonType do begin

AddMethod(AnsiString('Clear'), @TPyDBField.Do_Clear,

AnsiString('DBField.Clear() -> None') );

AddMethod(AnsiString('FocusControl'), @TPyDBField.Do_FocusControl,

AnsiString('DBField.FocusControl() -> None') );

AddMethod(AnsiString('IsValidChar'), @TPyDBField.Do_IsValidChar,

AnsiString('DBField.IsValidChar( InputChar : String ) -> True or False') );

AddMethod(AnsiString('RefreshLookupList'), @TPyDBField.Do_RefreshLookupList,

AnsiString('DBField.RefreshLookupList() -> None') );

end;

end;

function TPyDBField.CheckField : Boolean;

if not Assigned(DelphiObject) then begin

Result := False;

with GetPythonEngine do

PyErr_SetString (PyExc_RuntimeError^, PAnsiChar('No field defined !') );

end

else

Result := True;

Result := Result;

end;

procedure TPyDBField.AppendProperties( List : PPyObject );

inherited;

AppendProp( List, 'Alignment');

AppendProp( List, 'AsBoolean');

AppendProp( List, 'AsDateTime');

AppendProp( List, 'AsFloat');

AppendProp( List, 'AsInteger');

AppendProp( List, 'AsString');

AppendProp( List, 'CanModify');

AppendProp( List, 'ConstraintErrorMessage');

AppendProp( List, 'CurValue');

AppendProp( List, 'CustomConstraint');

AppendProp( List, 'DataSize');

AppendProp( List, 'DataType');

AppendProp( List, 'DefaultExpression');

AppendProp( List, 'DisplayLabel');

AppendProp( List, 'DisplayName');

AppendProp( List, 'DisplayText');

AppendProp( List, 'DisplayWidth');

AppendProp( List, 'EditMask');

AppendProp( List, 'FieldKind');

AppendProp( List, 'FieldName');

AppendProp( List, 'FieldNo');

AppendProp( List, 'HasConstraints');

AppendProp( List, 'ImportedConstraint');

AppendProp( List, 'Index');

AppendProp( List, 'IsBlob');

AppendProp( List, 'IsIndexField');

AppendProp( List, 'IsNull');

AppendProp( List, 'KeyFields');

AppendProp( List, 'Lookup');

AppendProp( List, 'LookupCache');

AppendProp( List, 'LookupDataset');

AppendProp( List, 'LookupKeyFields');

AppendProp( List, 'LookupList');

AppendProp( List, 'LookupResultField');

AppendProp( List, 'NewValue');

AppendProp( List, 'Offset');

AppendProp( List, 'OldValue');

AppendProp( List, 'Origin');

AppendProp( List, 'ReadOnly');

AppendProp( List, 'Required');

AppendProp( List, 'Size');

AppendProp( List, 'Text');

AppendProp( List, 'ValidChars');

AppendProp( List, 'Value');

AppendProp( List, 'Visible');

end;

function TPyDBField.Do_Clear( args : PPyObject ) : PPyObject;

Adjust(@Self); // <- adjust the transmitted self argument

with GetPythonEngine do begin

try

if CheckField then begin

DelphiObject.Clear;

Result := ReturnNone;

end

else

Result := nil;

except

on E : Exception do begin

RaiseDBError( E );

Result := nil;

end;

end;

end;

end;

function TPyDBField.Do_FocusControl( args : PPyObject ) : PPyObject;

Adjust(@Self); // <- adjust the transmitted self argument

with GetPythonEngine do begin

try

if CheckField then begin

DelphiObject.FocusControl;

Result := ReturnNone;

end

else

Result := nil;

except

on E : Exception do begin

RaiseDBError( E );

Result := nil;

end;

end;

end;

end;

function TPyDBField.Do_IsValidChar( args : PPyObject ) : PPyObject;

c : Char;

s : PAnsiChar;

str : AnsiString;

Adjust(@Self); // <- adjust the transmitted self argument

with GetPythonEngine do begin

try

if CheckField then begin

if PyArg_ParseTuple( args, 's:TField.IsValidChar',@s ) <> 0 then begin

str := s;

if Length(str) > 0 then

c := Char(str[1])

else

c := #0;

Result := VariantAsPyObject( DelphiObject.IsValidChar( c ) )

end

else

Result := nil;

end

else

Result := nil;

except

on E : Exception do begin

RaiseDBError( E );

Result := nil;

end;

end;

end;

end;

function TPyDBField.Do_RefreshLookupList( args : PPyObject ) : PPyObject;

Adjust(@Self); // <- adjust the transmitted self argument

with GetPythonEngine do begin

try

if CheckField then begin

DelphiObject.RefreshLookupList;

Result := ReturnNone;

end

else

Result := nil;

except

on E : Exception do begin

RaiseDBError( E );

Result := nil;

end;

end;

end;

end;

class function TDSRowsAccess.ExpectedContainerClass: TClass;

Result := TFDDataset;

end;

function TDSRowsAccess.GetContainer: TFDDataset;

Result := TFDDataset(inherited Container);

end;

function TDSRowsAccess.GetItem(aIndex: Integer): PPyObject;

i : Integer;

l_oDataset: TFDDataset;

Result := nil;

l_oDataset := GetContainer;

if (aIndex >= 0) and (aIndex < l_oDataset.RecordCount) then begin

with GetPythonEngine do begin

try

l_oDataset.RecNo := AIndex + 1;

Result := PyTuple_New(l_oDataset.FieldCount);

for i := 0 to l_oDataset.FieldCount - 1 do begin

with l_oDataset.Fields[i] do begin

PyTuple_SetItem( Result, i, VariantAsPyObject( SqlTimeToVarDate(Value) ) );

end;

end;

except

on E : Exception do begin

raise Exception.CreateFmt('Exception in TDSRowsAccess.GetItem - Index=%d', [AIndex]);

end;

end;

end;

end;

end;

function TDSRowsAccess.GetSize: Integer;

l_oDataset: TFDDataset;

l_oDataset := GetContainer;

Result := l_oDataset.RecordCount;

end;

class function TDSRowsAccess.Name: string;

Result := 'DSRows';

end;

function TPyDBDataset.GetDelphiObject: TFDDataset;

Result := TFDDataset(inherited DelphiObject);

end;

procedure TPyDBDataset.SetDelphiObject(const Value: TFDDataset);

inherited DelphiObject := Value;

end;

class procedure TPyDBDataset.SetupType(PythonType: TPythonType);

inherited;

PythonType.GenerateCreateFunction := True;

PythonType.Prefix := 'T';

end;

class function TPyDBDataset.DelphiObjectClass : TClass;

Result := TFDDataset;

end;

class function TPyDBDataset.GetContainerAccessClass : TContainerAccessClass;

Result := TDSRowsAccess;

end;

function TPyDBDataset.Get_RowsCount(AContext: Pointer): PPyObject;

Adjust(@Self);

Result := GetPythonEngine.PyLong_FromLong(DelphiObject.RecordCount);

end;

function TPyDBDataset.Get_Rows(AContext: Pointer): PPyObject;

Adjust(@Self);

Result := Self.PyDelphiWrapper.DefaultContainerType.CreateInstance;

with PythonToDelphi(Result) as TPyDelphiContainer do

Setup(Self.PyDelphiWrapper, TDSRowsAccess.Create(Self.PyDelphiWrapper, Self.DelphiObject));

end;

class procedure TPyDBDataset.RegisterGetSets( PythonType : TPythonType );

PythonType.AddGetSet(PAnsiChar('RowsCount'), @TPyDBDataset.Get_RowsCount, nil,

PAnsiChar('Returns the count of contained dataset rows'), nil);

PythonType.AddGetSet(PAnsiChar('Rows'), @TPyDBDataset.Get_Rows, nil,

PAnsiChar('Returns an iterator over contained dataset rows'), nil);

end;

class procedure TPyDBDataset.RegisterMethods( PythonType : TPythonType );

with PythonType do begin

AddMethod(AnsiString('Fields'), @TPyDBDataset.Do_Fields,

AnsiString('DBDataset.Fields( index : Integer ) -> TField') );

AddMethod(AnsiString('FieldByName'), @TPyDBDataset.Do_FieldByName,

AnsiString('DBDataset.FieldByName(FieldName: String) -> DBField') );

AddMethod(AnsiString('FieldNamesAsTuple'), @TPyDBDataset.Do_FieldNamesAsTuple,

AnsiString('DBDataset.FieldNamesAsTuple() -> a tuple containing all field names') );

AddMethod(AnsiString('FieldsAsTuple'), @TPyDBDataset.Do_FieldsAsTuple,

AnsiString('DBDataset.FieldsAsTuple() -> a tuple containing all TFields') );

AddMethod(AnsiString('FieldsAsDict'), @TPyDBDataset.Do_FieldsAsDict,

AnsiString('DBDataset.FieldsAsDict() -> a dictionary containing all TFields, with FieldName as Key, and TField as Value') );

AddMethod(AnsiString('First'), @TPyDBDataset.Do_First,

AnsiString('DBDataset.First() -> None') );

AddMethod(AnsiString('Last'), @TPyDBDataset.Do_Last,

AnsiString('DBDataset.Last() -> None') );

AddMethod(AnsiString('Next'), @TPyDBDataset.Do_Next,

AnsiString('DBDataset.Next() -> None') );

AddMethod(AnsiString('Prior'), @TPyDBDataset.Do_Prior,

AnsiString('DBDataset.Prior() -> None') );

AddMethod(AnsiString('Locate'), @TPyDBDataset.Do_Locate,

AnsiString('DBDataset.Locate( KeyFields : String, KeyValues : Object or Sequence, Options : TLocateOptions ) -> True or False') );

AddMethod(AnsiString('Lookup'), @TPyDBDataset.Do_Lookup,

AnsiString('DBDataset.Lookup( KeyFields : String, KeyValues : Object or Sequence, ResultFields : String ) -> a list containing all Result fields') );

AddMethod(AnsiString('FindKey'), @TPyDBDataset.Do_FindKey,

AnsiString('DBDataset.FindKey( KeyValues : Sequence ) -> True or False') );

AddMethod(AnsiString('FindNearest'), @TPyDBDataset.Do_FindNearest,

AnsiString('DBDataset.FindNearest( KeyValues : Sequence ) -> None') );

end;

end;

function TPyDBDataset.GetAttrO(key: PPyObject) : PPyObject;

l_sUpperKey: string;

l_oDataset: TFDDataset;

with GetPythonEngine do begin

try

l_oDataset := DelphiObject;

l_sUpperKey := UpperCase(PyObjectAsString(Key));

if l_sUpperKey = 'BOF' then

Result := VariantAsPyObject( l_oDataset.BOF )

else if l_sUpperKey = 'CANMODIFY' then

Result := VariantAsPyObject( l_oDataset.CanModify )

else if l_sUpperKey = 'EOF' then

Result := VariantAsPyObject( l_oDataset.EOF )

else if l_sUpperKey = 'FIELDCOUNT' then

Result := VariantAsPyObject( l_oDataset.FieldCount )

else if l_sUpperKey = 'RECNO' then

Result := VariantAsPyObject( l_oDataset.RecNo )

else

Result := inherited GetAttrO(key);

except

on E : Exception do begin

RaiseDBError( E );

Result := Nil;

end;

end;

end;

end;

function TPyDBDataset.SetAttrO(key, value: PPyObject) : Integer;

l_sUpperKey: string;

l_oDataset: TFDDataset;

with GetPythonEngine do begin

try

l_oDataset := DelphiObject;

l_sUpperKey := UpperCase(PyObjectAsString(Key));

if l_sUpperKey = 'FILTER' then begin

l_oDataset.Filter := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'FILTERED' then begin

l_oDataset.Filtered := PyObjectAsVariant( value );

Result := 0;

end

else if l_sUpperKey = 'BOF' then begin

Result := 0;

end

else if l_sUpperKey = 'CanModify' then begin

Result := 0;

end

else if l_sUpperKey = 'EOF' then begin

Result := 0;

end

else if l_sUpperKey = 'RECNO' then begin

l_oDataset.RecNo := PyObjectAsVariant( value );

Result := 0;

end

else

Result := inherited SetAttrO(key, value);

except

on E : Exception do begin

RaiseDBError( E );

Result := -1;

end;

end;

end;

end;

procedure TPyDBDataset.RaiseDBError( E : Exception );

if self.GetModule <> nil then

GetModule.RaiseError( AnsiString('DBError'), AnsiString(E.Message) );

end;

function TPyDBDataset.Do_Fields( args : PPyObject ): PPyObject;

idx : Integer;

l_oDataset: TFDDataset;

// We adjust the transmitted self argument

Adjust(@Self);

with GetPythonEngine do begin

l_oDataset := DelphiObject;

try

if PyArg_ParseTuple( args, 'i:DBDataset.Fields',@idx ) <> 0 then begin

if (idx >= 0) and (idx < l_oDataset.FieldCount) then

Result := PyDelphiWrapper.Wrap(l_oDataset.Fields[idx])

else begin

Result := nil;

PyErr_SetString (PyExc_AttributeError^, PAnsiChar(AnsiString(Format('Value out of range : %d', [idx]))));

end;

end

else

Result := nil;

except

on E : Exception do begin

RaiseDBError( E );

Result := nil;

end;

end;

end;

end;

function TPyDBDataset.Do_FieldByName( args : PPyObject ) : PPyObject;

l_sAStr: AnsiString;

s : PAnsiChar;

fld : TField;

l_oDataset: TFDDataset;

// We adjust the transmitted self argument

Adjust(@Self);

with GetPythonEngine do begin

l_oDataset := DelphiObject;

try

if (PyArg_ParseTuple( args, PAnsiChar('s:DBDataset.FieldByName'),@s ) <> 0) then begin

l_sAStr := AnsiString(s);

fld := l_oDataset.FieldByName(string(l_sAStr));

if Assigned(fld) then