fpc/packages/fcl-db/examples/tsamytable.pp

Unit tsamytable;

{$mode objfpc}{$H+}

Interface

Uses Classes, SysUtils, db, fieldmap, sqldb;

Const
  IID_MyTypeSafeAccess = '{1258E169-56C8-4846-8BAF-928C06B89487}';

  // Field names
  FLD_MyTypeSafeAccess_MyString = 'MyString';
  FLD_MyTypeSafeAccess_MyFixedChar = 'MyFixedChar';
  FLD_MyTypeSafeAccess_MyWideString = 'MyWideString';
  FLD_MyTypeSafeAccess_MyDateTime = 'MyDateTime';
  FLD_MyTypeSafeAccess_MyUnicodeString = 'MyUnicodeString';
  FLD_MyTypeSafeAccess_MyUTF8String = 'MyUTF8String';
  FLD_MyTypeSafeAccess_MyFixedWideString = 'MyFixedWideString';
  FLD_MyTypeSafeAccess_MyInteger = 'MyInteger';
  FLD_MyTypeSafeAccess_MyByteInteger = 'MyByteInteger';
  FLD_MyTypeSafeAccess_MySmallintInteger = 'MySmallintInteger';
  FLD_MyTypeSafeAccess_MyShortIntInteger = 'MyShortIntInteger';
  FLD_MyTypeSafeAccess_MyCardinalInteger = 'MyCardinalInteger';
  FLD_MyTypeSafeAccess_MyFloat = 'MyFloat';
  FLD_MyTypeSafeAccess_MyWord = 'MyWord';
  FLD_MyTypeSafeAccess_MyBoolean = 'MyBoolean';
  FLD_MyTypeSafeAccess_MyInt64 = 'MyInt64';
  FLD_MyTypeSafeAccess_MyQWordLargeInt = 'MyQWordLargeInt';
  FLD_MyTypeSafeAccess_MyBlob = 'MyBlob';

  SQLMyTypeSafeAccess = 
    'SELECT' + sLineBreak +
    'MyString' + sLineBreak +
    ', MyFixedChar' + sLineBreak +
    ', MyWideString' + sLineBreak +
    ', MyDateTime' + sLineBreak +
    ', MyUnicodeString' + sLineBreak +
    ', MyUTF8String' + sLineBreak +
    ', MyFixedWideString' + sLineBreak +
    ', MyInteger' + sLineBreak +
    ', MyByteInteger' + sLineBreak +
    ', MySmallintInteger' + sLineBreak +
    ', MyShortIntInteger' + sLineBreak +
    ', MyCardinalInteger' + sLineBreak +
    ', MyFloat' + sLineBreak +
    ', MyWord' + sLineBreak +
    ', MyBoolean' + sLineBreak +
    ', MyInt64' + sLineBreak +
    ', MyQWordLargeInt' + sLineBreak +
    ', MyBlob' + sLineBreak +
    'FROM MyTable';


Type

