* Type-safe dataset access implementation and code generator

git-svn-id: trunk@39617 -

.gitattributes

@@ -2016,6 +2016,7 @@ packages/fcl-db/examples/createsql.lpi svneol=native#text/plain
 packages/fcl-db/examples/createsql.pas svneol=native#text/plain
 packages/fcl-db/examples/dbftool.lpi svneol=native#text/plain
 packages/fcl-db/examples/dbftool.lpr svneol=native#text/plain
+packages/fcl-db/examples/demotypesafeaccess.pp svneol=native#text/plain
 packages/fcl-db/examples/fbadmindemo.pp svneol=native#text/plain
 packages/fcl-db/examples/fbeventstest.pp svneol=native#text/plain
 packages/fcl-db/examples/loadlibdemo.lpi svneol=native#text/plain
@@ -2026,6 +2027,8 @@ packages/fcl-db/examples/pqeventstest.pp svneol=native#text/plain
 packages/fcl-db/examples/showcsv.pp svneol=native#text/plain
 packages/fcl-db/examples/sqlite3loadlib.lpr svneol=native#text/plain
 packages/fcl-db/examples/sqlparser.pp svneol=native#text/plain
+packages/fcl-db/examples/tsamytable.pp svneol=native#text/plain
+packages/fcl-db/examples/typesafetable.sql svneol=native#text/plain
 packages/fcl-db/fpmake.pp svneol=native#text/plain
 packages/fcl-db/src/Dataset.txt svneol=native#text/plain
 packages/fcl-db/src/README.txt svneol=native#text/plain
@@ -2042,6 +2045,7 @@ packages/fcl-db/src/base/dbcoll.pp svneol=native#text/plain
 packages/fcl-db/src/base/dbconst.pas svneol=native#text/plain
 packages/fcl-db/src/base/dbwhtml.pp svneol=native#text/plain
 packages/fcl-db/src/base/dsparams.inc svneol=native#text/plain
+packages/fcl-db/src/base/fieldmap.pp svneol=native#text/plain
 packages/fcl-db/src/base/fields.inc svneol=native#text/plain
 packages/fcl-db/src/base/fpmake.inc svneol=native#text/plain
 packages/fcl-db/src/base/fpmake.pp svneol=native#text/plain
@@ -2054,8 +2058,10 @@ packages/fcl-db/src/codegen/buildddcg.lpi svneol=native#text/plain
 packages/fcl-db/src/codegen/buildddcg.lpr svneol=native#text/plain
 packages/fcl-db/src/codegen/fpcgcreatedbf.pp svneol=native#text/plain
 packages/fcl-db/src/codegen/fpcgdbcoll.pp svneol=native#text/plain
+packages/fcl-db/src/codegen/fpcgfieldmap.pp svneol=native#text/plain
 packages/fcl-db/src/codegen/fpcgsqlconst.pp svneol=native#text/plain
 packages/fcl-db/src/codegen/fpcgtiopf.pp svneol=native#text/plain
+packages/fcl-db/src/codegen/fpcgtypesafedataset.pp svneol=native#text/plain
 packages/fcl-db/src/codegen/fpddcodegen.pp svneol=native#text/plain
 packages/fcl-db/src/codegen/fpddpopcode.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/Makefile svneol=native#text/plain

packages/fcl-db/examples/demotypesafeaccess.pp

@@ -0,0 +1,56 @@
+program testpp;
+{$mode objfpc}
+{$H+}
+uses sysutils, sqldb, ibconnection, tsamytable;
+
+Procedure DoTest;
+
+Var
+  C : TIBConnection;
+  T : TSQLTransaction;
+  A : IMyTypeSafeAccess;
+
+begin
+  C:=TIBConnection.Create(Nil);
+  try
+    C.HostName:='localhost';
+    C.DatabaseName:='/home/firebird/testdb.fdb';
+    C.UserName:='WISASOFT';
+    C.Password:='SysteemD';
+    T:=TSQLTransaction.Create(C);
+    C.Transaction:=T;
+    T.Database:=C;
+    A:=TMyTypeSafeAccess.GetQuery(C,T);
+    A.Open;
+    A.Append;
+    A.MyBoolean:=True;
+    A.MyInteger:=StrToIntDef(Paramstr(1),1);
+    A.MyWideString:='a';
+    A.MyUnicodeString:='B';
+    A.MyByteInteger:=123;
+    A.MyInt64:=4564654;
+    A.MyQWordLargeInt:=6566564564;
+    A.MySmallintInteger:=2345;
+    A.MyShortIntInteger:=5;
+    A.MyCardinalInteger:=6;
+    A.MybLob.Write(C.DatabaseName[1],Length(C.DatabaseName));
+    A.MyFixedChar:='fa';
+    A.MyFixedWideString:='fu';
+    A.Post;
+    A.ApplyUpdates;
+    T.Commit;
+  finally
+//    A.Free;
+    C.Free;
+  end;
+end;
+
+begin
+  Try
+    DoTest;
+  except
+    On E : Exception do
+      writeln('Exception ',E.ClassName,' with message : ',E.Message);
+  end;
+end.
+

packages/fcl-db/examples/tsamytable.pp

@@ -0,0 +1,600 @@
+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.

packages/fcl-db/examples/typesafetable.sql

@@ -0,0 +1,20 @@
+create table mytable (
+  myString varchar(30),
+  myfixedchar char(30),
+  myWideString varchar(20),
+  myunicodestring varchar(20),
+  myutf8string varchar(20),
+  myfixedwidestring char(10),
+  myinteger int PRIMARY KEY,
+  mybyteinteger SMALLINT,
+  mysmallintInteger smallint,
+  myshortintinteger smallint,
+  mycardinalinteger int,
+  mydatetime timestamp,
+  myfloat float,
+  myword int,
+  myboolean smallint,
+  myint64 bigint,
+  myqwordlargeint bigint,
+  myblob blob
+);

packages/fcl-db/fpmake.pp

@@ -134,6 +134,9 @@ begin
 
     T:=P.Targets.AddUnit('sqlscript.pp');
     T.ResourceStrings:=true;
+    
+    T:=P.Targets.AddUnit('fieldmap.pp');
+    T.ResourceStrings:=true;
 
     T:=P.Targets.AddUnit('dbwhtml.pp');
     with T.Dependencies do
@@ -335,7 +338,18 @@ begin
         begin
           AddUnit('fpddcodegen');
         end;
-    T.ResourceStrings:=true;
+    T.ResourceStrings:=true;    
+    T:=P.Targets.AddUnit('fpcgfieldmap.pp', DatadictOSes);
+      with T.Dependencies do
+        begin
+          AddUnit('fpddcodegen');
+        end;
+    T:=P.Targets.AddUnit('fpcgtypesafedataset.pp', DatadictOSes);
+      with T.Dependencies do
+        begin
+          AddUnit('fpddcodegen');
+          AddUnit('fpcgfieldmap');
+        end;
     T:=P.Targets.AddUnit('fpcgtiopf.pp', DatadictOSes);
       with T.Dependencies do
         begin
@@ -441,6 +455,22 @@ begin
           AddUnit('fpddsqldb');
           AddUnit('mysql55conn');
         end;
+    T:=P.Targets.AddUnit('fpddmysql56.pp', DatadictOSes);
+      with T.Dependencies do
+        begin
+          AddUnit('sqldb');
+          AddUnit('fpdatadict');
+          AddUnit('fpddsqldb');
+          AddUnit('mysql56conn');
+        end;
+    T:=P.Targets.AddUnit('fpddmysql57.pp', DatadictOSes);
+      with T.Dependencies do
+        begin
+          AddUnit('sqldb');
+          AddUnit('fpdatadict');
+          AddUnit('fpddsqldb');
+          AddUnit('mysql57conn');
+        end;
     T:=P.Targets.AddUnit('fpddodbc.pp', DatadictOSes);
       with T.Dependencies do
         begin

packages/fcl-db/src/base/fieldmap.pp