{$INLINE ON}

  { IMyTypeSafeAccess }

  IMyTypeSafeAccess = Interface(ITypeSafeDatasetAccess) [IID_MyTypeSafeAccess]
    Function GetMyString : AnsiString;
    Procedure SetMyString (aValue : AnsiString);
    Function GetMyFixedChar : AnsiString;
    Procedure SetMyFixedChar (aValue : AnsiString);
    Function GetMyWideString : WideString;
    Procedure SetMyWideString (aValue : WideString);
    Function GetMyDateTime : TDateTime;
    Procedure SetMyDateTime (aValue : TDateTime);
    Function GetMyUnicodeString : UnicodeString;
    Procedure SetMyUnicodeString (aValue : UnicodeString);
    Function GetMyUTF8String : Utf8String;
    Procedure SetMyUTF8String (aValue : Utf8String);
    Function GetMyFixedWideString : WideString;
    Procedure SetMyFixedWideString (aValue : WideString);
    Function GetMyInteger : Longint;
    Procedure SetMyInteger (aValue : Longint);
    Function GetMyByteInteger : Byte;
    Procedure SetMyByteInteger (aValue : Byte);
    Function GetMySmallintInteger : SmallInt;
    Procedure SetMySmallintInteger (aValue : SmallInt);
    Function GetMyShortIntInteger : ShortInt;
    Procedure SetMyShortIntInteger (aValue : ShortInt);
    Function GetMyCardinalInteger : Cardinal;
    Procedure SetMyCardinalInteger (aValue : Cardinal);
    Function GetMyFloat : Double;
    Procedure SetMyFloat (aValue : Double);
    Function GetMyWord : Word;
    Procedure SetMyWord (aValue : Word);
    Function GetMyBoolean : Boolean;
    Procedure SetMyBoolean (aValue : Boolean);
    Function GetMyInt64 : Int64;
    Procedure SetMyInt64 (aValue : Int64);
    Function GetMyQWordLargeInt : QWord;
    Procedure SetMyQWordLargeInt (aValue : QWord);
    Function GetMyBlob : TStream;
    Property MyString : AnsiString Read GetMyString Write SetMyString;
    Property MyFixedChar : AnsiString Read GetMyFixedChar Write SetMyFixedChar;
    Property MyWideString : WideString Read GetMyWideString Write SetMyWideString;
    Property MyDateTime : TDateTime Read GetMyDateTime Write SetMyDateTime;
    Property MyUnicodeString : UnicodeString Read GetMyUnicodeString Write SetMyUnicodeString;
    Property MyUTF8String : Utf8String Read GetMyUTF8String Write SetMyUTF8String;
    Property MyFixedWideString : WideString Read GetMyFixedWideString Write SetMyFixedWideString;
    Property MyInteger : Longint Read GetMyInteger Write SetMyInteger;
    Property MyByteInteger : Byte Read GetMyByteInteger Write SetMyByteInteger;
    Property MySmallintInteger : SmallInt Read GetMySmallintInteger Write SetMySmallintInteger;
    Property MyShortIntInteger : ShortInt Read GetMyShortIntInteger Write SetMyShortIntInteger;
    Property MyCardinalInteger : Cardinal Read GetMyCardinalInteger Write SetMyCardinalInteger;
    Property MyFloat : Double Read GetMyFloat Write SetMyFloat;
    Property MyWord : Word Read GetMyWord Write SetMyWord;
    Property MyBoolean : Boolean Read GetMyBoolean Write SetMyBoolean;
    Property MyInt64 : Int64 Read GetMyInt64 Write SetMyInt64;
    Property MyQWordLargeInt : QWord Read GetMyQWordLargeInt Write SetMyQWordLargeInt;
    Property MyBlob : TStream Read GetMyBlob;
  end;
  { TMyTypeSafeAccess }

  TMyTypeSafeAccess = Class(TTypeSafeDatasetAccess,IMyTypeSafeAccess)
  Private
    FBlobMyBlob : TBlobProxyStream;
    Procedure DoMyBlobChanged(Sender : TObject);
  Private
    Function GetMyString : AnsiString;
    Procedure SetMyString (AValue  : AnsiString);
    Function GetMyFixedChar : AnsiString;
    Procedure SetMyFixedChar (AValue  : AnsiString);
    Function GetMyWideString : WideString;
    Procedure SetMyWideString (AValue  : WideString);
    Function GetMyDateTime : TDateTime;
    Procedure SetMyDateTime (AValue  : TDateTime);
    Function GetMyUnicodeString : UnicodeString;
    Procedure SetMyUnicodeString (AValue  : UnicodeString);
    Function GetMyUTF8String : Utf8String;
    Procedure SetMyUTF8String (AValue  : Utf8String);
    Function GetMyFixedWideString : WideString;
    Procedure SetMyFixedWideString (AValue  : WideString);
    Function GetMyInteger : Longint;
    Procedure SetMyInteger (AValue  : Longint);
    Function GetMyByteInteger : Byte;
    Procedure SetMyByteInteger (AValue  : Byte);
    Function GetMySmallintInteger : SmallInt;
    Procedure SetMySmallintInteger (AValue  : SmallInt);
    Function GetMyShortIntInteger : ShortInt;
    Procedure SetMyShortIntInteger (AValue  : ShortInt);
    Function GetMyCardinalInteger : Cardinal;
    Procedure SetMyCardinalInteger (AValue  : Cardinal);
    Function GetMyFloat : Double;
    Procedure SetMyFloat (AValue  : Double);
    Function GetMyWord : Word;
    Procedure SetMyWord (AValue  : Word);
    Function GetMyBoolean : Boolean;
    Procedure SetMyBoolean (AValue  : Boolean);
    Function GetMyInt64 : Int64;
    Procedure SetMyInt64 (AValue  : Int64);
    Function GetMyQWordLargeInt : QWord;
    Procedure SetMyQWordLargeInt (AValue  : QWord);
    Function GetMyBlob : TStream;
  Protected
    Class Function FieldMapClass : TFieldMapClass; override;
  Public
    Destructor Destroy; Override;
    Procedure ApplyUpdates; override;
    Class Function CreateQuery(aSQL : String; aConnection : TSQLConnection; aTransaction : TSQLTransaction) : TMyTypeSafeAccess; overload;
    Class Function CreateQuery(aConnection : TSQLConnection; aTransaction : TSQLTransaction) : TMyTypeSafeAccess; overload;
    Class Function GetQuery(aSQL : String; aConnection : TSQLConnection; aTransaction : TSQLTransaction) : IMyTypeSafeAccess; overload;
    Class Function GetQuery(aConnection : TSQLConnection; aTransaction : TSQLTransaction) : IMyTypeSafeAccess; overload;
  Published
    Property MyString : AnsiString Read GetMyString Write SetMyString;
    Property MyFixedChar : AnsiString Read GetMyFixedChar Write SetMyFixedChar;
    Property MyWideString : WideString Read GetMyWideString Write SetMyWideString;
    Property MyDateTime : TDateTime Read GetMyDateTime Write SetMyDateTime;
    Property MyUnicodeString : UnicodeString Read GetMyUnicodeString Write SetMyUnicodeString;
    Property MyUTF8String : Utf8String Read GetMyUTF8String Write SetMyUTF8String;
    Property MyFixedWideString : WideString Read GetMyFixedWideString Write SetMyFixedWideString;
    Property MyInteger : Longint Read GetMyInteger Write SetMyInteger;
    Property MyByteInteger : Byte Read GetMyByteInteger Write SetMyByteInteger;
    Property MySmallintInteger : SmallInt Read GetMySmallintInteger Write SetMySmallintInteger;
    Property MyShortIntInteger : ShortInt Read GetMyShortIntInteger Write SetMyShortIntInteger;
    Property MyCardinalInteger : Cardinal Read GetMyCardinalInteger Write SetMyCardinalInteger;
    Property MyFloat : Double Read GetMyFloat Write SetMyFloat;
    Property MyWord : Word Read GetMyWord Write SetMyWord;
    Property MyBoolean : Boolean Read GetMyBoolean Write SetMyBoolean;
    Property MyInt64 : Int64 Read GetMyInt64 Write SetMyInt64;
    Property MyQWordLargeInt : QWord Read GetMyQWordLargeInt Write SetMyQWordLargeInt;
    Property MyBlob : TStream Read GetMyBlob;
  end;


Implementation

Type

  { TMyFieldMap }

  TMyFieldMap = Class(TFieldMap)
  Private
    FMyString : TField;
    FMyFixedChar : TField;
    FMyWideString : TField;
    FMyDateTime : TField;
    FMyUnicodeString : TField;
    FMyUTF8String : TField;
    FMyFixedWideString : TField;
    FMyInteger : TField;
    FMyByteInteger : TField;
    FMySmallintInteger : TField;
    FMyShortIntInteger : TField;
    FMyCardinalInteger : TField;
    FMyFloat : TField;
    FMyWord : TField;
    FMyBoolean : TField;
    FMyInt64 : TField;
    FMyQWordLargeInt : TField;
    FMyBlob : TField;
  Public
    Procedure InitFields; Override;
    Property MyString : TField read FMyString;
    Property MyFixedChar : TField read FMyFixedChar;
    Property MyWideString : TField read FMyWideString;
    Property MyDateTime : TField read FMyDateTime;
    Property MyUnicodeString : TField read FMyUnicodeString;
    Property MyUTF8String : TField read FMyUTF8String;
    Property MyFixedWideString : TField read FMyFixedWideString;
    Property MyInteger : TField read FMyInteger;
    Property MyByteInteger : TField read FMyByteInteger;
    Property MySmallintInteger : TField read FMySmallintInteger;
    Property MyShortIntInteger : TField read FMyShortIntInteger;
    Property MyCardinalInteger : TField read FMyCardinalInteger;
    Property MyFloat : TField read FMyFloat;
    Property MyWord : TField read FMyWord;
    Property MyBoolean : TField read FMyBoolean;
    Property MyInt64 : TField read FMyInt64;
    Property MyQWordLargeInt : TField read FMyQWordLargeInt;
    Property MyBlob : TField read FMyBlob;
  end;
 { TMyTypeSafeAccess } 

 { Constructor and destructor }