@@ -0,0 +1,562 @@
+unit fieldmap;
+{$mode objfpc}
+{$H+}
+interface
+
+uses SysUtils,Classes, db;
+
+{ ---------------------------------------------------------------------
+  TFieldMap
+  ---------------------------------------------------------------------}
+
+type
+  EFieldMap = Class(EDatabaseError);
+
+  { TFieldMap }
+
+  TFieldMap = Class(TObject)
+  private
+    FDataset: TDataset;
+    FFreeDataset: Boolean;
+    FOldOnOpen : TDataSetNotifyEvent;
+  Protected
+    Procedure DoOnOpen(Sender : TDataset);
+    Function FindField(FN : String) : TField;
+    Function FieldByName(FN : String) : TField;
+  Public
+    Constructor Create(ADataset : TDataset; HookOnOpen : Boolean = False);
+    Destructor Destroy; override;
+    Procedure InitFields; virtual; abstract;
+    Procedure LoadObject(AObject : TObject); virtual;
+    Function GetFromField(F : TField; ADefault : Integer) : Integer; overload;
+    Function GetFromField(F : TField; ADefault : String) : String; overload;
+    Function GetFromField(F : TField; ADefault : Boolean) : Boolean; overload;
+    Function GetFromField(F : TField; ADefault : TDateTime) : TDateTime; overload;
+    Function GetFromField(F : TField; ADefault : Currency) : Currency; overload;
+    Property Dataset : TDataset Read FDataset;
+    Property FreeDataset : Boolean Read FFreeDataset Write FFreeDataset;
+  end;
+  TFieldMapClass = Class of TFieldMap;
+
+  { TParamMap }
+
+  TParamMap = Class(TObject)
+  private
+    FParams: TParams;
+  Protected
+    Function FindParam(FN : String) : TParam;
+    Function ParamByName(FN : String) : TParam;
+  Public
+    Constructor Create(AParams : TParams);
+    Procedure InitParams; virtual; abstract;
+    Procedure SaveObject(AObject : TObject); virtual; abstract;
+    Property Params : TParams Read FParams;
+  end;
+
+{ $INTERFACES CORBA}
+
+  ITypeSafeDatasetAccess = Interface ['{67496051-66AA-474E-9CB2-A4AEAA7A2324}']
+    // Property getter/setter
+    procedure SetFreeDataset(AValue: Boolean);
+    function GetFreeDataset: Boolean;
+    function GetActive: boolean;
+    function GetIsEmpty: boolean;
+    function GetModified: Boolean;
+    function GetRecNo: integer;
+    function GetRecordCount: integer;
+    function GetState: TDatasetState;
+    function GetBOF: Boolean;
+    function GetDataset: TDataset;
+    function GetEOF: Boolean;
+    procedure SetActive(AValue: boolean);
+    procedure SetRecNo(AValue: integer);
+    // Examine data
+    function IsFieldNull(const FieldName : String) : boolean;
+    function IsFieldNull(const FieldIndex : Integer) : boolean;
+    // Open/close
+    procedure Open;
+    procedure Close;
+    // Navigation
+    procedure First;
+    procedure Prior;
+    Procedure Next;
+    procedure Last;
+    function Locate(const aKeyFields: string; const aKeyValues: Variant; aOptions: TLocateOptions = []): Boolean;
+    function Lookup(const aKeyFields: string; const aKeyValues: Variant; const aResultFields: string): Variant;
+    // Modification
+    Procedure Append;
+    Procedure Insert;
+    Procedure Edit;
+    Procedure Post;
+    Procedure Delete;
+    Procedure Cancel;
+    Procedure ApplyUpdates;
+    procedure ClearField(const FieldName : String);
+    procedure ClearField(const FieldIndex : Integer);
+    // Properties
+    Property EOF : Boolean Read GetEOF;
+    Property BOF : Boolean Read GetBOF;
+    Property Dataset : TDataset Read GetDataset;
+    property IsEmpty : boolean read GetIsEmpty;
+    property State : TDatasetState read GetState;
+    property RecordCount: integer read GetRecordCount;
+    property RecNo : integer read GetRecNo write SetRecNo;
+    property Active: boolean read GetActive write SetActive;
+    Property Modified : Boolean Read GetModified;
+    Property FreeDataset : Boolean Read GetFreeDataset Write SetFreeDataset;
+  end;
+
+  { TTypeSafeDatasetAccess }
+
+  TTypeSafeDatasetAccess = Class(TInterfacedObject, ITypeSafeDatasetAccess)
+  private
+    FFieldMap: TFieldMap;
+    function GetActive: boolean;
+    function GetIsEmpty: boolean;
+    function GetModified: Boolean;
+    function GetFreeDataset: Boolean;
+    function GetRecNo: integer;
+    function GetRecordCount: integer;
+    function GetState: TDatasetState;
+    procedure SetActive(AValue: boolean);
+    procedure SetFreeDataset(AValue: Boolean);
+    procedure SetRecNo(AValue: integer);
+  Protected
+    Class Function FieldMapClass : TFieldMapClass; virtual; abstract;
+    function GetBOF: Boolean;
+    function GetDataset: TDataset;
+    function GetEOF: Boolean;
+    Property FieldMap : TFieldMap Read FFieldMap;
+  Public
+    Constructor Create(aDataset : TDataset; HookOnOpen : Boolean = True);
+    Destructor Destroy; override;
+    function  IsFieldNull(const FieldName : String) : boolean;
+    function  IsFieldNull(const FieldIndex : Integer) : boolean;
+    procedure ClearField(const FieldName : String);
+    procedure ClearField(const FieldIndex : Integer);
+    // Open/close
+    procedure Open;
+    procedure Close;
+    // Navigation
+    procedure First;
+    procedure Prior;
+    Procedure Next;
+    procedure Last;
+    function Locate(const aKeyFields: string; const aKeyValues: Variant; aOptions: TLocateOptions = []): Boolean;
+    function Lookup(const aKeyFields: string; const aKeyValues: Variant;
+      const aResultFields: string): Variant;
+    // Modification
+    Procedure Append;
+    Procedure Insert;
+    Procedure Edit;
+    Procedure Post;
+    Procedure Delete;
+    Procedure Cancel;
+    Procedure ApplyUpdates; virtual;
+
+    Property EOF : Boolean Read GetEOF;
+    Property BOF : Boolean Read GetBOF;
+    Property Dataset : TDataset Read GetDataset;
+    property IsEmpty : boolean read GetIsEmpty;
+    property State : TDatasetState read GetState;
+    property RecordCount: integer read GetRecordCount;
+    property RecNo : integer read GetRecNo write SetRecNo;
+    property Active: boolean read GetActive write SetActive;
+    Property Modified : Boolean Read GetModified;
+    Property FreeDataset : Boolean Read GetFreeDataset Write SetFreeDataset;
+  end;
+
+  { TBlobProxyStream }
+
+  TBlobProxyStream = Class(TOwnerStream)
+  Private
+    FChangeCount : Integer;
+    FOnChange: TNotifyEvent;
+    function GetUpdating: Boolean;
+  Protected
+    Procedure DoChanged; virtual;
+    Procedure BeginUpdate; virtual;
+    Procedure EndUpdate; virtual;
+    function GetSize: Int64; override;
+    procedure SetSize(const aValue: Int64); override;
+    function GetPosition: Int64; override;
+    procedure SetPosition(const aValue: Int64); override;
+  Public
+    Constructor create; overload;
+    function Read(var Buffer; Count: Longint): Longint; override;
+    function Write(const Buffer; Count: Longint): Longint; override;
+    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; overload;
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    Property Updating : Boolean Read GetUpdating;
+  end;
+
+
+implementation
+
+
+resourcestring
+  SErrNoDataset = '%s: No dataset available.';
+  SErrNoParamsForParam  = '%s: No params to search param "%s".';
+  SErrNoObjectToLoad = '%s: No object to load';
+
+
+function TBlobProxyStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
+begin
+  Result := Source.Seek(Offset, Origin);
+end;
+
+procedure TBlobProxyStream.SetPosition(const aValue: Int64);
+begin
+  Source.Position := aValue;
+end;
+
+procedure TBlobProxyStream.SetSize(const aValue: Int64);
+begin
+  Source.Size := aValue;
+  DoChanged;
+end;
+
+function TBlobProxyStream.Write(const Buffer; Count: Longint): Longint;
+begin
+  Result := Source.Write(Buffer, Count);
+  DoChanged;
+end;
+
+procedure TBlobProxyStream.BeginUpdate;
+begin
+  inc(FChangeCount);
+end;
+
+constructor TBlobProxyStream.create;
+begin
+  Inherited Create(TMemoryStream.Create);
+  SourceOwner:=True;
+end;
+
+procedure TBlobProxyStream.EndUpdate;
+begin
+  if FChangeCount > 0 then
+    Dec(FChangeCount);
+  DoChanged;
+end;
+
+function TBlobProxyStream.GetPosition: Int64;
+begin
+  Result := Source.Position;
+end;
+
+function TBlobProxyStream.GetSize: Int64;
+begin
+  Result := Source.Size;
+end;
+
+function TBlobProxyStream.GetUpdating: Boolean;
+begin
+  Result:=FChangeCount>0;
+end;
+
+procedure TBlobProxyStream.DoChanged;
+begin
+  if (FChangeCount = 0) and Assigned(OnChange) then
+    OnChange(Self);
+end;
+
+function TBlobProxyStream.Read(var Buffer; Count: Longint): Longint;
+begin
+  Result := Source.Read(Buffer, Count);
+end;
+
+{ TTypeSafeDatasetAccess }
+
+function TTypeSafeDatasetAccess.GetIsEmpty: boolean;
+begin
+  With Dataset do
+    Result:=EOF and BOF;
+end;
+
+function TTypeSafeDatasetAccess.GetModified: Boolean;
+begin
+  Result:=Dataset.Modified;
+end;
+
+function TTypeSafeDatasetAccess.GetFreeDataset: Boolean;
+begin
+  Result:=FFieldMap.FreeDataset;
+end;
+
+function TTypeSafeDatasetAccess.GetActive: boolean;
+begin
+  Result:=Dataset.Active;
+end;
+
+function TTypeSafeDatasetAccess.GetRecNo: integer;
+begin
+  Result:=Dataset.RecNo;
+end;
+
+function TTypeSafeDatasetAccess.GetRecordCount: integer;
+begin
+  Result:=Dataset.RecordCount
+end;
+
+function TTypeSafeDatasetAccess.GetState: TDatasetState;
+begin
+  Result:=Dataset.State;
+end;
+
+procedure TTypeSafeDatasetAccess.SetActive(AValue: boolean);
+begin
+  Dataset.Active:=AValue;
+end;
+
+procedure TTypeSafeDatasetAccess.SetFreeDataset(AValue: Boolean);
+begin
+  FFieldMap.FreeDataset:=AValue;
+end;
+
+procedure TTypeSafeDatasetAccess.SetRecNo(AValue: integer);
+begin
+  Dataset.RecNo:=AValue;
+end;
+
+function TTypeSafeDatasetAccess.GetBOF: Boolean;
+begin
+  Result:=Dataset.BOF;
+end;
+
+function TTypeSafeDatasetAccess.GetDataset: TDataset;
+begin
+  Result:=FieldMap.Dataset;
+end;
+
+function TTypeSafeDatasetAccess.GetEOF: Boolean;
+begin
+  Result:=Dataset.EOF;
+end;
+
+procedure TTypeSafeDatasetAccess.ApplyUpdates;
+begin
+  // Needs to be implemented by descendents
+end;
+
+constructor TTypeSafeDatasetAccess.Create(aDataset: TDataset; HookOnOpen : Boolean = True);
+begin
+  FFieldMap:=FieldMapClass.Create(aDataset,HookOnOpen);
+end;
+
+destructor TTypeSafeDatasetAccess.Destroy;
+begin
+  FreeAndNil(FFieldMap);
+  inherited Destroy;
+end;
+
+function TTypeSafeDatasetAccess.IsFieldNull(const FieldName: String): boolean;
+begin
+  Result:=Dataset.FieldByName(FieldName).IsNull;
+end;
+
+function TTypeSafeDatasetAccess.IsFieldNull(const FieldIndex: Integer): boolean;
+begin
+  Result:=Dataset.Fields[FieldIndex].IsNull;
+end;
+
+procedure TTypeSafeDatasetAccess.ClearField(const FieldName: String);
+begin
+  Dataset.FieldByName(FieldName).Clear;
+end;
+
+procedure TTypeSafeDatasetAccess.ClearField(const FieldIndex: Integer);
+begin
+  Dataset.Fields[FieldIndex].Clear;
+end;
+
+procedure TTypeSafeDatasetAccess.Open;
+begin
+  Dataset.Open;
+end;
+
+procedure TTypeSafeDatasetAccess.Close;
+begin
+  Dataset.Close;
+end;
+
+procedure TTypeSafeDatasetAccess.First;
+begin
+  Dataset.First;
+end;
+
+procedure TTypeSafeDatasetAccess.Append;
+begin
+  Dataset.Append;
+end;
+
+procedure TTypeSafeDatasetAccess.Insert;
+begin
+  Dataset.Insert;
+end;
+
+procedure TTypeSafeDatasetAccess.Edit;
+begin
+  Dataset.Edit;
+end;
+
+procedure TTypeSafeDatasetAccess.Next;
+begin
+  Dataset.Next;
+end;
+
+procedure TTypeSafeDatasetAccess.Last;
+begin
+  Dataset.Last;
+end;
+
+function TTypeSafeDatasetAccess.Locate(const aKeyFields: string;
+  const aKeyValues: Variant; aOptions: TLocateOptions): Boolean;
+begin
+  Result:=Dataset.Locate(aKeyFields,AKeyValues,aOptions);
+end;
+
+function TTypeSafeDatasetAccess.Lookup(const aKeyFields: string;
+  const aKeyValues: Variant; const aResultFields: string): Variant;
+begin
+  Result:=Dataset.Lookup(aKeyFields,aKeyValues,aResultFields);
+end;
+
+procedure TTypeSafeDatasetAccess.Prior;
+begin
+  Dataset.Prior;
+end;
+
+procedure TTypeSafeDatasetAccess.Post;
+begin
+  Dataset.Post;
+end;
+
+procedure TTypeSafeDatasetAccess.Delete;
+begin
+  Dataset.Delete;
+end;
+
+procedure TTypeSafeDatasetAccess.Cancel;
+begin
+  Dataset.Cancel;
+end;
+
+{ TParamMap }
+
+function TParamMap.FindParam(FN: String): TParam;
+begin
+  Result:=FParams.FindParam(FN);
+  {if (Result=Nil) then
+    Writeln(ClassName,' param ',FN,' not found');}
+end;
+
+function TParamMap.ParamByName(FN: String): TParam;
+begin
+  If (FParams=Nil) then
+    Raise Exception.CreateFmt(SErrNoParamsForParam,[ClassName,FN]);
+  Result:=FParams.ParamByName(FN);
+end;
+
+constructor TParamMap.Create(AParams: TParams);
+begin
+  FParams:=AParams;
+  InitParams;
+end;
+
+{ TFieldMap }
+
+constructor TFieldMap.Create(ADataset: TDataset; HookOnOpen : Boolean = False);
+begin
+  if (ADataset=Nil) then
+    Raise EFieldMap.CreateFmt(SErrNoDataset,[ClassName]);
+  FDataset:=ADataset;
+  if HookOnOpen then
+    begin
+    FOldOnOpen:=FDataset.AfterOpen;
+    FDataset.AfterOpen:=@DoOnOpen;
+    end;
+  if FDataset.Active then
+    InitFields;
+end;
+
+destructor TFieldMap.Destroy;
+begin
+  if FFreeDataset then
+    FreeAndNil(FFreeDataset);
+  inherited Destroy;
+end;
+
+procedure TFieldMap.LoadObject(AObject: TObject);
+begin
+  If (AObject=Nil) then
+    Raise EFieldMap.CreateFmt(SErrNoObjectToLoad,[ClassName]);
+end;
+
+function TFieldMap.FieldByName(FN: String): TField;
+begin
+  Result:=FDataset.FieldByName(FN)
+end;
+
+procedure TFieldMap.DoOnOpen(Sender: TDataset);
+begin
+  InitFields;
+  If Assigned(FOldOnOpen) then
+    FOldOnOpen(Sender);
+end;
+
+function TFieldMap.FindField(FN: String): TField;
+begin
+  If (FDataset=Nil) then
+    Result:=Nil
+  else
+    Result:=FDataset.FindField(FN);
+end;
+
+function TFieldMap.GetFromField(F: TField; ADefault: Integer): Integer;
+begin
+  If Assigned(F) then
+    Result:=F.AsInteger
+  else
+    Result:=ADefault;
+end;
+
+function TFieldMap.GetFromField(F: TField; ADefault: String): String;
+begin
+  If Assigned(F) then
+    Result:=F.AsString
+  else
+    Result:=ADefault;
+end;
+
+function TFieldMap.GetFromField(F: TField; ADefault: Boolean): Boolean;
+begin
+  If Assigned(F) then
+    begin
+    if (F is TStringField) then
+      Result:=(F.AsString='+')
+    else
+      Result:=F.AsBoolean
+    end
+  else
+    Result:=ADefault;
+end;
+
+function TFieldMap.GetFromField(F: TField; ADefault: TDateTime): TDateTime;
+begin
+  If Assigned(F) then
+    Result:=F.AsDateTime
+  else
+    Result:=ADefault;
+end;
+
+function TFieldMap.GetFromField(F: TField; ADefault: Currency): Currency;
+begin
+  If Assigned(F) then
+    Result:=F.AsCurrency
+  else
+    Result:=ADefault;
+end;
+
+end.
+ 

packages/fcl-db/src/codegen/buildddcg.lpi

@@ -1,17 +1,17 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <PathDelim Value="/"/>
-    <Version Value="6"/>
+    <Version Value="11"/>
     <General>
+      <Flags>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
       <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
-      <IconPath Value="./"/>
-      <TargetFileExt Value=""/>
     </General>
-    <VersionInfo>
-      <ProjectVersion Value=""/>
-    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
       <IgnoreBinaries Value="False"/>
@@ -20,58 +20,58 @@
     </PublishOptions>
     <RunParams>
       <local>
-        <FormatVersion Value="1"/>
         <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default">
+          <local>
+            <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+          </local>
+        </Mode0>
+      </Modes>
     </RunParams>
     <Units Count="7">
       <Unit0>
         <Filename Value="buildddcg.lpr"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="buildddcg"/>
       </Unit0>
       <Unit1>
         <Filename Value="fpddpopcode.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="fpddpopcode"/>
       </Unit1>
       <Unit2>
         <Filename Value="fpcgcreatedbf.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="fpcgcreatedbf"/>
       </Unit2>
       <Unit3>
         <Filename Value="fpcgdbcoll.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="fpcgdbcoll"/>
       </Unit3>
       <Unit4>
         <Filename Value="fpcgsqlconst.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="fpcgsqlconst"/>
       </Unit4>
       <Unit5>
         <Filename Value="fpcgtiopf.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="fpcgtiopf"/>
       </Unit5>
       <Unit6>
         <Filename Value="fpddcodegen.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="fpddcodegen"/>
+        <UnitName Value="FPDDCodeGen"/>
       </Unit6>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="5"/>
+    <Version Value="11"/>
     <SearchPaths>
       <UnitOutputDirectory Value="../../units/$(TARGETCPU)-$(TARGETOS)"/>
     </SearchPaths>
-    <CodeGeneration>
-      <Generate Value="Faster"/>
-    </CodeGeneration>
-    <Other>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
+    <Parsing>
+      <SyntaxOptions>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
   </CompilerOptions>
 </CONFIG>

packages/fcl-db/src/codegen/buildddcg.lpr

@@ -8,7 +8,7 @@ uses
   {$ENDIF}{$ENDIF}
   Classes
   { you can add units after this }, fpddpopcode, fpcgcreatedbf, fpcgdbcoll,
-  fpcgsqlconst, fpcgtiopf, fpddcodegen;
+  fpcgsqlconst, fpcgtiopf, fpddcodegen, fpcgfieldmap, fpcgtypesafedataset;
 
 begin
 end.

packages/fcl-db/src/codegen/fpcgdbcoll.pp

@@ -68,11 +68,10 @@ Type
   { TDDDBCollCodeGenerator }
 
   TDDDBCollCodeGenerator = Class(TDDClassCodeGenerator)
-    procedure CreateObjectAssign(Strings: TStrings;
-      const ObjectClassName: String);
   private
     function GetOpt: TDBColLOptions;
   Protected
+    procedure CreateObjectAssign(Strings: TStrings; const ObjectClassName: String); virtual;
     // Not to be overridden.
     procedure CreateFieldMapImplementation(Strings: TStrings; const ObjectClassName, MapClassName: String);
     procedure CreateListImplementation(Strings: TStrings; ListMode: TListMode;  const ObjectClassName, ListClassName: String);

packages/fcl-db/src/codegen/fpcgfieldmap.pp

@@ -0,0 +1,243 @@
+unit fpcgfieldmap;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpddcodegen;
+
+Type
+
+  { TGenFieldMapOptions }
+  TFieldMapOption = (fmoPublicFields,fmoRequireFields);
+  TFieldMapOptions = Set of TFieldMapOption;
+
+  TGenFieldMapOptions = Class(TClassCodeGeneratorOptions)
+  Private
+    FOptions: TFieldMapOptions;
+  Protected
+    function GetMapAncestorName: String; virtual;
+    function GetMapName: String; virtual;
+    procedure SetMapAncestorName(const AValue: String); virtual;
+    procedure SetMapClassName(const AValue: String); virtual;
+  Public
+    Constructor Create; override;
+    Procedure Assign(ASource: TPersistent); override;
+    Property MapAncestorName : String Read GetMapAncestorName Write SetMapAncestorName;
+    Property MapClassName : String Read GetMapName Write SetMapClassName;
+  Published
+    Property FieldMapOptions : TFieldMapOptions Read FOptions Write FOptions;
+  end;
+
+  { TDDDBFieldMapCodeGenerator }
+
+  TDDBaseFieldMapCodeGenerator = Class(TDDClassCodeGenerator)
+  private
+    function GetOpt: TGenFieldMapOptions;
+  Protected
+    // Overrides;
+    Function GetInterfaceUsesClause : string; override;
+    Function CreateOptions : TCodeGeneratorOptions; override;
+    // New methods
+    procedure DoCreateFieldMapDeclaration(Strings: TStrings; const ObjectClassName,MapClassName, MapAncestorName: String);
+    procedure WriteMapInitFields(Strings: TStrings; const ObjectClassName,   MapClassName: String); virtual;
+    procedure CreateFieldMapImplementation(Strings: TStrings; const ObjectClassName, MapClassName: String);
+    Property FieldMapOpts : TGenFieldMapOptions Read Getopt;
+  Public
+    procedure CreateFieldMapDeclaration(Strings: TStrings; const ObjectClassName,MapClassName, MapAncestorName: String);
+  end;
+
+  TDDDBFieldMapCodeGenerator = Class(TDDBaseFieldMapCodeGenerator)
+  Protected
+    Procedure DoGenerateInterface(Strings: TStrings); override;
+    Procedure DoGenerateImplementation(Strings: TStrings); override;
+  Public
+    Property FieldMapOpts;
+  end;
+
+implementation
+
+{ TDDDBFieldMapCodeGenerator }
+
+function TDDBaseFieldMapCodeGenerator.GetOpt: TGenFieldMapOptions;
+begin
+  Result:=CodeOptions as TGenFieldMapOptions;
+end;
+
+function TDDBaseFieldMapCodeGenerator.GetInterfaceUsesClause: string;
+begin
+  Result:=inherited GetInterfaceUsesClause;
+  If (Result<>'') then
+    Result:=Result+', db, fieldmap';
+end;
+
+procedure TDDDBFieldMapCodeGenerator.DoGenerateInterface(Strings: TStrings);
+begin
+  inherited DoGenerateInterface(Strings);
+  AddLn(Strings,'Type');
+  CreatefieldMapDeclaration(Strings,'',GetOpt.MapClassName,GetOpt.MapAncestorName);
+end;
+
+procedure TDDDBFieldMapCodeGenerator.DoGenerateImplementation(Strings: TStrings
+  );
+begin
+  inherited DoGenerateImplementation(Strings);
+  With FieldMapOpts do
+    CreateFieldMapImplementation(Strings,ObjectClassName,MapClassName);
+end;
+
+function TDDBaseFieldMapCodeGenerator.CreateOptions: TCodeGeneratorOptions;
+begin
+  Result:=TGenFieldMapOptions.Create;
+end;
+
+procedure TDDBaseFieldMapCodeGenerator.DoCreateFieldMapDeclaration(
+  Strings: TStrings; const ObjectClassName, MapClassName,
+  MapAncestorName: String);
+
+Var
+  I : Integer;
+  F : TFieldPropDef;
+
+begin
+  AddLn(Strings,'Private');
+  IncIndent;
+  Try
+    For I:=0 to Fields.Count-1 do
+      begin
+      F:=Fields[I];
+      If F.Enabled then
+        AddLn(Strings,'F%s : TField;',[F.PropertyName]);
+      end;
+  Finally
+    DecIndent;
+  end;
+  AddLn(Strings,'Public');
+  IncIndent;
+  Try
+    AddLn(Strings,'Procedure InitFields; Override;');
+    if fmoPublicFields in  FieldMapOpts.FieldMapOptions then
+      For I:=0 to Fields.Count-1 do
+        begin
+        F:=Fields[I];
+        If F.Enabled then
+          AddLn(Strings,'Property %s : TField read F%s;',[F.PropertyName,F.FieldName]);
+        end;
+  Finally
+    DecIndent;
+  end;
+end;
+
+procedure TDDBaseFieldMapCodeGenerator.CreateFieldMapDeclaration(Strings: TStrings; const ObjectClassName, MapClassName, MapAncestorName: String);
+begin
+  Addln(Strings);
+  IncIndent;
+  try
+    Addln(Strings,'{ %s }',[MapClassName]);
+    Addln(Strings);
+    Addln(Strings,'%s = Class(%s)',[MapClassName,MapAncestorName]);
+    DoCreateFieldMapDeclaration(Strings,ObjectClassName,MapClassName,MapAncestorName);
+    AddLn(Strings,'end;');
+  Finally
+    DecIndent;
+  end;
+end;
+
+procedure TDDBaseFieldMapCodeGenerator.CreateFieldMapImplementation(
+  Strings: TStrings; const ObjectClassName, MapClassName: String);
+
+Var
+  S : String;
+
+begin
+  AddLn(Strings,' { %s }',[MapClassName]);
+  AddLn(Strings);
+  S:=Format('Procedure %s.InitFields;',[MapClassName]);
+  BeginMethod(Strings,S);
+  Try
+    WriteMapInitFields(Strings,ObjectClassName,MapClassName);
+  Finally
+    EndMethod(Strings,S);
+  end;
+end;
+
+procedure TDDBaseFieldMapCodeGenerator.WriteMapInitFields(Strings: TStrings;
+  const ObjectClassName, MapClassName: String);
+
+Const
+  Finders : Array[Boolean] of string = ('FindField','FieldByName');
+
+Var
+  I: Integer;
+  F : TFieldPropDef;
+  Fmt : String;
+begin
+  AddLn(Strings,'begin');
+  IncIndent;
+  try
+    Fmt:='F%s:='+Finders[fmoRequireFields in FieldMapOpts.FieldMapOptions]+'(%s);';
+    For I:=0 to Fields.Count-1 Do
+      begin
+      F:=Fields[i];
+      If F.Enabled then
+        AddLn(Strings,Fmt,[F.PropertyName,CreateString(F.FieldName)]);
+      end;
+  Finally
+    DecIndent;
+  end;
+end;
+
+
+{ TGenFieldMapOptions }
+
+function TGenFieldMapOptions.GetMapAncestorName: String;
+begin
+  Result:=AncestorClass;
+end;
+
+function TGenFieldMapOptions.GetMapName: String;
+begin
+  Result:=ObjectClassName;
+end;
+
+procedure TGenFieldMapOptions.SetMapAncestorName(const AValue: String);
+begin
+  AncestorClass:=AValue;
+end;
+
+procedure TGenFieldMapOptions.SetMapClassName(const AValue: String);
+begin
+  ObjectClassName:=AValue;
+end;
+
+constructor TGenFieldMapOptions.Create;
+begin
+  inherited Create;
+  MapClassName:='TMyObjectMap';
+  MapAncestorName:='TFieldMap';
+end;
+
+procedure TGenFieldMapOptions.Assign(ASource: TPersistent);
+
+Var
+  O : TGenFieldMapOptions;
+
+begin
+  if ASource is TGenFieldMapOptions then
+    begin
+    O:=ASource as TGenFieldMapOptions;
+    MapClassName:=O.MapClassName;
+    MapAncestorName:=O.MapAncestorName;
+    Options:=O.Options;
+    end;
+  inherited Assign(ASource);
+end;
+
+Initialization
+  RegisterCodeGenerator('FieldMap','TFieldMap descendent.',TDDDBFieldMapCodeGenerator);
+
+Finalization
+  UnRegisterCodeGenerator(TDDDBFieldMapCodeGenerator);
+end.
+

packages/fcl-db/src/codegen/fpcgtypesafedataset.pp