Destructor TMyTypeSafeAccess.Destroy;

begin
  FreeAndNil(FBlobMyBlob);
  Inherited;
end;


 { Property Getters }

Function TMyTypeSafeAccess.GetMyString : AnsiString;

begin
  Result:=TMyFieldMap(FieldMap).MyString.AsAnsiString;
end;


Function TMyTypeSafeAccess.GetMyFixedChar : AnsiString;

begin
  Result:=TMyFieldMap(FieldMap).MyFixedChar.AsAnsiString;
end;


Function TMyTypeSafeAccess.GetMyWideString : WideString;

begin
  Result:=TMyFieldMap(FieldMap).MyWideString.AsWideString;
end;


Function TMyTypeSafeAccess.GetMyDateTime : TDateTime;

begin
  Result:=TMyFieldMap(FieldMap).MyDateTime.AsDateTime;
end;


Function TMyTypeSafeAccess.GetMyUnicodeString : UnicodeString;

begin
  Result:=TMyFieldMap(FieldMap).MyUnicodeString.AsUnicodeString;
end;


Function TMyTypeSafeAccess.GetMyUTF8String : Utf8String;

begin
  Result:=TMyFieldMap(FieldMap).MyUTF8String.AsUtf8String;
end;


Function TMyTypeSafeAccess.GetMyFixedWideString : WideString;

begin
  Result:=TMyFieldMap(FieldMap).MyFixedWideString.AsWideString;
end;


Function TMyTypeSafeAccess.GetMyInteger : Longint;

begin
  Result:=TMyFieldMap(FieldMap).MyInteger.AsInteger;
end;


Function TMyTypeSafeAccess.GetMyByteInteger : Byte;

begin
  Result:=TMyFieldMap(FieldMap).MyByteInteger.AsInteger;
end;


Function TMyTypeSafeAccess.GetMySmallintInteger : SmallInt;

begin
  Result:=TMyFieldMap(FieldMap).MySmallintInteger.AsInteger;
end;


Function TMyTypeSafeAccess.GetMyShortIntInteger : ShortInt;

begin
  Result:=TMyFieldMap(FieldMap).MyShortIntInteger.AsInteger;
end;


Function TMyTypeSafeAccess.GetMyCardinalInteger : Cardinal;

begin
  Result:=TMyFieldMap(FieldMap).MyCardinalInteger.AsInteger;
end;


Function TMyTypeSafeAccess.GetMyFloat : Double;

begin
  Result:=TMyFieldMap(FieldMap).MyFloat.AsFLoat;
end;


Function TMyTypeSafeAccess.GetMyWord : Word;

begin
  Result:=TMyFieldMap(FieldMap).MyWord.AsInteger;