@@ -0,0 +1,968 @@
+unit fpcgtypesafedataset;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, db, fpddcodegen,fpDataDict, fpcgfieldmap;
+
+Const
+  SNonInterfacedParentClass = 'TTypeSafeDatasetAccess';
+  SInterfacedParentClass = 'TInterfacedTypeSafeDatasetAccess';
+
+Type
+  TTypeSafeDatasetOption = (tsdInterfaced,       // Create easy access interface
+                            tsdFieldMapPublic,   // Create publicly accessible fieldmap object
+                            tsdIsNullProperty,   // Create *IsNull property for each property
+                            tsdFieldNameConsts,  // Define fieldnames.
+                            tsdGetQuery,         // Create GetQuery() calls
+                            tsdSQLPublic         // Create SQL statement as constant in interface.
+                            );
+  TTypeSafeDatasetOptions = set of TTypeSafeDatasetOption;
+
+  { TGenTypeSafeDatasetOptions }
+
+  TGenTypeSafeDatasetOptions = class(TGenFieldMapOptions)
+  private
+    FConnectionClass: String;
+    FFieldNameConstPrefix: String;
+    FMapAncestorName,
+    FMapName,
+    FInterfaceGUID,
+    FInterfaceName: String;
+    FMemoryStreamClass: String;
+    FQueryClass: String;
+    FTransactionClass: String;
+    FTypeSafeAccesOptions: TTypeSafeDatasetOptions;
+    function GetConnectionClass: String;
+    function GetFieldNameConstPrefix: String;
+    function GetInterfaceGUID: String;
+    function GetInterfaceName: String;
+    function GetQueryClass: String;
+    function GetTransactionClass: String;
+    procedure SetInterfaceGUID(AValue: String);
+    procedure SetInterfaceName(AValue: String);
+    procedure SetTypeSafeAccesOptions(AValue: TTypeSafeDatasetOptions);
+  Protected
+    function GetMapAncestorName: String; override;
+    function GetMapName: String; override;
+    procedure SetMapAncestorName(const AValue: String); override;
+    procedure SetMapClassName(const AValue: String); override;
+  Public
+    Constructor Create; override;
+    Procedure Assign(Source : TPersistent); override;
+  Published
+    Property TypeSafeAccesOptions : TTypeSafeDatasetOptions Read FTypeSafeAccesOptions Write SetTypeSafeAccesOptions;
+    Property InterfaceName : String Read GetInterfaceName Write SetInterfaceName;
+    Property InterfaceGUID : String Read GetInterfaceGUID Write SetInterfaceGUID;
+    Property MemoryStreamClass : String Read FMemoryStreamClass Write FMemoryStreamClass;
+    Property FieldNameConstPrefix : String Read GetFieldNameConstPrefix Write FFieldNameConstPrefix;
+    Property ConnectionClass : String Read GetConnectionClass Write FConnectionClass;
+    Property TransactionClass : String Read GetTransactionClass Write FTransactionClass;
+    Property QueryClass : String Read GetQueryClass Write FQueryClass;
+  end;
+
+  { TTSAFieldPropDef }
+
+  TTSAFieldPropDef = Class (TFieldPropDef)
+  Protected
+    Procedure InitFromField(F : TField); override;
+    Procedure InitFromDDFieldDef(F : TDDFieldDef);override;
+    procedure SetFieldType(AValue: TFieldType); override;
+  Public
+    Constructor Create(ACollection: TCollection); override;
+    function FieldIsNullGetterName: String;
+    function FieldIsNullSetterName: String;
+    function FieldIsNullPropertyName: String;
+  end;
+
+  { TDDTypeSafeDatasetCodeGenerator }
+
+  TDDTypeSafeDatasetCodeGenerator = class(TDDBaseFieldMapCodeGenerator)
+  private
+    FMySQL : TStringList;
+    function GetSafeOpts: TGenTypeSafeDatasetOptions;virtual;
+    function GetTSAFieldPropDefs(aIndex : Integer): TTSAFieldPropDef;
+  Protected
+    function GetSQL: TStrings; override;
+    procedure SetSQL(const AValue: TStrings); override;
+    procedure CreateApplyUpdatesImplementation(Strings: TStrings); virtual;
+    procedure CreateGetQueryImplementation(Strings: TStrings; ASQLArgument: Boolean);virtual;
+    procedure CreateCreateQueryImplementation(Strings: TStrings; ASQLArgument: Boolean); virtual;
+    procedure CreateSQLConst(Strings: TStrings; Full : Boolean);virtual;
+    function CreateQueryDeclaration(aFull : Boolean; ASQLArgument: Boolean): String;virtual;
+    function GetQueryDeclaration(aFull : Boolean; ASQLArgument: Boolean): String;virtual;
+    function NeedConstSection: Boolean; virtual;
+    procedure WriteConstSection(Strings: TStrings); virtual;
+    function MyMapExpr: String;
+    Function GetClassInterfaces: String; override;
+    Function GetInterfaceUsesClause : string; override;
+    procedure CreateTypeSafeInterfaceDeclaration(Strings: TStrings; const aInterfaceName, aInterfaceGUID: String);virtual;
+    function GetFieldAccessor(F: TFieldPropDef): String;
+    procedure GenerateFieldMapClass(Strings: TStrings); virtual;
+    procedure GenerateMyMap(Strings: TStrings); virtual;
+    procedure WriteBlobChangeEvent(Strings: TStrings; F: TFieldPropDef); virtual;
+    procedure WritePropertyIsNullGetter(Strings: TStrings; F: TFieldPropDef);virtual;
+    procedure WritePropertyIsNullSetter(Strings: TStrings; F: TFieldPropDef);virtual;
+    Function NeedsConstructor : Boolean; override;
+    Function NeedsDestructor : Boolean; override;
+    procedure WritePropertyDeclaration(Strings: TStrings; F: TFieldPropDef); override;
+    procedure WriteVisibilityStart(V: TVisibility; Strings: TStrings); override;
+    procedure WriteVisibilityEnd(V: TVisibility; Strings: TStrings); override;
+    procedure WriteFieldCreate(Strings: TStrings; F: TFieldPropDef); override;
+    procedure WriteFieldDestroy(Strings: TStrings; F: TFieldPropDef); override;
+    Function CreateFieldPropDefs : TFieldPropDefs; override;
+    Function CreateOptions : TCodeGeneratorOptions; override;
+    procedure WritePropertyGetterImpl(Strings: TStrings; F: TFieldPropDef); override;
+    procedure WritePropertySetterImpl(Strings: TStrings; F: TFieldPropDef); override;
+    procedure WritePrivateFields(Strings: TStrings); override;
+    procedure DoBeforeTypeSection(Strings: TStrings); override;
+    procedure DoBeforeClassDeclaration(Strings: TStrings); override;
+    procedure DoAfterClassImplementation(Strings: TStrings); override;
+    procedure DoBeforeClassImplementation(Strings: TStrings); override;
+    Procedure DoAfterDestructor(Strings: TStrings); override;
+    Property TSAFieldPropDefs[aIndex : Integer] : TTSAFieldPropDef read GetTSAFieldPropDefs;
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+    Class Function NeedsSQL: Boolean; override;
+    Property SafeOpts : TGenTypeSafeDatasetOptions Read GetSafeOpts;
+  end;
+
+implementation
+
+{ TTSAFieldPropDef }
+
+procedure TTSAFieldPropDef.InitFromField(F: TField);
+begin
+  inherited InitFromField(F);
+  If FieldType in ftBlobTypes then
+    PropertyAccess:=paReadonly;
+end;
+
+procedure TTSAFieldPropDef.InitFromDDFieldDef(F: TDDFieldDef);
+begin
+  inherited InitFromDDFieldDef(F);
+  If FieldType in ftBlobTypes then
+    PropertyAccess:=paReadonly;
+end;
+
+procedure TTSAFieldPropDef.SetFieldType(AValue: TFieldType);
+begin
+  inherited SetFieldType(AValue);
+  If FieldType in ftBlobTypes then
+    PropertyAccess:=paReadonly;
+end;
+
+constructor TTSAFieldPropDef.Create(ACollection: TCollection);
+begin
+  inherited Create(ACollection);
+  PropertyAccess:=paReadWrite;
+  PropSetters:=[psRead,psWrite];
+end;
+
+function TTSAFieldPropDef.FieldIsNullGetterName: String;
+begin
+  Result:='Get'+PropertyName+'IsNull';
+end;
+
+function TTSAFieldPropDef.FieldIsNullSetterName: String;
+begin
+  Result:='Set'+PropertyName+'IsNull';
+end;
+
+function TTSAFieldPropDef.FieldIsNullPropertyName: String;
+begin
+  Result:=PropertyName+'IsNull';
+end;
+
+{ TDDTypeSafeDatasetCodeGenerator }
+
+function TDDTypeSafeDatasetCodeGenerator.GetSafeOpts: TGenTypeSafeDatasetOptions;
+begin
+  Result:=CodeOptions as TGenTypeSafeDatasetOptions;
+end;
+
+function TDDTypeSafeDatasetCodeGenerator.GetTSAFieldPropDefs(aIndex : Integer
+  ): TTSAFieldPropDef;
+begin
+  Result:=Fields[aIndex] as TTSAFieldPropDef;
+end;
+
+function TDDTypeSafeDatasetCodeGenerator.GetSQL: TStrings;
+begin
+  Result:=FMySQL;
+end;
+
+procedure TDDTypeSafeDatasetCodeGenerator.SetSQL(const AValue: TStrings);
+begin
+  if (AValue=FMySQL) then exit;
+  FMySQL.Assign(aValue);
+end;
+
+function TDDTypeSafeDatasetCodeGenerator.NeedsDestructor: Boolean;
+begin
+  Result:=True;
+end;
+
+procedure TDDTypeSafeDatasetCodeGenerator.WritePropertyDeclaration(Strings: TStrings; F: TFieldPropDef);
+begin
+  inherited WritePropertyDeclaration(Strings, F);
+  if tsdIsNullProperty in SafeOpts.TypeSafeAccesOptions then
+    With F as TTSAFieldPropDef do
+      AddLn(Strings,'Property %s : Boolean Read %s Write %s;',[FieldIsNullPropertyName,FieldIsNullGetterName,FieldIsNullSetterName]);
+end;
+
+function TDDTypeSafeDatasetCodeGenerator.MyMapExpr: String;
+
+begin
+  if tsdFieldMapPublic in SafeOpts.TypeSafeAccesOptions then
+    Result:='MyMap'
+  else
+    Result:=SafeOpts.MapClassName+'(FieldMap)';
+end;
+
+function TDDTypeSafeDatasetCodeGenerator.GetClassInterfaces: String;
+begin
+  Result:=inherited GetClassInterfaces;
+  if tsdInterfaced in SafeOpts.TypeSafeAccesOptions then
+    begin
+    if (Result<>'') then
+      Result:=Result+',';
+    Result:=Result+SafeOpts.InterfaceName;
+    end;
+end;
+
+function TDDTypeSafeDatasetCodeGenerator.GetInterfaceUsesClause: string;
+begin
+  Result:=inherited GetInterfaceUsesClause;
+  if tsdGetQuery in SafeOpts.TypeSafeAccesOptions then
+    Result:=Result+', sqldb';
+end;
+
+procedure TDDTypeSafeDatasetCodeGenerator.WriteVisibilityStart(V: TVisibility;
+  Strings: TStrings);
+begin
+  Inherited;
+  If (V=vProtected) then
+    begin
+    AddLn(Strings,'Class Function FieldMapClass : TFieldMapClass; override;');
+    if tsdFieldMapPublic in SafeOpts.TypeSafeAccesOptions then
+      AddLn(Strings,'Function MyMap : %s; inline;',[SafeOpts.MapClassName]);
+    end;
+end;
+
+procedure TDDTypeSafeDatasetCodeGenerator.WriteVisibilityEnd(V: TVisibility;
+  Strings: TStrings);
+begin
+  inherited WriteVisibilityEnd(V, Strings);
+  if (v=vPublic) and (tsdGetQuery in SafeOpts.TypeSafeAccesOptions) then
+    begin
+    AddLn(Strings,'Procedure ApplyUpdates; override;');
+    AddLn(Strings,CreateQueryDeclaration(False,True));
+    AddLn(Strings,CreateQueryDeclaration(False,False));
+    If (tsdInterfaced in SafeOpts.TypeSafeAccesOptions) then
+      begin
+      AddLn(Strings,GetQueryDeclaration(False,True));
+      AddLn(Strings,GetQueryDeclaration(False,False));
+      end;
+    end;
+end;
+
+procedure TDDTypeSafeDatasetCodeGenerator.WriteFieldCreate(Strings: TStrings;
+  F: TFieldPropDef);
+begin
+  // Do nothing
+  Assert(TObject(Strings)<>TObject(F),'Just avoiding compiler warning here');
+end;
+
+procedure TDDTypeSafeDatasetCodeGenerator.WriteFieldDestroy(Strings: TStrings;
+  F: TFieldPropDef);
+begin
+  if F.FieldType in ftBlobTypes then
+    Addln(Strings, 'FreeAndNil(FBlob%s);',[F.PropertyName])
+end;
+
+function TDDTypeSafeDatasetCodeGenerator.GetFieldAccessor(F: TFieldPropDef
+  ): String;
+
+begin
+  Case F.PropertyType of
+    ptDouble : Result:='AsFLoat';
+    ptByte : Result:='AsInteger';
+    ptShortInt : Result:='AsInteger';
+    ptInt64 : Result:='AsLargeInt';
+    ptWord : Result:='AsInteger';
+    ptSmallInt : Result:='AsInteger';
+    ptLongint : Result:='AsInteger';
+    ptCardinal : Result:='AsInteger';
+    ptQWord : Result:='AsLargeInt';
+    ptDateTime : Result:='AsDateTime';
+  else
+    Result:='As'+PropTypeNames[F.PropertyType];
+  end;
+end;
+
+procedure TDDTypeSafeDatasetCodeGenerator.WriteBlobChangeEvent(Strings: TStrings; F: TFieldPropDef);
+
+Var
+  S : String;
+begin
+  S:=Format('Procedure %s.Do%sChanged(Sender : TObject);',[SafeOpts.ObjectClassName, F.PropertyName]);
+  BeginMethod(Strings,S);
+  AddLn(Strings,'begin');
+  IncIndent;
+  AddLn(Strings,'If Dataset.State in dsEditModes then');
+  IncIndent;
+  AddLn(Strings,'TBlobField(%s.%s).LoadFromStream(TStream(Sender));',[MyMapExpr,F.FieldName,F.PropertyName]);
+  DecIndent;
+  DecIndent;
+  EndMethod(Strings,S);
+end;
+
+function TDDTypeSafeDatasetCodeGenerator.NeedsConstructor: Boolean;
+begin
+  Result:=False;
+end;
+
+procedure TDDTypeSafeDatasetCodeGenerator.WritePropertyGetterImpl(
+  Strings: TStrings; F: TFieldPropDef);
+
+Var
+  S : String;
+
+begin
+  If (F.FieldType in ftBlobTypes) then
+    WriteBlobChangeEvent(Strings,F);
+  S:=PropertyGetterDeclaration(F,True);
+  BeginMethod(Strings,S);
+  AddLn(Strings,'begin');
+  IncIndent;
+  If not (F.FieldType in ftBlobTypes) then
+    AddLn(Strings,'Result:=%s.%s.%s;',[MyMapExpr,F.FieldName,GetFieldAccessor(F)])
+  else
+    begin
+    AddLn(Strings,'if not Assigned(FBlob%s) then',[F.PropertyName]);
+    IncIndent;
+    AddLn(Strings,'begin');
+    AddLn(Strings,'FBlob%s:=%s.Create;',[F.PropertyName,SafeOpts.MemoryStreamClass]);
+    AddLn(Strings,'FBlob%s.OnChange:=@Do%sChanged;',[F.PropertyName,F.PropertyName]);
+    AddLn(Strings,'end;');
+    DecIndent;
+    AddLn(Strings,'FBlob%s.Size:=0;',[F.PropertyName]);
+    AddLn(Strings,'FBlob%s.Position:=0;',[F.PropertyName]);
+    AddLn(Strings,'if not FBlob%s.Updating then',[F.PropertyName]);
+    IncIndent;
+    AddLn(Strings,'begin');
+    AddLn(Strings,'TBlobField(%s.%s).SaveToStream(FBlob%s);',[MyMapExpr,F.FieldName,F.PropertyName]);
+    AddLn(Strings,'FBlob%s.Position:=0;',[F.PropertyName]);
+    AddLn(Strings,'end;');
+    DecIndent;
+    AddLn(Strings,'Result:=FBlob%s;',[F.PropertyName]);
+    end;
+  DecIndent;
+  EndMethod(Strings,S);
+  if tsdIsNullProperty in SafeOpts.TypeSafeAccesOptions then
+    begin
+    WritePropertyIsNullGetter(Strings,F);
+    // We do it here, because for blob fields, WritePropertySetterImpl is not called.
+    WritePropertyIsNullSetter(Strings,F);
+    end;
+end;
+
+procedure TDDTypeSafeDatasetCodeGenerator.WritePropertyIsNullGetter(Strings : TStrings; F : TFieldPropDef);
+
+Var
+  S : String;
+
+begin
+  S:=Format('Function %s.Get%sIsNull: boolean;',[SafeOpts.ObjectClassName, F.PropertyName]);
+  BeginMethod(Strings,S);
+  AddLn(Strings,'begin');
+  incIndent;
+  AddLn(Strings,'Result:=%s.%s.IsNull;',[MyMapExpr,F.FieldName]);
+  DecIndent;
+  EndMethod(Strings,S);
+end;
+
+procedure TDDTypeSafeDatasetCodeGenerator.WritePropertySetterImpl(
+  Strings: TStrings; F: TFieldPropDef);
+
+Var
+  S : String;
+
+begin
+  S:=PropertySetterDeclaration(F,True);
+  BeginMethod(Strings,S);
+  AddLn(Strings,'begin');
+  incIndent;
+  If not (F.FieldType in ftBlobTypes) then
+    AddLn(Strings,'%s.%s.%s:=aValue;',[MyMapExpr,F.FieldName,GetFieldAccessor(F)]);
+  DecIndent;
+  EndMethod(Strings,S);
+end;
+
+procedure TDDTypeSafeDatasetCodeGenerator.WritePropertyIsNullSetter(Strings : TStrings; F : TFieldPropDef);
+
+Var
+  S : String;
+
+begin
+  S:=Format('Procedure %s.Set%sIsNull(aValue : boolean);',[Safeopts.ObjectClassName, F.PropertyName]);
+  BeginMethod(Strings,S);
+  AddLn(Strings,'begin');
+  IncIndent;
+  AddLn(Strings,'If aValue then ');
+  IncIndent;
+  AddLn(Strings,'%s.%s.Clear;',[MyMapExpr,F.FieldName]);
+  DecIndent;
+  DecIndent;
+  EndMethod(Strings,S);
+end;
+
+
+
+procedure TDDTypeSafeDatasetCodeGenerator.WritePrivateFields(Strings: TStrings);
+
+Var
+  I : Integer;
+  F : TTSAFieldPropDef;
+
+begin
+  IncIndent;
+//  AddLn(Strings,'FMap : %s;',[SafeOpts.MapClassName]);
+  For I:=0 to Fields.Count-1 do
+    begin
+    F:=TSAFieldPropDefs[I];
+    if F.FieldType in ftBlobTypes then
+      AddLn(Strings,'FBlob%s : %s;',[F.PropertyName,SafeOpts.MemoryStreamClass]);
+    end;
+  // Change handlers for blobfields
+  For I:=0 to Fields.Count-1 do
+    begin
+    F:=TSAFieldPropDefs[I];
+    if F.FieldType in ftBlobTypes then
+      AddLn(Strings,'Procedure Do%sChanged(Sender : TObject);',[F.PropertyName]);
+    end;
+  // Getters/Setters for IsNull
+  if (tsdIsNullProperty in SafeOpts.TypeSafeAccesOptions) then
+    For I:=0 to Fields.Count-1 do
+      begin
+      F:=TSAFieldPropDefs[I];
+      AddLn(Strings,'Function %s : Boolean;',[F.FieldIsNullGetterName]);
+      AddLn(Strings,'Procedure %s (aValue : Boolean);',[F.FieldIsNullSetterName]);
+      end;
+  DecIndent;
+end;
+
+procedure TDDTypeSafeDatasetCodeGenerator.WriteConstSection(Strings: TStrings);
+
+Const
+  OptsWriteSQL = [tsdGetQuery,tsdSQLPublic];
+
+Var
+  Pre : String;
+  I : integer;
+
+begin
+  AddLn(Strings,'Const');
+  IncIndent;
+  if (tsdInterfaced in SafeOpts.TypeSafeAccesOptions) then
+    AddLn(Strings,'IID_%s = ''%s'';',[SafeOpts.CleanObjectClassName,SafeOpts.InterfaceGUID]);
+  AddLn(Strings);
+  if (tsdFieldNameConsts in SafeOpts.TypeSafeAccesOptions) then
+    begin
+    AddLn(Strings,'// Field names');
+    Pre:=SafeOpts.FieldNameConstPrefix;
+    For I:=0 to Fields.Count-1 do
+      if Fields[i].Enabled then
+        AddLn(Strings,'%s = ''%s'';',[Pre+MakeIdentifier(Fields[i].FieldName),Fields[i].FieldName]);
+    AddLn(Strings);
+    end;
+  if OptsWriteSQL * SafeOpts.TypeSafeAccesOptions = OptsWriteSQL then
+    CreateSQLConst(Strings,False);
+  DecIndent;
+  AddLn(Strings);
+end;
+
+function TDDTypeSafeDatasetCodeGenerator.NeedConstSection: Boolean;
+
+
+begin
+  Result:=([tsdInterfaced,tsdFieldNameConsts,tsdSQLPublic] * SafeOpts.TypeSafeAccesOptions)<>[];
+end;
+
+procedure TDDTypeSafeDatasetCodeGenerator.DoBeforeTypeSection(Strings: TStrings);
+
+begin
+  inherited DoBeforeTypeSection(Strings);
+  If NeedConstSection then
+    WriteConstSection(Strings);
+end;
+
+function TDDTypeSafeDatasetCodeGenerator.CreateFieldPropDefs: TFieldPropDefs;
+begin
+  Result:=TFieldPropDefs.Create(TTSAFieldPropDef);
+end;
+
+
+function TDDTypeSafeDatasetCodeGenerator.CreateOptions: TCodeGeneratorOptions;
+begin
+  Result:=TGenTypeSafeDatasetOptions.Create;
+end;
+
+procedure TDDTypeSafeDatasetCodeGenerator.DoBeforeClassDeclaration(Strings: TStrings);
+
+begin
+  DecIndent;
+  AddLn(Strings,'{$INLINE ON}');
+  IncIndent;
+  With SafeOpts do
+    begin
+    if (tsdFieldMapPublic in TypeSafeAccesOptions) then
+      begin
+      DecIndent;
+      CreatefieldMapDeclaration(Strings,'',MapClassName,MapAncestorName);
+      IncIndent;
+      end;
+    if (tsdInterfaced in TypeSafeAccesOptions) then
+      CreateTypeSafeInterfaceDeclaration(Strings,InterfaceName,InterfaceGUID);
+    end;
+//  CreateDeclaration(Strings);
+end;
+
+
+procedure TDDTypeSafeDatasetCodeGenerator.CreateTypeSafeInterfaceDeclaration(
+  Strings: TStrings; const aInterfaceName, aInterfaceGUID: String);
+
+Var
+  I : Integer;
+  F : TTSAFieldPropDef;
+
+begin
+  Addln(Strings);
+  Addln(Strings, '{ %s }',[aInterfaceName]);
+  Addln(Strings);
+  AddLn(Strings,'%s = Interface(ITypeSafeDatasetAccess) [IID_%s]',[aInterfaceName,SafeOpts.CleanObjectClassName]);
+  IncIndent;
+  // Getter/Setter
+  for I:=0 to Fields.Count-1 do
+    begin
+    F:=TSAFieldPropDefs[i];
+    if F.Enabled then
+      begin
+      AddLn(Strings,'Function %s : %s;',[F.ObjPasReadDef,PropTypeNames[F.PropertyType]]);
+      if not (F.FieldType in ftBlobTypes) then
+        AddLn(Strings,'Procedure %s (aValue : %s);',[F.ObjPasWriteDef,PropTypeNames[F.PropertyType]]);
+      if tsdIsNullProperty in SafeOpts.TypeSafeAccesOptions then
+        begin
+        AddLn(Strings,'Function %s : Boolean;',[F.FieldIsNullGetterName]);
+        AddLn(Strings,'Procedure %s (aValue : Boolean);',[F.FieldIsNullSetterName]);
+        end;
+      end;
+    end;
+  // Property
+  for I:=0 to Fields.Count-1 do
+    begin
+    F:=TSAFieldPropDefs[i];
+    if F.Enabled then
+      begin
+      AddLn(Strings,PropertyDeclaration(Strings,F)+';');
+      if tsdIsNullProperty in SafeOpts.TypeSafeAccesOptions then
+        AddLn(Strings,'Property %s : Boolean Read %s Write F%;',[F.FieldIsNullPropertyName,F.FieldIsNullGetterName,F.FieldIsNullSetterName]);
+      end;
+    end;
+  DecIndent;
+  AddLn(Strings,'end;');
+end;
+
+procedure TDDTypeSafeDatasetCodeGenerator.GenerateFieldMapClass(
+  Strings: TStrings);
+
+Var
+  S : String;
+
+begin
+  S:=Format('Class Function %s.FieldMapClass : TFieldMapClass;',[SafeOpts.ObjectClassName]);
+  BeginMethod(Strings,S);
+  AddLn(Strings,'begin');
+  incIndent;
+  AddLn(Strings,'Result:=%s;',[Safeopts.MapClassName]);
+  DecIndent;
+  EndMethod(Strings,S);
+end;
+
+procedure TDDTypeSafeDatasetCodeGenerator.GenerateMyMap(
+  Strings: TStrings);
+
+Var
+  S : String;
+
+begin
+  S:=Format('Function %s.MyMap : %s;',[SafeOpts.ObjectClassName,SafeOpts.MapClassName]);
+  BeginMethod(Strings,S);
+  AddLn(Strings,'begin');
+  incIndent;
+  AddLn(Strings,'Result:=%s(FieldMap);',[Safeopts.MapClassName]);
+  DecIndent;
+  EndMethod(Strings,S);
+end;
+
+procedure TDDTypeSafeDatasetCodeGenerator.DoAfterClassImplementation(
+  Strings: TStrings);
+begin
+  inherited;
+  GenerateFieldMapClass(Strings);
+  With SafeOpts do
+    CreateFieldMapImplementation(Strings,ObjectClassName,MapClassName);
+  if tsdGetQuery in SafeOpts.TypeSafeAccesOptions then
+    begin
+    if not (tsdSQLPublic in SafeOpts.TypeSafeAccesOptions) then
+      CreateSQLConst(Strings,True);
+    CreateCreateQueryImplementation(Strings,False);
+    CreateCreateQueryImplementation(Strings,True);
+    If (tsdInterfaced in SafeOpts.TypeSafeAccesOptions) then
+      begin
+      CreateGetQueryImplementation(Strings,False);
+      CreateGetQueryImplementation(Strings,True);
+      end;
+    CreateApplyUpdatesImplementation(Strings);
+    end;
+end;
+
+Procedure TDDTypeSafeDatasetCodeGenerator.CreateApplyUpdatesImplementation(Strings: TStrings);
+
+Var
+  S : String;
+
+begin
+  S:=Format('Procedure %s.ApplyUpdates;',[SafeOpts.ObjectClassName]);
+  BeginMethod(Strings,S);
+  Addln(Strings);
+  Addln(Strings,'begin');
+  IncIndent;
+  AddLn(Strings,'If Dataset is TSQLQuery then');
+  IncIndent;
+  AddLn(Strings,'(Dataset as TSQLQuery).ApplyUpdates;');
+  DecIndent;
+  DecIndent;
+  EndMethod(Strings,S);
+end;
+
+function TDDTypeSafeDatasetCodeGenerator.CreateQueryDeclaration(aFull : Boolean; ASQLArgument: Boolean): String;
+
+Var
+  S : String;
+begin
+  if Not aSQLArgument then
+    S:='CreateQuery(aConnection : %s; aTransaction : %s) : %s;'
+  else
+    S:='CreateQuery(aSQL : String; aConnection : %s; aTransaction : %s) : %s;';
+  With SafeOpts do
+    S:=Format(S,[ConnectionClass,TransactionClass,ObjectClassName]);
+  if AFull then
+    S:=SafeOpts.ObjectClassName+'.'+S
+  else
+    S:=S+' overload;';
+  Result:='Class Function '+S;
+end;
+
+function TDDTypeSafeDatasetCodeGenerator.GetQueryDeclaration(aFull : Boolean; ASQLArgument: Boolean): String;
+
+Var
+  S : String;
+begin
+  if Not aSQLArgument then
+    S:='GetQuery(aConnection : %s; aTransaction : %s) : %s;'
+  else
+    S:='GetQuery(aSQL : String; aConnection : %s; aTransaction : %s) : %s;';
+  With SafeOpts do
+    S:=Format(S,[ConnectionClass,TransactionClass,InterfaceName]);
+  if AFull then
+    S:=SafeOpts.ObjectClassName+'.'+S
+  else
+    S:=S+' overload;';
+  Result:='Class Function '+S;
+end;
+
+procedure TDDTypeSafeDatasetCodeGenerator.CreateSQLConst(Strings : TStrings; Full : Boolean);
+
+Var
+  I : Integer;
+  L : String;
+
+begin
+  if Full then
+    begin
+    AddLn(Strings,'Const');
+    IncIndent;
+    end;
+  AddLn(Strings,'SQL%s = ',[SafeOpts.CleanObjectClassName]);
+  IncIndent;
+  if Not (Assigned(SQL) and (SQL.Count>0)) then
+    AddLn(Strings,''''';')
+  else
+    For I:=0 to SQL.Count-1 do
+      begin
+      L:=CreatePascalString(SQL[I],True);
+      if I<SQL.Count-1 then
+        L:=L+' + sLineBreak +'
+      else
+        L:=L+';';
+      Addln(Strings,L);
+      end;
+  DecIndent;
+  if Full then
+    DecIndent;
+  Addln(Strings);
+end;
+
+procedure TDDTypeSafeDatasetCodeGenerator.CreateCreateQueryImplementation(
+  Strings: TStrings; ASQLArgument: Boolean);
+
+Var
+  S : String;
+
+begin
+  S:=CreateQueryDeclaration(True,aSQLArgument);
+  BeginMethod(Strings,S);
+  if aSQLArgument then
+    begin
+    AddLn(Strings,'Var');
+    IncIndent;
+    AddLn(Strings,'Q : %s;',[SafeOpts.QueryClass]);
+    AddLn(Strings,'MySQL : String;');
+    DecIndent;
+    end;
+  AddLn(Strings,'begin');
+  IncIndent;
+  if Not aSQLArgument then
+     Addln(Strings,'Result:=CreateQuery(SQL%s,aConnection,aTransaction);',[SafeOpts.CleanObjectClassName])
+  else
+    begin
+    AddLn(Strings,'If aSQL='''' then');
+    IncIndent;
+    AddLn(Strings,'MySQL:=SQL%s ',[SafeOpts.CleanObjectClassName]);
+    DecIndent;
+    AddLn(Strings,'else');
+    IncIndent;
+    AddLn(Strings,'MySQL:=aSQL;');
+    DecIndent;
+    AddLn(Strings,'Q:=%s.Create(aConnection);',[SafeOpts.QueryClass]);
+    AddLn(Strings,'If aTransaction<>Nil then');
+    IncIndent;
+    AddLn(Strings,'Q.Transaction:=aTransaction;');
+    DecIndent;
+    AddLn(Strings,'Q.Database:=aConnection;');
+    AddLn(Strings,'Q.SQL.Text:=MySQL;');
+    AddLn(Strings,'Result:=%s.Create(Q,True);',[SafeOpts.ObjectClassName]);
+    end;
+  DecIndent;
+  EndMethod(Strings,S);
+end;
+
+procedure TDDTypeSafeDatasetCodeGenerator.CreateGetQueryImplementation(
+  Strings: TStrings; ASQLArgument: Boolean);
+
+Var
+  S : String;
+
+begin
+  S:=GetQueryDeclaration(True,aSQLArgument);
+  BeginMethod(Strings,S);
+  AddLn(Strings,'begin');
+  IncIndent;
+  if Not aSQLArgument then
+     Addln(Strings,'Result:=CreateQuery(aConnection,aTransaction);',[SafeOpts.CleanObjectClassName])
+  else
+     Addln(Strings,'Result:=CreateQuery(aSQL,aConnection,aTransaction);',[SafeOpts.CleanObjectClassName]);
+  DecIndent;
+  EndMethod(Strings,S);
+end;
+
+procedure TDDTypeSafeDatasetCodeGenerator.DoBeforeClassImplementation(
+  Strings: TStrings);
+begin
+  inherited DoBeforeClassImplementation(Strings);
+  With SafeOpts do
+    if Not (tsdFieldMapPublic in TypeSafeAccesOptions) then
+      begin
+      AddLn(Strings,'Type');
+      CreatefieldMapDeclaration(Strings,'',MapClassName,MapAncestorName);
+      end;
+end;
+
+procedure TDDTypeSafeDatasetCodeGenerator.DoAfterDestructor(Strings: TStrings);
+begin
+  inherited DoAfterDestructor(Strings);
+  if tsdFieldMapPublic in SafeOpts.TypeSafeAccesOptions then
+    GenerateMyMap(Strings);
+end;
+
+constructor TDDTypeSafeDatasetCodeGenerator.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FMySQL:=TStringlist.Create;
+end;
+
+destructor TDDTypeSafeDatasetCodeGenerator.Destroy;
+begin
+  FreeAndNil(FMySQL);
+  inherited Destroy;
+end;
+
+class function TDDTypeSafeDatasetCodeGenerator.NeedsSQL: Boolean;
+begin
+  Result:=True;
+end;
+
+{ TGenTypeSafeDatasetOptions }
+
+function TGenTypeSafeDatasetOptions.GetInterfaceName: String;
+begin
+  Result:=FInterfaceName;
+  If Result='' then
+    Result:='I'+CleanObjectClassName;
+end;
+
+function TGenTypeSafeDatasetOptions.GetQueryClass: String;
+begin
+  Result:=FQueryClass;
+  if Result='' then
+    Result:='TSQLQuery';
+end;
+
+function TGenTypeSafeDatasetOptions.GetTransactionClass: String;
+begin
+  Result:=FConnectionClass;
+  if Result='' then
+    Result:='TSQLTransaction';
+end;
+
+function TGenTypeSafeDatasetOptions.GetInterfaceGUID: String;
+
+Var
+  G : TGUID;
+
+begin
+  if FInterfaceGUID='' then
+    begin
+    CreateGUID(G);
+    FInterfaceGUID:=GUIDToString(G);
+    end;
+  Result:=FInterfaceGUID;
+end;
+
+function TGenTypeSafeDatasetOptions.GetFieldNameConstPrefix: String;
+begin
+  Result:=FFieldNameConstPrefix;
+  if (Result='') then
+    Result:='FLD_'+CleanObjectClassName+'_';
+end;
+
+function TGenTypeSafeDatasetOptions.GetConnectionClass: String;
+begin
+  Result:=FConnectionClass;
+  if Result='' then
+    Result:='TSQLConnection';
+end;
+
+procedure TGenTypeSafeDatasetOptions.SetInterfaceGUID(AValue: String);
+
+Var
+  G : TGUID;
+
+begin
+  G:=StringToGUID(AValue);
+  FInterfaceGUID:=GUIDToString(G);
+end;
+
+procedure TGenTypeSafeDatasetOptions.SetInterfaceName(AValue: String);
+begin
+  CheckIdentifier(AValue,True);
+  FInterfaceName:=AValue;
+end;
+
+procedure TGenTypeSafeDatasetOptions.SetTypeSafeAccesOptions(
+  AValue: TTypeSafeDatasetOptions);
+begin
+  if FTypeSafeAccesOptions=AValue then Exit;
+  FTypeSafeAccesOptions:=AValue;
+  if (tsdInterfaced in TypeSafeAccesOptions) then
+    begin
+    if (AncestorClass=SNonInterfacedParentClass) then
+      AncestorClass:=SNonInterfacedParentClass;
+    end
+  else
+    begin
+    if (AncestorClass=SInterfacedParentClass) then
+      AncestorClass:=SNonInterfacedParentClass;
+    end
+end;
+
+
+function TGenTypeSafeDatasetOptions.GetMapAncestorName: String;
+begin
+  Result:=FMapAncestorName;
+end;
+
+function TGenTypeSafeDatasetOptions.GetMapName: String;
+begin
+  Result:=FMapName;
+  if Result='' then
+    Result:=ObjectClassName+'Map';
+end;
+
+procedure TGenTypeSafeDatasetOptions.SetMapAncestorName(const AValue: String);
+begin
+  CheckIdentifier(aValue,False);
+  FMapAncestorName:=AValue;
+end;
+
+procedure TGenTypeSafeDatasetOptions.SetMapClassName(const AValue: String);
+begin
+  CheckIdentifier(aValue,False);
+  FMapName:=AValue;
+end;
+
+
+constructor TGenTypeSafeDatasetOptions.Create;
+Var
+  G : TGUID;
+begin
+  inherited Create;
+  AncestorClass:=SNonInterfacedParentClass;
+  ObjectClassName:='TMyTypeSafeAccess';
+  MapAncestorName:='TFieldMap';
+  FMemoryStreamClass:='TBlobProxyStream';
+  TypeSafeAccesOptions:=[tsdIsNullProperty];
+  if CreateGUID(G)=0 then
+    InterfaceGUID:=GuidToString(G);
+end;
+
+procedure TGenTypeSafeDatasetOptions.Assign(Source: TPersistent);
+
+Var
+  O : TGenTypeSafeDatasetOptions;
+
+begin
+  if Source is TGenTypeSafeDatasetOptions then
+    begin
+    O:=Source as TGenTypeSafeDatasetOptions;
+    TypeSafeAccesOptions:=O.TypeSafeAccesOptions;
+    FInterfaceName:=O.FInterfaceName; // Don't use public accessor
+    FInterfaceGUID:=O.FInterfaceGUID; // Don't use public accessor
+    MemoryStreamClass:=O.MemoryStreamClass;
+    FFieldNameConstPrefix:=O.FFieldNameConstPrefix; // Don't use public accessor
+    end;
+  Inherited;
+end;
+
+Initialization
+  RegisterCodeGenerator('TypesafeAccess','Type safe dataset access class and interface.',TDDTypeSafeDatasetCodeGenerator);
+
+Finalization
+  UnRegisterCodeGenerator(TDDTypeSafeDatasetCodeGenerator);
+end.
+

packages/fcl-db/src/codegen/fpddcodegen.pp

@@ -29,7 +29,7 @@ Type
                ptSmallInt, ptWord,
                ptLongint, ptCardinal,
                ptInt64, ptQWord,
-               ptShortString, ptAnsiString, ptWideString,
+               ptShortString, ptAnsiString, ptWideString, ptUnicodeString, ptUtf8String,
                ptSingle, ptDouble, ptExtended, ptComp, ptCurrency,
                ptDateTime,
                ptEnumerated, ptSet, ptStream, ptTStrings,
@@ -61,10 +61,11 @@ Type
     function GetPropName: String;
     function GetPropType: TPropType;
     function GetPropTypeStored: boolean;
-    procedure SetPropName(const AValue: String);
   Protected
     Procedure InitFromField(F : TField); virtual;
     Procedure InitFromDDFieldDef(F : TDDFieldDef);virtual;
+    procedure SetFieldType(AValue: TFieldType); virtual;
+    procedure SetPropName(const AValue: String); virtual;
   Public
     Constructor Create(ACollection : TCollection) ; override;
     Procedure Assign(ASource : TPersistent); override;
@@ -77,7 +78,7 @@ Type
   Published
     Property Enabled : Boolean Read FEnabled Write FEnabled;
     Property FieldName : String Read FFieldName Write FFieldName;