end;


Function TMyTypeSafeAccess.GetMyBoolean : Boolean;

begin
  Result:=TMyFieldMap(FieldMap).MyBoolean.AsBoolean;
end;


Function TMyTypeSafeAccess.GetMyInt64 : Int64;

begin
  Result:=TMyFieldMap(FieldMap).MyInt64.AsLargeInt;
end;


Function TMyTypeSafeAccess.GetMyQWordLargeInt : QWord;

begin
  Result:=TMyFieldMap(FieldMap).MyQWordLargeInt.AsLargeInt;
end;


Procedure TMyTypeSafeAccess.DoMyBlobChanged(Sender : TObject);

begin
  If Dataset.State in dsEditModes then
    TBlobField(TMyFieldMap(FieldMap).MyBlob).LoadFromStream(TStream(Sender));
end;


Function TMyTypeSafeAccess.GetMyBlob : TStream;

begin
  if not Assigned(FBlobMyBlob) then
    begin
    FBlobMyBlob:=TBlobProxyStream.Create;
    FBlobMyBlob.OnChange:=@DoMyBlobChanged;
    end;
  FBlobMyBlob.Size:=0;
  FBlobMyBlob.Position:=0;
  if not FBlobMyBlob.Updating then
    begin
    TBlobField(TMyFieldMap(FieldMap).MyBlob).SaveToStream(FBlobMyBlob);
    FBlobMyBlob.Position:=0;
    end;
  Result:=FBlobMyBlob;
end;


 { Property Setters }

Procedure TMyTypeSafeAccess.SetMyString (AValue  : AnsiString);

begin
  TMyFieldMap(FieldMap).MyString.AsAnsiString:=aValue;
end;


Procedure TMyTypeSafeAccess.SetMyFixedChar (AValue  : AnsiString);

begin
  TMyFieldMap(FieldMap).MyFixedChar.AsAnsiString:=aValue;
end;


Procedure TMyTypeSafeAccess.SetMyWideString (AValue  : WideString);

begin
  TMyFieldMap(FieldMap).MyWideString.AsWideString:=aValue;
end;


Procedure TMyTypeSafeAccess.SetMyDateTime (AValue  : TDateTime);

begin
  TMyFieldMap(FieldMap).MyDateTime.AsDateTime:=aValue;
end;


Procedure TMyTypeSafeAccess.SetMyUnicodeString (AValue  : UnicodeString);

begin
  TMyFieldMap(FieldMap).MyUnicodeString.AsUnicodeString:=aValue;
end;


Procedure TMyTypeSafeAccess.SetMyUTF8String (AValue  : Utf8String);

begin
  TMyFieldMap(FieldMap).MyUTF8String.AsUtf8String:=aValue;
end;


Procedure TMyTypeSafeAccess.SetMyFixedWideString (AValue  : WideString);

begin
  TMyFieldMap(FieldMap).MyFixedWideString.AsWideString:=aValue;
end;


Procedure TMyTypeSafeAccess.SetMyInteger (AValue  : Longint);

begin
  TMyFieldMap(FieldMap).MyInteger.AsInteger:=aValue;
end;


Procedure TMyTypeSafeAccess.SetMyByteInteger (AValue  : Byte);

begin
  TMyFieldMap(FieldMap).MyByteInteger.AsInteger:=aValue;
end;


Procedure TMyTypeSafeAccess.SetMySmallintInteger (AValue  : SmallInt);

begin
  TMyFieldMap(FieldMap).MySmallintInteger.AsInteger:=aValue;
end;


Procedure TMyTypeSafeAccess.SetMyShortIntInteger (AValue  : ShortInt);

begin
  TMyFieldMap(FieldMap).MyShortIntInteger.AsInteger:=aValue;
end;


Procedure TMyTypeSafeAccess.SetMyCardinalInteger (AValue  : Cardinal);

begin
  TMyFieldMap(FieldMap).MyCardinalInteger.AsInteger:=aValue;
end;