-    Property FieldType : TFieldType Read FFieldType Write FFieldType;
+    Property FieldType : TFieldType Read FFieldType Write SetFieldType;
     Property PropertyName : String Read GetPropName Write SetPropName;
     Property PropertyType : TPropType Read GetPropType Write FPropType Stored GetPropTypeStored;
     Property PropertySize : Integer Read FPRopSize Write FPropSize;
@@ -141,6 +142,7 @@ Type
   TCodeGeneratorOptionsClass = Class of TCodeGeneratorOptions;
 
   { TDDCustomCodeGenerator }
+  TCodeEvent = Procedure(Sender : TObject; Strings : TStrings) of object;
 
   TDDCustomCodeGenerator = Class(TComponent)
     FCodeOptions: TCodeGeneratorOptions;
@@ -152,6 +154,8 @@ Type
     procedure AddLn(Strings: TStrings); overload;
     procedure AddLn(Strings: TStrings; Line: String); overload;
     procedure AddLn(Strings: TStrings; Fmt: String; Args: array of const); overload;
+    // Create a pascal code string. Surround by quotes or not
+    Function CreatePascalString(S : String; Quote : Boolean = True) : String;
     // Increase indent by defined amount
     procedure IncIndent;
     // Decrease indent by defined amount
@@ -205,21 +209,29 @@ Type
     Property AncestorClass : String Read FAncestorClass Write SetAncestorClass;
   Public
     Procedure Assign(ASource : TPersistent); override;
+    // Classname without T prepended
+    Function CleanObjectClassName : String;
   Published
     Property ObjectClassName : String Read FClassName Write SetClassName;
   end;
 
   { TDDClassCodeGenerator }
-
   TDDClassCodeGenerator = Class(TDDCustomCodeGenerator)
   private
+    FAfterClassDeclaration: TCodeEvent;
+    FAfterClassImplementation: TCodeEvent;
+    FAfterDestructOrImplementation: TCodeEvent;
+    FAfterTypeSection: TCodeEvent;
     FAncestorClass : String;
-    FClassName: String;
+    FBeforeClassDeclaration: TCodeEvent;
+    FBeforeClassImplementation: TCodeEvent;
+    FBeforeConstructOrImplementation: TCodeEvent;
+    FBeforeTypeSection: TCodeEvent;
     FFieldDefs: TFieldPropDefs;
-    FOptions: TCodeOptions;
     FStreamClass: String;
     FStringsClass: String;
     FUnitName: String;
+    procedure DoBeforeGetter(Strings: TStrings);
     function GetOpts: TClassCodeGeneratorOptions;
     procedure SetAncestorClass(const AValue: String);
     procedure SetClassName(const AValue: String);
@@ -229,8 +241,18 @@ Type
     Function GetFieldDefs: TFieldPropDefs; override;
     procedure SetFieldDefs(const AValue: TFieldPropDefs); override;
     Function CreateOptions : TCodeGeneratorOptions; override;
+    Procedure DoBeforeTypeSection(Strings: TStrings); virtual;
+    Procedure DoAfterTypeSection(Strings: TStrings); virtual;
+    Procedure DoBeforeClassDeclaration(Strings: TStrings); virtual;
+    Procedure DoAfterClassDeclaration(Strings: TStrings); virtual;
+    Procedure DoBeforeConstructor(Strings: TStrings); virtual;
+    Procedure DoAfterDestructor(Strings: TStrings); virtual;
+    Procedure DoBeforeClassImplementation(Strings : TStrings); virtual;
+    Procedure DoAfterClassImplementation(Strings: TStrings); virtual;
     Procedure DoGenerateInterface(Strings: TStrings); override;
     Procedure DoGenerateImplementation(Strings: TStrings); override;
+    // Override this if you want to add interfaces to the class.
+    Function GetClassInterfaces : String; virtual;
     // General code things.
     // Override to create TFieldpropdefs descendent instance.
     Function CreateFieldPropDefs : TFieldPropDefs; virtual;
@@ -250,8 +272,12 @@ Type
     procedure CreateClassEnd(Strings : TStrings); virtual;
     // Called right after section start is written.
     procedure WriteVisibilityStart(V: TVisibility; Strings: TStrings); virtual;
-    // Should a property declaration be written ?
+    // Called at the end of section.
+    procedure WriteVisibilityEnd(V: TVisibility; Strings: TStrings); virtual;
+    // Should a property declaration be written ? Checks enabled and visibility
     function AllowPropertyDeclaration(F: TFieldPropDef; AVisibility: TVisibilities): Boolean; virtual;
+    // Writes a property declaration. Only called if AllowPropertyDeclaration returned true
+    procedure WritePropertyDeclaration(Strings: TStrings; F: TFieldPropDef); virtual;
     // Creates a property declaration.
     Function PropertyDeclaration(Strings: TStrings; Def: TFieldPropDef) : String; virtual;
     // Writes private fields for class.
@@ -301,6 +327,14 @@ Type
     Procedure GenerateClass(Stream : TStream);
   Published
     Property Fields;
+    Property AfterTypeSection : TCodeEvent Read FAfterTypeSection Write FAfterTypeSection;
+    Property BeforeTypeSection : TCodeEvent Read FBeforeTypeSection Write FBeforeTypeSection;
+    Property AfterClassDeclaration : TCodeEvent Read FAfterClassDeclaration Write FAfterClassDeclaration;
+    Property BeforeClassDeclaration : TCodeEvent Read FBeforeClassDeclaration Write FBeforeClassDeclaration;
+    Property AfterClassImplementation : TCodeEvent Read FAfterClassImplementation Write FAfterClassImplementation;
+    Property BeforeClassImplementation : TCodeEvent Read FBeforeClassImplementation Write FBeforeClassImplementation;
+    Property AfterDestructorImplementation : TCodeEvent Read FAfterDestructOrImplementation Write FAfterDestructOrImplementation;
+    Property BeforeConstructorImplementation : TCodeEvent Read FBeforeConstructOrImplementation Write FBeforeConstructOrImplementation;
   end;
 
   ECodeGenerator = Class(Exception);
@@ -379,7 +413,7 @@ Var
     vPublished, vPublished,
     vPublished, vPublished,
     vPublished, vPublished,
-    vPublished, vPublished, vPublished,
+    vPublished, vPublished, vPublished, vPublished, vPublished,
     vPublished, vPublished, vPublished, vPublished, vPublished,
     vPublished,
     vPublished, vPublished, vPublic, vPublished,
@@ -396,7 +430,7 @@ Const
         'SmallInt', 'Word',
         'Longint', 'Cardinal',
         'Int64', 'QWord',
-        'String', 'AnsiString', 'WideString',
+        'String', 'AnsiString', 'WideString',  'UnicodeString', 'Utf8String',
         'Single', 'Double' , 'Extended', 'Comp', 'Currency',
         'TDateTime',
         '','', 'TStream', 'TStrings',
@@ -493,6 +527,12 @@ begin
   Result:=(FPropType<>ptAuto)
 end;
 
+procedure TFieldPropDef.SetFieldType(AValue: TFieldType);
+begin
+  if FFieldType=AValue then Exit;
+  FFieldType:=AValue;
+end;
+
 
 procedure TFieldPropDef.SetPropName(const AValue: String);
 
@@ -736,28 +776,42 @@ end;
 procedure TDDClassCodeGenerator.GenerateClass(Strings: TStrings);
 
 begin
- IncIndent;
- Try
-  AddLn(Strings,'// Declaration');
-  AddLn(Strings,'Type');
-  AddLn(Strings);
-  CreateDeclaration(Strings);
-  AddLn(Strings);
-  AddLn(Strings,'// Implementation');
-  AddLn(Strings);
-  CreateDeclaration(Strings);
+  IncIndent;
+  Try
+    DoBeforeTypeSection(Strings);
+    AddLn(Strings,'// Declaration');
+    AddLn(Strings,'Type');
+    AddLn(Strings);
+    DoBeforeClassDeclaration(Strings);
+    CreateDeclaration(Strings);
+    DoAfterClassDeclaration(Strings);
+    AddLn(Strings);
+    DoAfterTypeSection(Strings);
+    AddLn(Strings,'// Implementation');
+    AddLn(Strings);
+    DoBeforeClassImplementation(Strings);
+    CreateImplementation(Strings);
+    DoAfterClassImplementation(Strings);
   Finally
     DecIndent;
   end;
 end;
 
-Function TDDClassCodeGenerator.AllowPropertyDeclaration(F : TFieldPropDef; AVisibility : TVisibilities) : Boolean;
+function TDDClassCodeGenerator.AllowPropertyDeclaration(F: TFieldPropDef;
+  AVisibility: TVisibilities): Boolean;
 
 begin
   Result:=Assigned(f) and F.Enabled and ((AVisibility=[]) or (F.PropertyVisibility in AVisibility));
 end;
 
-Procedure TDDClassCodeGenerator.CreateDeclaration(Strings : TStrings);
+procedure TDDClassCodeGenerator.WritePropertyDeclaration(Strings: TStrings;
+  F: TFieldPropDef);
+
+begin
+  AddLn(Strings,PropertyDeclaration(Strings,F)+';');
+end;
+
+procedure TDDClassCodeGenerator.CreateDeclaration(Strings: TStrings);
 
 Const
   VisibilityNames : Array [TVisibility] of string
@@ -782,8 +836,9 @@ begin
         begin
         F:=Fields[i];
         if AllowPropertyDeclaration(F,[V]) then
-          AddLn(Strings,PropertyDeclaration(Strings,F)+';');
+          WritePropertyDeclaration(Strings,F);
         end;
+      WriteVisibilityEnd(V,Strings);
     Finally
       Decindent;
     end;