Procedure TMyTypeSafeAccess.SetMyFloat (AValue  : Double);

begin
  TMyFieldMap(FieldMap).MyFloat.AsFLoat:=aValue;
end;


Procedure TMyTypeSafeAccess.SetMyWord (AValue  : Word);

begin
  TMyFieldMap(FieldMap).MyWord.AsInteger:=aValue;
end;


Procedure TMyTypeSafeAccess.SetMyBoolean (AValue  : Boolean);

begin
  TMyFieldMap(FieldMap).MyBoolean.AsBoolean:=aValue;
end;


Procedure TMyTypeSafeAccess.SetMyInt64 (AValue  : Int64);

begin
  TMyFieldMap(FieldMap).MyInt64.AsLargeInt:=aValue;
end;


Procedure TMyTypeSafeAccess.SetMyQWordLargeInt (AValue  : QWord);

begin
  TMyFieldMap(FieldMap).MyQWordLargeInt.AsLargeInt:=aValue;
end;


Class Function TMyTypeSafeAccess.FieldMapClass : TFieldMapClass;

begin
  Result:=TMyFieldMap;
end;


 { TMyFieldMap }

Procedure TMyFieldMap.InitFields;

begin
  FMyString:=FieldByName('MyString');
  FMyFixedChar:=FieldByName('MyFixedChar');
  FMyWideString:=FieldByName('MyWideString');
  FMyDateTime:=FieldByName('MyDateTime');
  FMyUnicodeString:=FieldByName('MyUnicodeString');
  FMyUTF8String:=FieldByName('MyUTF8String');
  FMyFixedWideString:=FieldByName('MyFixedWideString');
  FMyInteger:=FieldByName('MyInteger');
  FMyByteInteger:=FieldByName('MyByteInteger');
  FMySmallintInteger:=FieldByName('MySmallintInteger');
  FMyShortIntInteger:=FieldByName('MyShortIntInteger');
  FMyCardinalInteger:=FieldByName('MyCardinalInteger');
  FMyFloat:=FieldByName('MyFloat');
  FMyWord:=FieldByName('MyWord');
  FMyBoolean:=FieldByName('MyBoolean');
  FMyInt64:=FieldByName('MyInt64');
  FMyQWordLargeInt:=FieldByName('MyQWordLargeInt');
  FMyBlob:=FieldByName('MyBlob');
end;


Class Function TMyTypeSafeAccess.CreateQuery(aConnection : TSQLConnection; aTransaction : TSQLTransaction) : TMyTypeSafeAccess;

begin
  Result:=CreateQuery(SQLMyTypeSafeAccess,aConnection,aTransaction);
end;


Class Function TMyTypeSafeAccess.CreateQuery(aSQL : String; aConnection : TSQLConnection; aTransaction : TSQLTransaction) : TMyTypeSafeAccess;

Var
  Q : TSQLQuery;
  MySQL : String;
begin
  If aSQL='' then
    MySQL:=SQLMyTypeSafeAccess 
  else
    MySQL:=aSQL;
  Q:=TSQLQuery.Create(aConnection);
  If aTransaction<>Nil then
    Q.Transaction:=aTransaction;
  Q.Database:=aConnection;
  Q.SQL.Text:=MySQL;
  Result:=TMyTypeSafeAccess.Create(Q,True);
end;


Class Function TMyTypeSafeAccess.GetQuery(aConnection : TSQLConnection; aTransaction : TSQLTransaction) : IMyTypeSafeAccess;

begin
  Result:=CreateQuery(aConnection,aTransaction);
end;


Class Function TMyTypeSafeAccess.GetQuery(aSQL : String; aConnection : TSQLConnection; aTransaction : TSQLTransaction) : IMyTypeSafeAccess;

begin
  Result:=CreateQuery(aSQL,aConnection,aTransaction);
end;


Procedure TMyTypeSafeAccess.ApplyUpdates;


begin
  If Dataset is TSQLQuery then
    (Dataset as TSQLQuery).ApplyUpdates;
end;



end.