@@ -791,7 +846,7 @@ begin
   CreateClassEnd(Strings);
 end;
 
-Procedure TDDClassCodeGenerator.WritePrivateFields(Strings : TStrings);
+procedure TDDClassCodeGenerator.WritePrivateFields(Strings: TStrings);
 
 Var
   I : Integer;
@@ -811,7 +866,13 @@ begin
   end;
 end;
 
-Procedure TDDClassCodeGenerator.CreateImplementation(Strings : TStrings);
+procedure TDDClassCodeGenerator.DoBeforeGetter(Strings: TStrings);
+
+begin
+
+end;
+
+procedure TDDClassCodeGenerator.CreateImplementation(Strings: TStrings);
 
 Var
   B : Boolean;
@@ -821,13 +882,20 @@ Var
 begin
   AddLn(Strings,' { %s } ',[ClassOptions.ObjectClassName]);
   AddLn(Strings);
+  DoBeforeConstructor(Strings);
+  If NeedsConstructor or NeedsDestructor then
+    Addln(Strings,' { Constructor and destructor }');
   If NeedsConstructor then
     begin
-    Addln(Strings,' { Constructor and destructor }');
     Addln(Strings);
     WriteConstructorImplementation(Strings);
+    end;
+  If NeedsDestructor then
+    begin
+    Addln(Strings);
     WriteDestructorImplementation(Strings);
     end;
+  DoAfterDestructor(Strings);
   B:=False;
   For I:=0 to Fields.Count-1 do
     begin
@@ -860,7 +928,8 @@ begin
     end;
 end;
 
-Procedure TDDClassCodeGenerator.WritePropertyGetterImpl(Strings : TStrings; F : TFieldPropDef);
+procedure TDDClassCodeGenerator.WritePropertyGetterImpl(Strings: TStrings;
+  F: TFieldPropDef);
 
 Var
   S : String;
@@ -878,7 +947,8 @@ begin
   EndMethod(Strings,S);
 end;
 
-Procedure TDDClassCodeGenerator.WritePropertySetterImpl(Strings : TStrings; F : TFieldPropDef);
+procedure TDDClassCodeGenerator.WritePropertySetterImpl(Strings: TStrings;
+  F: TFieldPropDef);
 
 Var
   S : String;
@@ -926,25 +996,85 @@ begin
   Result:=TClassCodeGeneratorOptions.Create;
 end;
 
+procedure TDDClassCodeGenerator.DoBeforeTypeSection(Strings: TStrings);
+begin
+  If Assigned(BeforeTypeSection) then
+    BeforeTypeSection(Self,Strings);
+end;
+
+procedure TDDClassCodeGenerator.DoAfterTypeSection(Strings: TStrings);
+begin
+  If Assigned(AfterTypeSection) then
+    AfterTypeSection(Self,Strings);
+end;
+
+procedure TDDClassCodeGenerator.DoBeforeClassDeclaration(Strings: TStrings);
+begin
+  if Assigned(BeforeClassDeclaration) then
+    BeforeClassDeclaration(Self,Strings);
+end;
+
+procedure TDDClassCodeGenerator.DoAfterClassDeclaration(Strings: TStrings);
+begin
+  if Assigned(AfterClassDeclaration) then
+    AfterClassDeclaration(Self,Strings);
+end;
+
+procedure TDDClassCodeGenerator.DoBeforeConstructor(Strings: TStrings);
+begin
+  If Assigned(BeforeConstructorImplementation) then
+    BeforeConstructorImplementation(Self,Strings);
+end;
+
+procedure TDDClassCodeGenerator.DoAfterDestructor(Strings: TStrings);
+begin
+  If Assigned(AfterDestructorImplementation) then
+    AfterDestructorImplementation(Self,Strings);
+end;
+
+procedure TDDClassCodeGenerator.DoBeforeClassImplementation(Strings: TStrings);
+begin
+  If Assigned(BeforeClassImplementation) then
+    BeforeClassImplementation(Self,Strings);
+end;
+
+procedure TDDClassCodeGenerator.DoAfterClassImplementation(Strings: TStrings);
+begin
+  If Assigned(AfterClassImplementation) then
+    AfterClassImplementation(Self,Strings);
+end;
+
 procedure TDDClassCodeGenerator.DoGenerateInterface(Strings: TStrings);
 begin
+  DoBeforeTypeSection(Strings);
   AddLn(Strings,'Type');
   AddLn(Strings);
   IncIndent;
   Try
+    DoBeforeClassDeclaration(Strings);
     CreateDeclaration(Strings);
+    DoAfterClassDeclaration(Strings);
   Finally
     DecIndent;
   end;
+  DoAfterTypeSection(Strings);
 end;
 
 procedure TDDClassCodeGenerator.DoGenerateImplementation(Strings: TStrings);
 begin
+  DoBeforeClassImplementation(Strings);
   CreateImplementation(Strings);
+  DoAfterClassImplementation(Strings);
+end;
+
+function TDDClassCodeGenerator.GetClassInterfaces: String;
+begin
+  Result:='';
 end;
 
 
-Procedure TDDClassCodeGenerator.WriteConstructorImplementation(Strings : TStrings);
+procedure TDDClassCodeGenerator.WriteConstructorImplementation(Strings: TStrings
+  );
 
 Var
   I : Integer;
@@ -970,7 +1100,8 @@ begin
   EndMethod(Strings,S);
 end;
 
-Procedure TDDClassCodeGenerator.WriteDestructorImplementation(Strings : TStrings);
+procedure TDDClassCodeGenerator.WriteDestructorImplementation(Strings: TStrings
+  );
 
 Var
   I : Integer;
@@ -998,7 +1129,8 @@ end;
 
 
 
-Procedure TDDClassCodeGenerator.WriteFieldCreate(Strings : TStrings;F : TFieldPropDef);
+procedure TDDClassCodeGenerator.WriteFieldCreate(Strings: TStrings;
+  F: TFieldPropDef);
 
 Var
   S : String;
@@ -1022,7 +1154,8 @@ begin
   end;
 end;
 
-Procedure TDDClassCodeGenerator.WriteFieldDestroy(Strings : TStrings;F : TFieldPropDef);
+procedure TDDClassCodeGenerator.WriteFieldDestroy(Strings: TStrings;
+  F: TFieldPropDef);
 
 Var
   S : String;
@@ -1043,15 +1176,21 @@ begin
 end;
 
 
-Procedure TDDClassCodeGenerator.CreateClassHead(Strings : TStrings);
+procedure TDDClassCodeGenerator.CreateClassHead(Strings: TStrings);
+
+Var
+  S : String;
 
 begin
   Addln(Strings,'{ %s }',[ClassOptions.ObjectClassName]);
   AddLn(Strings);
-  AddLn(Strings,'%s = Class(%s)',[ClassOptions.ObjectClassName,ClassOptions.AncestorClass]);
+  S:=GetClassInterfaces;
+  if (S<>'') then
+    S:=','+S;
+  AddLn(Strings,'%s = Class(%s%s)',[ClassOptions.ObjectClassName,ClassOptions.AncestorClass,S])
 end;
 
-Procedure TDDClassCodeGenerator.CreateClassEnd(Strings : TStrings);
+procedure TDDClassCodeGenerator.CreateClassEnd(Strings: TStrings);
 
 begin
   AddLn(Strings,'end;');
@@ -1059,7 +1198,8 @@ begin
 end;
 
 
-Procedure TDDClassCodeGenerator.WriteVisibilityStart(V : TVisibility; Strings : TStrings);
+procedure TDDClassCodeGenerator.WriteVisibilityStart(V: TVisibility;
+  Strings: TStrings);
 
 Var
   I : Integer;
@@ -1083,16 +1223,22 @@ begin
   else if v=vPublic then
     begin
     If NeedsConstructor then
-      begin
       AddLn(Strings,ConstructorDeclaration(False));
+    If NeedsDestructor then
       Addln(Strings,DestructorDeclaration(False));
-      end;
     end
   // Do nothing
 end;
 
+procedure TDDClassCodeGenerator.WriteVisibilityEnd(V: TVisibility;
+  Strings: TStrings);
+begin
+  // Do nothing
+end;
 
-Function TDDClassCodeGenerator.PropertyDeclaration(Strings : TStrings; Def : TFieldPropDef) : String;
+
+function TDDClassCodeGenerator.PropertyDeclaration(Strings: TStrings;
+  Def: TFieldPropDef): String;
 
 begin
   Result:='Property '+Def.PropertyName+' ';
@@ -1103,18 +1249,19 @@ begin
     Result:=Result+' Write '+Def.ObjPasWriteDef;
 end;
 
-Function TDDClassCodeGenerator.PropertyGetterDeclaration(Def : TFieldPropDef; Impl : Boolean) : String;
+function TDDClassCodeGenerator.PropertyGetterDeclaration(Def: TFieldPropDef;
+  Impl: Boolean): String;
 
 
 begin
   Result:='Function ';
   If Impl then
     Result:=Result+Classoptions.ObjectClassName+'.';
-  If Impl then
-    Result:=Result+Def.ObjPasReadDef+' : '+Def.ObjPasTypeDef+';';
+  Result:=Result+Def.ObjPasReadDef+' : '+Def.ObjPasTypeDef+';';
 end;
 
-Function TDDClassCodeGenerator.PropertySetterDeclaration(Def : TFieldPropDef; Impl : Boolean) : String;
+function TDDClassCodeGenerator.PropertySetterDeclaration(Def: TFieldPropDef;
+  Impl: Boolean): String;
 
 
 begin
@@ -1146,7 +1293,7 @@ begin
   Result:=NeedsConstructor;
 end;
 
-Function TDDClassCodeGenerator.ConstructorDeclaration(Impl : Boolean) : String;
+function TDDClassCodeGenerator.ConstructorDeclaration(Impl: Boolean): String;
 begin
   Result:='Constructor ';
   If Impl then
@@ -1154,7 +1301,7 @@ begin
   Result:=Result+'Create;';
 end;
 
-Function TDDClassCodeGenerator.DestructorDeclaration(Impl : Boolean) : String;
+function TDDClassCodeGenerator.DestructorDeclaration(Impl: Boolean): String;
 begin
   Result:='Destructor ';
   If Impl then
@@ -1247,12 +1394,28 @@ begin
   Strings.Add(FCurrentIndent+Line);
 end;
 
-procedure TDDCustomCodeGenerator.AddLn(Strings : TStrings; Fmt : String; Args : Array Of Const);
+procedure TDDCustomCodeGenerator.AddLn(Strings: TStrings; Fmt: String;
+  Args: array of const);
 
 begin
   Strings.Add(FCurrentIndent+Format(Fmt,Args));
 end;
 
+function TDDCustomCodeGenerator.CreatePascalString(S: String; Quote: Boolean): String;
+
+Var
+  SW : String;
+
+begin
+  SW:=StringReplace(S,'''','''''',[rfReplaceAll]);
+  SW:=StringReplace(SW,#13#10,'''#13#10''',[rfReplaceAll]);
+  SW:=StringReplace(SW,#10,'''#10''',[rfReplaceAll]);
+  SW:=StringReplace(SW,#13,'''#13''',[rfReplaceAll]);
+  If Quote then
+    SW:=''''+SW+'''';
+  Result:=SW;
+end;
+
 
 function TDDCustomCodeGenerator.CreateOptions: TCodeGeneratorOptions;
 begin
@@ -1356,14 +1519,16 @@ begin
 
 end;
 
-Procedure TDDCustomCodeGenerator.BeginMethod(STrings : TStrings; Const Decl : String);
+procedure TDDCustomCodeGenerator.BeginMethod(STrings: TStrings;
+  const Decl: String);
 
 begin
   AddLn(Strings,Decl);
   AddLn(Strings);
 end;
 
-Procedure TDDCustomCodeGenerator.EndMethod(STrings : TStrings; Const Decl : String);
+procedure TDDCustomCodeGenerator.EndMethod(STrings: TStrings; const Decl: String
+  );
 
 begin
   AddLn(Strings,'end;');
@@ -1563,6 +1728,18 @@ begin
   inherited Assign(ASource);
 end;
 
+function TClassCodeGeneratorOptions.CleanObjectClassName: String;
+
+Var
+  S : String;
+
+begin
+  S:=ObjectClassName;
+  if (Length(S)>1) and (S[1]='T') then
+    Delete(S,1,1);
+  Result:=S;
+end;
+
 procedure TClassCodeGeneratorOptions.SetAncestorClass(const AValue: String);
 begin
   if (FAncestorClass=AValue) then