* Initial implementation

git-svn-id: trunk@9389 -

.gitattributes

@@ -4106,6 +4106,13 @@ packages/fcl-db/src/base/dsparams.inc 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
+packages/fcl-db/src/codegen/Makefile svneol=native#text/plain
+packages/fcl-db/src/codegen/Makefile.fpc 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/fpcgsqlconst.pp svneol=native#text/plain
+packages/fcl-db/src/codegen/fpcgtiopf.pp svneol=native#text/plain
+packages/fcl-db/src/codegen/fpddcodegen.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/Makefile svneol=native#text/plain
 packages/fcl-db/src/datadict/Makefile.fpc svneol=native#text/plain
 packages/fcl-db/src/datadict/buildd.lpi svneol=native#text/plain

packages/fcl-db/src/codegen/Makefile.fpc

@@ -0,0 +1,24 @@
+#
+# Makefile.fpc for SQL FCL db units
+#
+
+[package]
+main=fcl-db
+
+[require]
+packages=fcl-base
+
+[target]
+units=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+
+[compiler]
+options=-S2h
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../../../..
+
+[rules]
+.NOTPARALLEL:

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

@@ -0,0 +1,258 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2007 by Michael Van Canneyt, member of the
+    Free Pascal development team
+
+    Data Dictionary Code Generator Implementation.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit fpcgcreatedbf;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpddCodeGen;
+  
+Type
+
+  { TDDCreateDBFOptions }
+
+  TDDCreateDBFOptions = Class(TCodeGeneratorOptions)
+  private
+    FIDent: String;
+    FProcName: String;
+    FCreateInstance: Boolean;
+    FTableName: String;
+    procedure SetIdent(const AValue: String);
+    procedure SetProcName(const AValue: String);
+  Public
+    Constructor Create; override;
+    Procedure Assign(ASource : TPersistent); override;
+  Published
+    Property Identifier : String Read FIDent Write SetIdent;
+    Property CreateInstance : Boolean Read FCreateInstance Write FCreateInstance default True;
+    Property ProcedureName : String Read FProcName Write SetProcName;
+    Property TableName : String Read FTableName Write FTableName;
+  end;
+  
+  { TDDCreateDBFGenerator }
+
+  TDDCreateDBFGenerator = Class(TDDCustomCodeGenerator)
+  Private
+    FFields: TFieldPropDefs;
+  Protected
+    Function ProcedureDecl : String; virtual;
+    Function CreateOptions : TCodeGeneratorOptions; override;
+    Procedure DoGenerateImplementation(Strings: TStrings); override;
+    Procedure DoGenerateInterface(Strings: TStrings); override;
+    function GetFieldDefs: TFieldPropDefs; override;
+    procedure SetFieldDefs(const AValue: TFieldPropDefs); override;
+    Function DBFOptions : TDDCreateDBFOptions;
+    Function GetImplementationUsesClause : string; override;
+    Function GetInterfaceUsesClause : string; override;
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+    Class Function NeedsFieldDefs : Boolean; override;
+  end;
+
+implementation
+
+uses db,typinfo;
+
+{ TDDCreateDBFOptions }
+
+procedure TDDCreateDBFOptions.SetIdent(const AValue: String);
+begin
+  if FIDent=AValue then exit;
+  If Not IsValidIdent(AValue) then
+    Raise ECodeGenerator.CreateFmt(SErrInvalidIdentifier,[AValue]);
+  FIDent:=AValue;
+end;
+
+procedure TDDCreateDBFOptions.SetProcName(const AValue: String);
+begin
+  if FProcName=AValue then exit;
+  If Not IsValidIdent(AValue) then
+    Raise ECodeGenerator.CreateFmt(SErrInvalidIdentifier,[AValue]);
+  FProcName:=AValue;
+end;
+
+constructor TDDCreateDBFOptions.Create;
+begin
+  inherited Create;
+  FCreateInstance:=True;
+  FIdent:='DBF';
+  FTableName:='MyTable';
+  FProcName:='CreateDBF';
+end;
+
+procedure TDDCreateDBFOptions.Assign(ASource: TPersistent);
+
+Var
+  DOP : TDDCreateDBFOptions;
+
+begin
+  if ASource is TDDCreateDBFOptions then
+    begin
+    DOP:=ASource as TDDCreateDBFOptions;
+    FCreateInstance:=DOP.FCreateInstance;
+    Fident:=DOP.FIdent;
+    FProcName:=DOP.FProcName;
+    FTableName:=DOP.FTableName;
+    end;
+  inherited Assign(ASource);
+end;
+
+{ TDDCreateDBFGenerator }
+
+function TDDCreateDBFGenerator.ProcedureDecl: String;
+begin
+  If not DBFOptions.CreateInstance then
+    Result:=Format('%s (%s : TDBF)',[DBFoptions.ProcedureName,DBFOptions.Identifier])
+  else
+    Result:=DBFoptions.ProcedureName;
+  Result:=Format('procedure %s;',[Result]);
+end;
+
+function TDDCreateDBFGenerator.CreateOptions: TCodeGeneratorOptions;
+begin
+  Result:=TDDCreateDBFOptions.Create;
+end;
+
+procedure TDDCreateDBFGenerator.DoGenerateImplementation(Strings: TStrings);
+
+Var
+  i : integer;
+  F : TFieldPropDef;
+  S : String;
+  N : String;
+  
+begin
+  N:=DBFOptions.Identifier;
+  If (DBFoptions.ProcedureName<>'') then
+    begin
+    BeginMethod(Strings,ProcedureDecl);
+    If DBFOptions.CreateInstance then
+      begin
+      Addln(Strings);
+      Addln(Strings,'Var');
+      IncIndent;
+      Try
+        Addln(Strings,'%s : TDBF;',[N]);
+      Finally
+        DecIndent;
+      end;
+      end;
+    AddLn(Strings,'begin');
+    IncIndent;
+    end;
+  Try
+    If DBFOptions.CreateInstance then
+      Addln(Strings,'%s:=TDBF.Create(Nil);',[N]);
+    Addln(Strings,'With %s do',[N]);
+    IncIndent;
+    try
+      AddLn(Strings,'begin');
+      If Not DBFOptions.CreateInstance then
+        AddLn(Strings,'Close;');
+      AddLn(Strings,'With FieldDefs do');
+      IncIndent;
+      try
+        AddLn(Strings,'begin');
+        For I:=0 to Fields.Count-1 do
+          begin
+          F:=Fields[i];
+          If F.Enabled then
+            begin
+            S:=GetEnumName(TypeInfo(TFieldType),Ord(F.FieldType));
+            AddLn(Strings,'Add(''%s'',%s,%d);',[F.FieldName,S,F.PropertySize]);
+            end;
+          end;
+        AddLn(Strings,'end;');
+      Finally
+        DecIndent;
+      end;
+      AddLn(Strings,'TableName:=%s;',[CreateString(DBFOptions.TableName)]);
+      AddLn(Strings,'CreateTable;');
+      AddLn(Strings,'Exclusive:=true;');
+      AddLn(Strings,'Open;');
+      AddLn(Strings,'end;');
+    finally
+      DecIndent;
+    end;
+  Finally
+    If (DBFoptions.ProcedureName<>'') then
+      begin
+      DecIndent;
+      EndMethod(Strings,DBFoptions.ProcedureName);
+      end;
+  end;
+end;
+
+procedure TDDCreateDBFGenerator.DoGenerateInterface(Strings: TStrings);
+begin
+  If (DBFoptions.ProcedureName<>'') then
+    BeginMethod(Strings,ProcedureDecl);
+end;
+
+function TDDCreateDBFGenerator.GetFieldDefs: TFieldPropDefs;
+begin
+  Result:=FFields;
+end;
+
+procedure TDDCreateDBFGenerator.SetFieldDefs(const AValue: TFieldPropDefs);
+begin
+  FFields.Assign(AValue);
+end;
+
+
+function TDDCreateDBFGenerator.DBFOptions: TDDCreateDBFOptions;
+begin
+  Result:=TDDCreateDBFOptions(CodeOptions);
+end;
+
+function TDDCreateDBFGenerator.GetImplementationUsesClause: String;
+begin
+  If DBFOptions.CreateInstance then
+    Result:='db, dbf';
+end;
+
+function TDDCreateDBFGenerator.GetInterfaceUsesClause: string;
+begin
+  If Not DBFOptions.CreateInstance then
+    Result:='db, dbf';
+end;
+
+constructor TDDCreateDBFGenerator.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FFields:=TFieldPropDefs.Create(TFieldPropDef);
+end;
+
+destructor TDDCreateDBFGenerator.Destroy;
+begin
+  FreeAndNil(FFields);
+  inherited Destroy;
+end;
+
+class function TDDCreateDBFGenerator.NeedsFieldDefs: Boolean;
+begin
+  Result:=True;
+end;
+
+initialization
+  RegisterCodeGenerator('DBFCreate','Create DBF file for data',TDDCreateDBFGenerator);
+Finalization
+  UnRegisterCodeGenerator(TDDCreateDBFGenerator);
+end.
+

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

@@ -0,0 +1,991 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2007 by Michael Van Canneyt, member of the
+    Free Pascal development team
+
+    Data Dictionary Code Generator Implementation.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit fpcgdbcoll;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, db, fpddcodegen;
+  
+Type
+  TListMode = (lmNone,lmList,lmObjectList,lmCollection,lmDBCollection);
+  TClassOption = (coCreateLoader,coUseFieldMap,coCreateArrayProperty,coCreateAssign);
+  TClassOptions = Set of TClassOption;
+  
+  { TDBCollOptions }
+
+  TDBCollOptions = Class(TClassCodeGeneratorOptions)
+  private
+    FClassOptions: TClassOptions;
+    FListMode: TListMode;
+    FListAncestorName: String;
+    FListClassName: String;
+    FArrayPropName: String;
+    FMapAncestorName: String;
+    FMapClassName: String;
+    function GetArrayPropName: String;
+    function GetListClassName: String;
+    function GetMapName: String;
+    procedure SetArrayPropName(const AValue: String);
+    procedure SetListAncestorName(const AValue: String);
+    procedure SetListClassName(const AValue: String);
+    procedure SetListMode(const AValue: TListMode);
+    procedure SetMapAncestorName(const AValue: String);
+    procedure SetMapClassName(const AValue: String);
+  Public
+    Constructor Create; override;
+    Procedure Assign(ASource : TPersistent); override;
+    Function CreateLoader : Boolean;
+    Function UseFieldMap : Boolean;
+    Function CreateArrayProperty : Boolean;
+    Function CreateAssign : Boolean;
+  Published
+    Property ClassOptions : TClassOptions Read FClassOptions Write FClassOptions;
+    Property ListMode : TListMode Read FListMode Write SetListMode;
+    Property ListAncestorName : String Read FListAncestorName Write SetListAncestorName;
+    Property ListClassName : String Read GetListClassName Write SetListClassName;
+    Property MapAncestorName : String Read FMapAncestorName Write SetMapAncestorName;
+    Property MapClassName : String Read GetMapName Write SetMapClassName;
+    Property ArrayPropName : String Read GetArrayPropName Write SetArrayPropName;
+    Property AncestorClass;
+  end;
+  
+  { TDDDBCollCodeGenerator }
+
+  TDDDBCollCodeGenerator = Class(TDDClassCodeGenerator)
+    procedure CreateObjectAssign(Strings: TStrings;
+      const ObjectClassName: String);
+  private
+    function GetOpt: TDBColLOptions;
+  Protected
+    // Not to be overridden.
+    procedure CreateFieldMapImplementation(Strings: TStrings; const ObjectClassName, MapClassName: String);
+    procedure CreateListImplementation(Strings: TStrings; ListMode: TListMode;  const ObjectClassName, ListClassName: String);
+    procedure WriteFieldMapAssign(Strings: TStrings; F: TFieldPropDef);
+    procedure WriteMapInitFields(Strings: TStrings; const ObjectClassName, MapClassName: String);
+    procedure WriteListLoad(Strings: TStrings; ListMode: TListMode; const ObjectClassName, ListClassName: String; FromMap: Boolean);
+    procedure WriteListAddObject(Strings: TStrings; ListMode: TListMode; const InstanceName, ObjectClassName: String);
+    // Overrides of parent objects
+    Function GetInterfaceUsesClause : string; override;
+    Procedure DoGenerateInterface(Strings: TStrings); override;
+    Procedure DoGenerateImplementation(Strings: TStrings); override;
+    procedure WriteVisibilityStart(V: TVisibility; Strings: TStrings); override;
+    procedure CreateImplementation(Strings: TStrings); override;
+    Class Function NeedsFieldDefs : Boolean; override;
+    Function CreateOptions : TCodeGeneratorOptions; override;
+    //
+    //  New methods
+    //
+    // Override to add declarations to list declaration
+    procedure DoCreateListDeclaration(Strings: TStrings; ListMode: TListMode; const ObjectClassName, ListClassName, ListAncestorName: String); virtual;
+    // Override to add declarations to fieldmap declaration
+    procedure DoCreateFieldMapDeclaration(Strings: TStrings; const ObjectClassName,MapClassName, MapAncestorName: String); virtual;
+    // Override to add statements to the FieldMap Load implementation
+    procedure DoWriteMapLoad(Strings: TStrings; const ObjectClassName, MapClassName: String); virtual;
+    // Override to add statements to the FieldMap LoadObject implementation
+    procedure DoWriteMapLoadObject(Strings: TStrings; const ObjectClassName, MapClassName: String);virtual;
+    // Create an object that should be added to the list.
+    procedure WriteListCreateObject(Strings: TStrings; ListMode: TListMode;  const InstanceName, ObjectClassName: String);
+    // Write LoadFromDataset implementation for List object
+    procedure WriteListLoadFromDataset(Strings: TStrings; ListMode: TListMode; const ObjectClassName, ListClassName: String);
+    // Write LoadFromMap implementation for List object
+    procedure WriteListLoadFromMap(Strings: TStrings; ListMode: TListMode; const ObjectClassName, ListClassName: String);
+    // Object load from map;
+    procedure CreateObjectLoadFromMap(Strings: TStrings; const ObjectClassName: String); virtual;
+    // Create assign statement for a property from a dataset field, in object itself (not in map).
+    procedure WriteFieldDatasetAssign(Strings: TStrings; F: TFieldPropDef); virtual;
+    // Copy a property from one instance to another in Assign()
+    procedure WriteFieldAssign(Strings: TStrings; F: TFieldPropDef); virtual;
+    // Code to Load object from fataset (should check usefieldmap)
+    procedure CreateObjectLoadFromDataset(Strings: TStrings; const ObjectClassName: String); virtual;
+  Public
+    procedure CreateFieldMapDeclaration(Strings: TStrings; const ObjectClassName,MapClassName,
+      MapAncestorName: String);
+    procedure CreateListDeclaration(Strings: TStrings; ListMode: TListMode;
+      const ObjectClassName, ListClassName, ListAncestorName: String);
+    Property DBCollOptions : TDBColLOptions Read GetOpt;
+  end;
+  
+implementation
+
+{ TDBCollOptions }
+
+procedure TDBCollOptions.SetListMode(const AValue: TListMode);
+begin
+  if FListMode=AValue then exit;
+  FListMode:=AValue;
+  Case ListMode of
+    lmNone :
+      begin
+      Exclude(FClassOptions,coCreateArrayProperty);
+      end;
+    lmList :
+      begin
+      AncestorClass:='TPersistent';
+      ListAncestorName:='TList';
+      end;
+    lmObjectList :
+      begin
+      AncestorClass:='TPersistent';
+      ListAncestorName:='TObjectList';
+      end;
+    lmCollection :
+      begin
+      AncestorClass:='TCollectionItem';
+      ListAncestorName:='TCollection';
+      end;
+    lmDBCollection :
+      begin
+      AncestorClass:='TDBCollectionItem';
+      ListAncestorName:='TDBCollection';
+      Include(FClassoptions,coUseFieldMap);
+      end;
+  end;
+end;
+
+procedure TDBCollOptions.SetMapAncestorName(const AValue: String);
+begin
+  CheckIdentifier(AValue,True);
+  FMapAncestorName:=AValue;
+end;
+
+procedure TDBCollOptions.SetMapClassName(const AValue: String);
+begin
+  CheckIdentifier(AValue,True);
+  FMapClassName:=AValue;
+end;
+
+function TDBCollOptions.GetListClassName: String;
+begin
+  Result:=FListClassName;
+  If (Result='') then
+    Result:=ObjectClassName+'List';
+end;
+
+function TDBCollOptions.GetArrayPropName: String;
+begin
+  Result:=FArrayPropName;
+  If (Result='') then
+    begin
+    Result:=ObjectClassName;
+    If (Result<>'') and (Upcase(Result[1])='T') then
+      Delete(Result,1,1);
+    Result:=Result+'s';
+    end;
+end;
+
+function TDBCollOptions.GetMapName: String;
+begin
+  Result:=FMapClassName;
+  If (Result='') then
+    Result:=ObjectClassName+'Map';
+end;
+
+procedure TDBCollOptions.SetArrayPropName(const AValue: String);
+begin
+  CheckIdentifier(AValue,True);
+  FArrayPropName:=AValue;
+end;
+
+procedure TDBCollOptions.SetListAncestorName(const AValue: String);
+begin
+  CheckIdentifier(AValue,True);
+  FListAncestorName:=AValue;
+end;
+
+procedure TDBCollOptions.SetListClassName(const AValue: String);
+begin
+  CheckIdentifier(AValue,True);
+  FListClassName:=AValue;
+end;
+
+constructor TDBCollOptions.Create;
+begin
+  inherited Create;
+  FClassOptions:=[coCreateLoader,coUseFieldMap,coCreateAssign];
+  AncestorClass:='TPersistent';
+  FListAncestorName:='TList';
+  ObjectClassName:='TMyObject';
+  FMapAncestorName:='TFieldMap';
+end;
+
+procedure TDBCollOptions.Assign(ASource: TPersistent);
+
+Var
+  DC : TDBCollOptions;
+
+begin
+  If ASource is TDBCollOptions then
+    begin
+    DC:=ASource as TDBCollOptions;
+    ListMode:=DC.ListMode;
+    FClassOptions:=DC.FClassOptions;
+    FListAncestorName:=DC.FListAncestorName;
+    FListClassName:=DC.FListClassName;
+    FMapAncestorName:=DC.FMapAncestorName;
+    FMapClassName:=DC.FMapClassName;
+    FArrayPropName:=DC.FArrayPropName;
+    end;
+  inherited Assign(ASource);
+end;
+
+function TDBCollOptions.CreateLoader: Boolean;
+begin
+  Result:=coCreateLoader in ClassOptions;
+end;
+
+function TDBCollOptions.UseFieldMap: Boolean;
+begin
+  Result:=coUseFieldMap in ClassOptions;
+end;
+
+function TDBCollOptions.CreateArrayProperty: Boolean;
+begin
+  Result:=coCreateArrayProperty in ClassOptions;
+end;
+
+function TDBCollOptions.CreateAssign: Boolean;
+begin
+  Result:=coCreateAssign in ClassOptions;
+end;
+
+{ TDDDBCollCodeGenerator }
+
+function TDDDBCollCodeGenerator.GetOpt: TDBColLOptions;
+begin
+  Result:=CodeOptions as TDBColLOptions
+end;
+
+procedure TDDDBCollCodeGenerator.DoGenerateInterface(Strings: TStrings);
+begin
+  inherited DoGenerateInterface(Strings);
+  With DBCollOptions do
+    begin
+    If CreateLoader then
+      begin
+      if UseFieldMap then
+        CreateFieldMapDeclaration(Strings,ObjectClassName,MapClassName,MapAncestorName);
+      end;
+    if ListMode<>lmNone then
+      CreateListDeclaration(Strings,ListMode,ObjectClassName,ListClassName,ListAncestorName);
+    end;
+end;
+
+procedure TDDDBCollCodeGenerator.DoGenerateImplementation(Strings: TStrings);
+begin
+  inherited DoGenerateImplementation(Strings);
+  With DBCollOptions do
+    begin
+    If CreateLoader then
+    If UseFieldMap then
+      CreateFieldMapImplementation(Strings,ObjectClassName,MapClassName);
+    if ListMode<>lmNone then
+      CreateListImplementation(Strings,ListMode,ObjectClassName,ListClassName);
+    end;
+
+end;
+
+procedure TDDDBCollCodeGenerator.WriteVisibilityStart(V: TVisibility;
+  Strings: TStrings);
+begin
+  inherited WriteVisibilityStart(V, Strings);
+  If (V=vPublic) then
+    With DBCollOptions do
+      begin
+      If CreateLoader and (ListMode in [lmList,lmObjectList,lmCollection]) then
+        begin
+        If UseFieldMap Then
+          AddLn(Strings,'Procedure LoadFromMap(Map : TFieldMap);');
+        AddLn(Strings,'Procedure LoadFromDataset(ADataset : TDataset);');
+        end;
+      If CreateAssign then
+          AddLn(Strings,'Procedure Assign(ASource : TPersistent); override;');
+      end;
+end;
+
+procedure TDDDBCollCodeGenerator.CreateImplementation(Strings: TStrings);
+
+Var
+  S : String;
+
+begin
+  inherited CreateImplementation(Strings);
+  With DBCOlloptions do
+    begin
+    If CreateLoader and (ListMode in [lmList,lmObjectList,lmCollection]) then
+      begin
+      if UseFieldMap then
+        begin
+        S:=Format('Procedure %s.LoadFromMap(Map : TFieldMap);',[ObjectClassName]);
+        BeginMethod(Strings,S);
+        CreateObjectLoadFromMap(Strings,ObjectClassName);
+        EndMethod(Strings,S);
+        end;
+      S:=Format('Procedure %s.LoadFromDataset(ADataset : TDataset);',[ObjectClassName]);
+      BeginMethod(Strings,S);
+      CreateObjectLoadFromDataset(Strings,ObjectClassName);
+      EndMethod(Strings,S);
+      end;
+    If CreateAssign then
+      begin
+      S:=Format('Procedure %s.Assign(ASource : TPersistent);',[ObjectClassName]);
+      BeginMethod(Strings,S);
+      CreateObjectAssign(Strings,ObjectClassName);
+      EndMethod(Strings,S);
+      end;
+    end;
+end;
+
+procedure TDDDBCollCodeGenerator.CreateObjectAssign(Strings : TStrings; Const ObjectClassName : String);
+
+Var
+  I : Integer;
+  F : TFieldPropDef;
+
+begin
+  AddLn(Strings,'var');
+  IncIndent;
+  Try
+    AddLn(Strings,'O : %s ;',[ObjectClassName]);
+  Finally
+    DecIndent;
+  end;
+  Addln(Strings,'begin');
+  IncIndent;
+  Try
+    AddLn(Strings,'If (ASource is %s) then',[ObjectClassName]);
+    IncIndent;
+    Try
+      Addln(Strings,'begin');
+      Addln(Strings,'O:=(ASource as %s);',[ObjectClassName]);
+      For I:=0 to Fields.Count-1 do
+        begin
+        F:=Fields[i];
+        If F.Enabled Then
+          WriteFieldAssign(Strings,F);
+        end;
+      Addln(Strings,'end');
+    Finally
+      DecIndent;
+    end;
+    AddLn(Strings,'else');
+    IncIndent;
+    Try
+      AddLn(Strings,'Inherited;');
+    Finally
+      DecIndent;
+    end;
+  Finally
+    DecIndent;
+  end;
+end;
+
+procedure TDDDBCollCodeGenerator.WriteFieldAssign(Strings : TStrings; F : TFieldPropDef);
+
+Var
+  S : String;
+
+begin
+  Case F.PropertyType of
+    ptStream: S:=Format('%s.CopyFrom(O.%s,0);',[F.ObjPasReadDef,F.ObjPasReadDef]);
+    ptTStrings: S:=Format('%s.Assign(O.%s,0);',[F.ObjPasReadDef,F.ObjPasReadDef]);
+    ptCustom: S:=Format('// Custom code to assign %s from O.%s',[F.ObjPasReadDef,F.ObjPasReadDef]);
+  else
+    S:=Format('%s:=O.%s;',[F.ObjPasReadDef,F.ObjPasReadDef]);
+  end;
+  AddLn(Strings,S);
+end;
+
+procedure TDDDBCollCodeGenerator.CreateObjectLoadFromMap(Strings : TStrings; Const ObjectClassName : String);
+
+begin
+  Addln(Strings,'begin');
+  IncIndent;
+  Try
+    AddLn(Strings,'Map.LoadObject(Self);');
+  Finally
+    DecIndent;
+  end;
+end;
+
+procedure TDDDBCollCodeGenerator.CreateObjectLoadFromDataset(Strings : TStrings; Const ObjectClassName : String);
+
+Var
+  I : Integer;
+
+begin
+  AddLn(Strings,'begin');
+  Incindent;
+  try
+    If DBColloptions.UseFieldMap then
+      begin
+      AddLn(Strings,'With %s.Create(ADataset) do',[DBCollOptions.MapClassName]);
+      IncIndent;
+      Try
+        Addln(Strings,'try');
+        IncIndent;
+        Try
+          Addln(Strings,'LoadObject(Self);');
+        Finally
+          DecIndent;
+        end;
+        Addln(Strings,'Finally');
+        IncIndent;
+        Try
+          Addln(Strings,'Free;');
+        Finally
+          DecIndent;
+        end;
+        Addln(Strings,'end;');
+      Finally
+        Decindent;
+      end;
+      end
+    else
+      begin
+      AddLn(Strings,'With ADataset do');
+      IncIndent;
+      Try
+        AddLn(Strings,'begin');
+        For I:=0 to Fields.Count-1 do
+          If Fields[i].Enabled then
+            WriteFieldDatasetAssign(Strings,Fields[i]);
+        AddLn(Strings,'end;');
+      Finally
+        DecIndent;
+      end;
+      end;
+  Finally
+    Decindent;
+  end;
+end;
+
+procedure TDDDBCollCodeGenerator.WriteFieldDatasetAssign(Strings : TStrings; F : TFieldPropDef);
+
+Var
+  FN,PN,S,R : String;
+
+begin
+  PN:=F.PropertyName;
+  FN:=F.FieldName;
+  Case F.PropertyType of
+    ptBoolean :
+      S:='AsBoolean';
+    ptShortint, ptByte,
+    ptSmallInt, ptWord,
+    ptLongint, ptCardinal :
+      S:='AsInteger';
+    ptInt64, ptQWord:
+      If F.FieldType=ftLargeInt then
+        R:=Format('%s:=(FieldByName(%s) as TLargeIntField).AsLargeInt;',[PN,CreateString(FN)])
+      else
+        S:='AsInteger';
+    ptShortString, ptAnsiString, ptWideString :
+      S:='AsString';
+    ptSingle, ptDouble, ptExtended, ptComp :
+      S:='AsFloat';
+    ptCurrency :
+      S:='AsCurrency';
+    ptDateTime :
+      S:='AsDateTime';
+    ptEnumerated :
+      R:=Format('Integer(%s):=FieldByName(%s).AsInteger;',[PN,CreateString(FN)]);
+    ptSet :
+      S:=Format('// Add custom set loading code here for %s from %s',[PN,FN]);
+    ptStream :
+      R:=Format('FieldByName(%s).SaveToStream(%s);',[CreateString(FN),PN]);
+    ptTStrings :
+      R:=Format('%s.Text:=FieldByName(%s).AsString;',[PN,CreateString(FN),PN]);
+    ptCustom :
+      R:=Format('// Add custom loading code here for %s from %s',[PN,FN]);
+  end;
+  If (S<>'') then
+    R:=Format('%s:=FieldByName(%s).%s;',[PN,CreateString(FN),s]);
+  AddLn(Strings,R);
+end;
+
+
+{ FieldMap interface generation routines}
+
+procedure TDDDBCollCodeGenerator.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 TDDDBCollCodeGenerator.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.FieldName]);
+      end;
+    AddLn(Strings,'Procedure DoLoad(AObject : %s);',[ObjectClassName]);
+  Finally
+    DecIndent;
+  end;
+  AddLn(Strings,'Public');
+  IncIndent;
+  Try
+    AddLn(Strings,'Procedure InitFields; Override;');
+    AddLn(Strings,'Procedure LoadObject(AObject : TObject); Override;');
+  Finally
+    DecIndent;
+  end;
+end;
+
+{ FieldMap implementation generation routines}
+
+procedure TDDDBCollCodeGenerator.CreateFieldMapImplementation(Strings : TStrings;
+  Const ObjectClassName,MapClassName : String);
+
+Var
+  S : String;
+  
+begin
+  AddLn(Strings,' { %s }',[MapClassName]);
+  AddLn(Strings);
+  S:=Format('Procedure %s.DoLoad(AObject : %s);',[MapClassName,ObjectClassName]);
+  BeginMethod(Strings,S);
+  Try
+    DoWriteMapLoad(Strings,ObjectClassName,MapClassName);
+  Finally
+    EndMethod(Strings,S);
+  end;
+  S:=Format('Procedure %s.LoadObject(AObject : TObject);',[MapClassName]);
+  BeginMethod(Strings,S);
+  Try
+    DoWriteMapLoadObject(Strings,ObjectClassName,MapClassName);
+  Finally
+    EndMethod(Strings,S);
+  end;
+  S:=Format('Procedure %s.InitFields;',[MapClassName]);
+  BeginMethod(Strings,S);
+  Try
+    WriteMapInitFields(Strings,ObjectClassName,MapClassName);
+  Finally
+    EndMethod(Strings,S);
+  end;
+end;
+
+procedure TDDDBCollCodeGenerator.DoWriteMapLoad(Strings : TStrings; COnst ObjectClassName,MapClassName  : String);
+
+Var
+  I : Integer;
+
+begin
+  AddLn(Strings,'begin');
+  IncIndent;
+  try
+     AddLn(Strings,'With AObject do');
+     IncIndent;
+     try
+       AddLn(Strings,'begin');
+       For I:=0 to Fields.Count-1 do
+         If Fields[i].Enabled then
+           WriteFieldMapAssign(Strings,Fields[i]);
+       AddLn(Strings,'end;');
+     finally
+       DecIndent;
+     end;
+  finally
+    DecIndent;
+  end;
+end;
+
+procedure TDDDBCollCodeGenerator.DoWriteMapLoadObject(Strings : TStrings; Const ObjectClassName,MapClassName : String);
+
+begin
+  Addln(Strings,'begin');
+  IncIndent;
+  try
+    Addln(Strings,'DoLoad(AObject as %s);',[ObjectClassName]);
+  finally
+    DecIndent;
+  end;
+end;
+
+
+procedure TDDDBCollCodeGenerator.WriteFieldMapAssign(Strings : TStrings; F : TFieldPropDef);
+
+Var
+  FN,PN,S : String;
+  
+begin
+  PN:=F.PropertyName;
+  FN:='Self.F'+F.FieldName;
+  Case F.PropertyType of
+    ptBoolean :
+      S:=Format('%s:=GetFromField(%s,%s);',[PN,FN,PN]);
+    ptShortint, ptByte,
+    ptSmallInt, ptWord,
+    ptLongint, ptCardinal :
+      S:=Format('%s:=GetFromField(%s,%s);',[PN,FN,PN]);
+    ptInt64, ptQWord,
+    ptShortString, ptAnsiString, ptWideString :
+      S:=Format('%s:=GetFromField(%s,%s);',[PN,FN,PN]);
+    ptSingle, ptDouble, ptExtended, ptComp, ptCurrency :
+      S:=Format('%s:=GetFromField(%s,%s);',[PN,FN,PN]);
+    ptDateTime :
+      S:=Format('%s:=GetFromField(%s,%s);',[PN,FN,PN]);
+    ptEnumerated :
+      S:=Format('Integer(%s):=GetFromField(%s,Ord(%s));',[PN,FN,PN]);
+    ptSet :
+      S:=Format('// Add custom set loading code here for %s from %s',[PN,FN]);
+    ptStream :
+      S:=Format('%s.SaveToStream(%s);',[FN,PN]);
+    ptTStrings :
+      S:=Format('%s.Text:=GetFromField(%s,%s.Text)',[PN,FN,PN]);
+    ptCustom :
+      S:=Format('// Add custom loading code here for %s from %s',[PN,FN]);
+  end;
+  AddLn(Strings,S);
+end;
+
+procedure TDDDBCollCodeGenerator.WriteMapInitFields(Strings : TStrings; COnst ObjectClassName,MapClassName  : String);
+
+Var
+  I: Integer;
+  F : TFieldPropDef;
+
+begin
+  AddLn(Strings,'begin');
+  IncIndent;
+  try
+    For I:=0 to Fields.Count-1 Do
+      begin
+      F:=Fields[i];
+      If F.Enabled then
+        AddLn(Strings,'F%s:=FindField(%s);',[F.FieldName,CreateString(F.FieldName)]);
+      end;
+  Finally
+    DecIndent;
+  end;
+end;
+
+function TDDDBCollCodeGenerator.GetInterfaceUsesClause: string;
+begin
+  Result:=inherited GetInterfaceUsesClause;
+  With DBColloptions do
+    if CreateLoader or (ListMode=lmDBCollection) then
+      begin
+      If (Result<>'') then
+        Result:=Result+', ';
+      Result:=Result+'db';
+      If  (ListMode=lmObjectList) then
+        Result:=Result+', contnrs';
+      If UseFieldMap or (ListMode=lmDBCollection) then
+        Result:=Result+', dbcoll';
+      end;
+
+end;
+
+
+
+{ List class generation routines }
+
+procedure TDDDBCollCodeGenerator.CreateListDeclaration(Strings : TStrings;
+  ListMode : TListMode; Const ObjectClassName,ListClassName,ListAncestorName : String);
+  
+begin
+  IncIndent;
+  try
+    Addln(Strings);
+    Addln(Strings,'{ %s }',[ListClassName]);
+    Addln(Strings);
+    Addln(Strings,'%s = Class(%s)',[ListClassName,ListAncestorName]);
+    DoCreateListDeclaration(Strings,ListMode,ObjectClassName,ListClassName,ListAncestorName);
+    AddLn(Strings,'end;');
+  Finally
+    DecIndent;
+  end;
+end;
+
+
+procedure TDDDBCollCodeGenerator.DoCreateListDeclaration(Strings : TStrings;
+  ListMode : TListMode; Const ObjectClassName,ListClassName,ListAncestorName : String);
+
+Var
+  S : String;
+
+begin
+  If DBCollOptions.CreateArrayProperty then
+    begin
+    AddLn(Strings,'Private');
+    IncIndent;
+    Try
+      AddLn(Strings,'Function GetObj(Index : Integer) : %s;',[ObjectClassname]);
+      AddLn(Strings,'Procedure SetObj(Index : Integer; AValue : %s);',[ObjectClassname]);
+    Finally
+      DecIndent;
+    end;
+    end;
+  AddLn(Strings,'Public');
+  IncIndent;
+  Try
+    If (ListMode in [lmList,lmObjectList,lmCollection]) and DBCollOptions.CreateLoader then
+      begin
+      If DBColloptions.UseFieldMap then
+        AddLn(Strings,'Procedure LoadFromMap(Map : TFieldMap);');
+      AddLn(Strings,'Procedure LoadFromDataset(Dataset : TDataset);');
+      end
+  Finally
+    DecIndent;
+  end;
+  If DBCollOptions.CreateArrayProperty then
+    begin
+    IncIndent;
+    Try
+      S:=DBCollOptions.ArrayPropName;
+      AddLn(Strings,'Property %s[Index : Integer] : %s Read GetObj Write SetObj; Default;',[S,ObjectClassname]);
+    Finally
+      DecIndent;
+    end;
+    end;
+end;
+
+procedure TDDDBCollCodeGenerator.CreateListImplementation(Strings : TStrings;
+  ListMode : TListMode; Const ObjectClassName,ListClassName : String);
+
+Var
+  S : String;
+
+begin
+  If (ListMode in [lmList,lmObjectList,lmCollection]) and DBCollOptions.CreateLoader then
+    begin
+    AddLn(Strings,'{ %s }',[ListClassName]);
+    If DBCollOptions.CreateArrayProperty then
+      begin
+      S:=Format('Function %s.GetObj(Index : Integer) : %s;',[ListClassName,ObjectClassname]);
+      BeginMethod(Strings,S);
+      AddLn(Strings,'begin');
+      IncIndent;
+      try
+        AddLn(Strings,'Result:=%s(Items[Index]);',[ObjectClassname]);
+      finally
+        DecIndent;
+      end;
+      EndMethod(Strings,S);
+      S:=Format('Procedure %s.SetObj(Index : Integer; AValue : %s);',[ListClassName,ObjectClassname]);
+      BeginMethod(Strings,S);
+      AddLn(Strings,'begin');
+      IncIndent;
+      try
+        AddLn(Strings,'Items[Index]:=AValue;');
+      finally
+        DecIndent;
+      end;
+      EndMethod(Strings,S);
+      end;
+    If DBColloptions.UseFieldMap then
+      begin
+      AddLn(Strings);
+      S:=Format('Procedure %s.LoadFromMap(Map : TFieldMap);',[ListClassName]);
+      BeginMethod(Strings,S);
+      WriteListLoadFromMap(Strings,Listmode,ObjectClassName,ListClassName);
+      EndMethod(Strings,S);
+      end;
+    AddLn(Strings);
+    S:=Format('Procedure %s.LoadFromDataset(Dataset : TDataset);',[ListClassName]);
+    BeginMethod(Strings,S);
+    WriteListLoadFromDataset(Strings,Listmode,ObjectClassName,ListClassName);
+    EndMethod(Strings,S);
+    end;
+end;
+
+procedure TDDDBCollCodeGenerator.WriteListLoadFromMap(Strings : TStrings; ListMode : TListMode; Const ObjectClassName,ListClassName : String);
+
+begin
+  WriteListLoad(Strings,ListMode,ObjectClassName,ListClassName,True);
+end;
+
+procedure TDDDBCollCodeGenerator.WriteListLoadFromDataset(Strings : TStrings; ListMode : TListMode; Const ObjectClassName,ListClassName : String);
+
+
+Var
+  M : String;
+
+begin
+  If Not DBCollOptions.UseFieldMap then
+    WriteListLoad(Strings,ListMode,ObjectClassName,ListClassName,False)
+  else
+    begin
+    M:=DBCollOptions.MapClassName;
+    AddLn(Strings);
+    AddLn(Strings,'Var');
+    IncIndent;
+    try
+      AddLn(Strings,'Map : %s;',[M]);
+    Finally
+      DecIndent;
+    end;
+    AddLn(Strings);
+    AddLn(Strings,'begin');
+    IncIndent;
+    try
+      AddLn(Strings,'Map:=%s.Create(Dataset);',[M]);
+      AddLn(Strings,'Try');
+      IncIndent;
+      try
+        AddLn(Strings,'LoadFromMap(Map);');
+      finally
+        DecIndent;
+      end;
+      AddLn(Strings,'Finally');
+      IncIndent;
+      try
+        AddLn(Strings,'FreeAndNil(Map);');
+      finally
+        DecIndent;
+      end;
+      AddLn(Strings,'end;');
+    finally
+      DecIndent;
+    end;
+    end;
+end;
+
+procedure TDDDBCollCodeGenerator.WriteListLoad(Strings : TStrings; ListMode : TListMode; Const ObjectClassName,ListClassName : String; FromMap : Boolean);
+
+begin
+  AddLn(Strings);
+  AddLn(Strings,'Var');
+  IncIndent;
+  try
+    AddLn(Strings,'Obj : %s;',[ObjectClassName]);
+  Finally
+    DecIndent;
+  end;
+  AddLn(Strings);
+  AddLn(Strings,'begin');
+  IncIndent;
+  try
+    If FromMap then
+      begin
+      AddLn(Strings,'With Map do');
+      IncIndent;
+      end;
+    Try
+      AddLn(Strings,'While not Dataset.EOF do');
+      IncIndent;
+      Try
+        AddLn(Strings,'begin');
+        WriteListCreateObject(Strings,ListMode,'Obj',ObjectClassName);
+        AddLn(Strings,'Try');
+        IncIndent;
+        Try
+          If FromMap then
+            AddLn(Strings,'LoadObject(Obj);')
+          else
+            AddLn(Strings,'Obj.LoadFromDataset(Dataset);');
+          WriteListAddObject(Strings,ListMode,'Obj',ObjectClassName);
+        Finally
+          DecIndent;
+        end;
+        AddLn(Strings,'Except');
+        IncIndent;
+        Try
+          AddLn(Strings,'FreeAndNil(Obj);');
+          AddLn(Strings,'Raise;');
+        Finally
+          DecIndent;
+        end;
+        AddLn(Strings,'end;');
+        AddLn(Strings,'Dataset.Next;');
+        AddLn(Strings,'end;');
+      Finally
+        DecIndent;
+      end;
+    finally
+      If FromMap then
+        DecIndent;
+    end;
+  finally
+    DecIndent;
+  end;
+end;
+
+procedure TDDDBCollCodeGenerator.WriteListCreateObject(Strings : TStrings; ListMode : TListMode; Const InstanceName,ObjectClassName : String);
+
+Var
+  S : String;
+
+begin
+  If ListMode in [lmList,lmObjectList] then
+    S:=Format('%s:=%s.Create;',[InstanceName,ObjectClassName])
+  else
+    S:=Format('%s:=Self.Add as %s;',[InstanceName,ObjectClassName]);
+  AddLn(Strings,S);
+end;
+
+procedure TDDDBCollCodeGenerator.WriteListAddObject(Strings : TStrings; ListMode : TListMode; Const InstanceName,ObjectClassName : String);
+
+Var
+  S : String;
+
+begin
+  If ListMode in [lmList,lmObjectList] then
+    begin
+    S:=Format('Add(%s);',[InstanceName]);
+    AddLn(Strings,S);
+    end;
+end;
+
+
+
+
+class function TDDDBCollCodeGenerator.NeedsFieldDefs: Boolean;
+begin
+  Result:=True;
+end;
+
+function TDDDBCollCodeGenerator.CreateOptions: TCodeGeneratorOptions;
+begin
+  Result:=TDBCollOptions.Create;
+end;
+
+
+Initialization
+  RegisterCodeGenerator('DBColl','Simple object/collection for the data',TDDDBCollCodeGenerator);
+  
+Finalization
+  UnRegisterCodeGenerator(TDDDBCollCodeGenerator);
+end.
+

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

@@ -0,0 +1,208 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2007 by Michael Van Canneyt, member of the
+    Free Pascal development team
+
+    Data Dictionary Code Generator Implementation.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit fpcgsqlconst;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpddCodeGen;
+
+Type
+
+  { TDDSQLConstOptions }
+
+  TMode = (mConst,mTStrings);
+  TDDSQLConstOptions = Class(TCodeGeneratorOptions)
+  private
+    FIDent: String;
+    FMode: TMode;
+    procedure SetIdent(const AValue: String);
+  Public
+    Constructor Create; override;
+    Procedure Assign(ASource : TPersistent); override;
+  Published
+    Property Identifier : String Read FIDent Write SetIdent;
+    Property Mode : TMode Read FMode Write FMode;
+  end;
+  
+  
+  { TDDSQLConstGenerator }
+
+  TDDSQLConstGenerator = Class(TDDCustomCodeGenerator)
+  Private
+    FSQL : TStrings;
+  Protected
+    Function CreateOptions : TCodeGeneratorOptions; override;
+    Procedure DoGenerateInterface(Strings: TStrings); override;
+    Procedure DoGenerateImplementation(Strings: TStrings); override;
+    function GetSQL: TStrings; override;
+    procedure SetSQL(const AValue: TStrings); override;
+    Function SQLOptions : TDDSQLConstOptions;
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+    Class Function NeedsSQL : Boolean; override;
+    Class Function NeedsFieldDefs : Boolean; override;
+  end;
+
+Const
+  SSQLConst = 'SQLConst';
+  
+Resourcestring
+  SSQLConstDescr = 'Generate Pascal constant/Stringlist from SQL';
+
+implementation
+
+{ TDDSQLConstOptions }
+
+procedure TDDSQLConstOptions.SetIdent(const AValue: String);
+begin
+  if FIDent=AValue then exit;
+  If Not IsValidIdent(AValue) then
+    Raise ECodeGenerator.CreateFmt(SErrInvalidIdentifier,[AValue]);
+  FIDent:=AValue;
+end;
+
+constructor TDDSQLConstOptions.Create;
+begin
+  Inherited;
+  FIdent:='SQL'; // Do not localize
+end;
+
+procedure TDDSQLConstOptions.Assign(ASource: TPersistent);
+
+Var
+  CO: TDDSQLConstOptions;
+  
+begin
+  If ASource is TDDSQLConstOptions then
+    begin
+    CO:=ASource as TDDSQLConstOptions;
+    FIDent:=CO.FIdent;
+    FMode:=CO.FMode;
+    end;
+  inherited Assign(ASource);
+end;
+
+{ TDDSQLConstGenerator }
+
+function TDDSQLConstGenerator.CreateOptions: TCodeGeneratorOptions;
+begin
+  Result:=TDDSQLConstOptions.Create;
+end;
+
+procedure TDDSQLConstGenerator.DoGenerateInterface(Strings: TStrings);
+
+Var
+  S : String;
+  I,L : Integer;
+  
+begin
+  If (SQLOptions.Mode=mConst) then
+    begin
+    Addln(Strings,'Const');
+    L:=Length(SQLOPtions.Identifier);
+    IncIndent;
+    try
+      For I:=0 to FSQL.Count-1 do
+        begin
+        If (I=0) then
+          S:=SQLOPtions.Identifier+' = '
+        else
+          S:=StringOfChar(' ',L)+'   +';
+        S:=S+CreateString(FSQL[i]);
+        If (I=FSQL.Count-1) then
+          S:=S+';'
+        else
+          S:=S+'+sLineBreak';
+        Addln(Strings,S);
+        end;
+    finally
+      DecIndent;
+    end;
+    end;
+end;
+
+procedure TDDSQLConstGenerator.DoGenerateImplementation(Strings: TStrings);
+
+Var
+  S : String;
+  I,L : Integer;
+
+begin
+  If (SQLOptions.Mode=mTStrings) then
+    begin
+    Addln(Strings,'With %s do',[SQLOPtions.Identifier]);
+    IncIndent;
+    try
+      Addln(Strings,'begin');
+      For I:=0 to FSQL.Count-1 do
+        Addln(Strings,'Add(%s);',[CreateString(FSQL[i])]);
+      Addln(Strings,'end;');
+    finally
+      DecIndent;
+    end;
+    end;
+end;
+
+function TDDSQLConstGenerator.GetSQL: TStrings;
+begin
+  Result:=FSQL;
+end;
+
+procedure TDDSQLConstGenerator.SetSQL(const AValue: TStrings);
+begin
+  FSQL.Assign(AValue);
+end;
+
+function TDDSQLConstGenerator.SQLOptions: TDDSQLConstOptions;
+begin
+  Result:=CodeOptions as TDDSQLConstOptions;
+end;
+
+constructor TDDSQLConstGenerator.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FSQL:=TSTringList.Create;
+end;
+
+destructor TDDSQLConstGenerator.Destroy;
+begin
+  FreeAndNil(FSQL);
+  inherited Destroy;
+end;
+
+class function TDDSQLConstGenerator.NeedsSQL: Boolean;
+begin
+  Result:=True;
+end;
+
+class function TDDSQLConstGenerator.NeedsFieldDefs: Boolean;
+begin
+  Result:=False;
+end;
+
+
+Initialization
+  RegisterCodeGenerator(SSQLConst, SSQLConstDescr, TDDSQLConstGenerator);
+  
+Finalization
+  UnRegisterCodeGenerator(TDDSQLConstGenerator);
+
+end.
+

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

@@ -0,0 +1,732 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2007 by Michael Van Canneyt, member of the
+    Free Pascal development team
+
+    Data Dictionary Code Generator Implementation.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit fpcgtiopf;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, db, fpddcodegen;
+  
+TYpe
+  TClassOption = (caConstructor,caDestructor,caCreateList,caListAddMethod,caListItemsProperty);
+  TClassOptions = Set of TClassOption;
+  TVisitorOption = (voRead,voReadList,voCreate,voDelete,voUpdate);
+  TVisitorOptions = set of TVisitorOption;
+  
+  { TTiOPFCodeOptions }
+
+  TTiOPFCodeOptions = Class (TClassCodeGeneratorOptions)
+  Private
+    FClassOptions: TClassOptions;
+    FListAncestorName: String;
+    FListClassName : String;
+    FVisitorOptions: TVisitorOptions;
+    function GetListClassName: String;
+    procedure SetListAncestorName(const AValue: String);
+    procedure SetListClassName(const AValue: String);
+  Public
+    Constructor Create; override;
+    Procedure Assign(ASource : TPersistent); override;
+  Published
+    Property ClassOptions : TClassOptions Read FClassOptions Write FClassOptions;
+    Property VisitorOptions : TVisitorOptions Read FVisitorOptions Write FVisitorOptions;
+    Property ListAncestorName : String Read FListAncestorName Write SetListAncestorName;
+    Property ListClassName : String Read GetListClassName Write SetListClassName;
+    Property AncestorClass;
+  end;
+  
+  { TTiOPFCodeGenerator }
+
+  TTiOPFCodeGenerator = Class(TDDClassCodeGenerator)
+    procedure CreateListImplementation(Strings: TStrings; const ObjectClassName, ListClassName: String);
+    function BeginInit(Strings: TStrings; const AClass: String): String;
+    function BeginAcceptVisitor(Strings: TStrings; const AClass, ObjectClassName: String): String;
+    function BeginSetupParams(Strings: TStrings; const AClass,ObjectClassName: String; DeclareObject : Boolean): String;
+    function BeginMapRowToObject(Strings: TStrings; const AClass, ObjectClassName : String): String;
+    procedure DeclareObjectvariable(Strings: TStrings;
+      const ObjectClassName: String);
+  private
+    function GetOpt: TTiOPFCodeOptions;
+    procedure WriteCreateVisitor(Strings: TStrings; const ObjectClassName: String);
+    procedure WriteDeleteVisitor(Strings: TStrings; const ObjectClassName: String);
+    procedure WriteFieldAssign(Strings: TStrings; F: TFieldPropDef);
+    procedure WriteParamAssign(Strings: TStrings; F: TFieldPropDef);
+    procedure WriteReadListVisitor(Strings: TStrings; const ObjectClassName: String);
+    procedure WriteReadVisitor(Strings: TStrings; const ObjectClassName: String );
+    procedure WriteUpdateVisitor(Strings: TStrings; const ObjectClassName: String);
+    procedure WriteVisitorDeclaration(Strings: TStrings; V: TVisitorOption; const ObjectClassName: String);
+    procedure WriteVisitorImplementation(Strings: TStrings; V: TVisitorOption; const ObjectClassName: String);
+  Protected
+    // Not to be overridden.
+    procedure WriteListAddObject(Strings: TStrings; const ListClassName, ObjectClassName: String);
+    // Overrides of parent objects
+    Function GetInterfaceUsesClause : string; override;
+    Procedure DoGenerateInterface(Strings: TStrings); override;
+    Procedure DoGenerateImplementation(Strings: TStrings); override;
+    Function NeedsConstructor : Boolean; override;
+    Function NeedsDestructor : Boolean; override;
+    Class Function NeedsFieldDefs : Boolean; override;
+    Function CreateOptions : TCodeGeneratorOptions; override;
+    //
+    //  New methods
+    //
+    // Override to add declarations to list declaration
+    procedure DoCreateListDeclaration(Strings: TStrings; const ObjectClassName, ListClassName, ListAncestorName: String); virtual;
+  Public
+    procedure CreateListDeclaration(Strings: TStrings; const ObjectClassName, ListClassName, ListAncestorName: String);
+    Property TiOPFOptions : TTiOPFCodeOptions Read GetOpt;
+  end;
+
+implementation
+
+{ TTiOPFCodeOptions }
+
+function TTiOPFCodeOptions.GetListClassName: String;
+begin
+  Result:=FListClassName;
+  If (Result='') then
+    Result:=ObjectClassName+'List';
+end;
+
+procedure TTiOPFCodeOptions.SetListAncestorName(const AValue: String);
+begin
+  CheckIdentifier(AValue,False);
+  FListAncestorName:=AValue;
+end;
+
+procedure TTiOPFCodeOptions.SetListClassName(const AValue: String);
+begin
+  CheckIdentifier(AValue,True);
+  FListClassName:=AValue;
+end;
+
+constructor TTiOPFCodeOptions.Create;
+begin
+  inherited Create;
+  FListAncestorName:='TObjectList';
+  AncestorClass:='TTiObject';
+  ObjectClassName:='MyObject';
+  FVisitorOptions:=[voRead,voCreate,voDelete,voUpdate];
+  FClassOptions:=[caCreateList,caListAddMethod,caListItemsProperty];
+end;
+
+procedure TTiOPFCodeOptions.Assign(ASource: TPersistent);
+
+Var
+  OC : TTiOPFCodeOptions;
+  
+begin
+  If ASource is TTiOPFCodeOptions then
+    begin
+    OC:=ASource as TTiOPFCodeOptions;
+    FListAncestorName:=OC.FListAncestorName;
+    AncestorClass:=OC.AncestorClass;
+    FVisitorOptions:=OC.FVisitorOptions;
+    FClassOptions:=OC.FClassOptions;
+    end;
+  inherited Assign(ASource);
+end;
+
+{ TTiOPFCodeGenerator }
+
+{ ---------------------------------------------------------------------
+  General overrides
+  ---------------------------------------------------------------------}
+
+function TTiOPFCodeGenerator.NeedsConstructor: Boolean;
+begin
+  Result:=inherited NeedsConstructor;
+  Result:=Result or (caConstructor in TiOPFOptions.ClassOptions);
+end;
+
+function TTiOPFCodeGenerator.NeedsDestructor: Boolean;
+begin
+  Result:=inherited NeedsDestructor;
+  Result:=Result or (caDestructor in TiOPFOptions.ClassOptions);
+end;
+
+class function TTiOPFCodeGenerator.NeedsFieldDefs: Boolean;
+begin
+  Result:=True;
+end;
+
+function TTiOPFCodeGenerator.CreateOptions: TCodeGeneratorOptions;
+begin
+  Result:=TTiOPFCodeOptions.Create;
+end;
+function TTiOPFCodeGenerator.GetOpt: TTiOPFCodeOptions;
+begin
+  Result:=CodeOptions as TTiOPFCodeOptions;
+end;
+
+function TTiOPFCodeGenerator.GetInterfaceUsesClause: string;
+begin
+  Result:=inherited GetInterfaceUsesClause;
+  If (Result<>'') then
+    Result:=Result+',';
+  Result:=Result+'tiVisitor, tiObject';
+end;
+
+procedure TTiOPFCodeGenerator.DoGenerateInterface(Strings: TStrings);
+
+Var
+  V : TVisitorOption;
+
+begin
+  inherited DoGenerateInterface(Strings);
+  With TiOPFOptions do
+    begin
+    IncIndent;
+    try
+      If caCreateList in ClassOptions then
+        CreateListDeclaration(Strings,ObjectClassName,ListClassName,ListAncestorName);
+      For V:=Low(TVisitorOption) to High(TVisitorOption) do
+        If V in VisitorOptions then
+          WriteVisitorDeclaration(Strings,V,ObjectClassName);
+    Finally
+      DecIndent;
+    end;
+    end;
+end;
+
+Function StripType(S : String) : string;
+
+begin
+  Result:=S;
+  If (Result<>'') and (Result[1]='T') then
+    Delete(Result,1,1);
+end;
+
+procedure TTiOPFCodeGenerator.WriteVisitorDeclaration(Strings : TStrings; V : TVisitorOption; Const ObjectClassName : String);
+
+Var
+  S,T,A : string;
+
+begin
+  Case V of
+    voRead     : S:='Read';
+    voReadList : S:='ReadList';
+    voCreate   : S:='Create';
+    voDelete   : S:='Delete';
+    voUpdate   : S:='Update';
+  end;
+  If V in [voCreate,voDelete,voUpdate] then
+    A:='Update'
+  else
+    A:='Select';
+  S:=Format('T%s%sVisitor',[S,StripType(ObjectClassName)]);
+  AddLn(Strings,'{ %s }',[S]);
+  AddlN(Strings,'%s = Class(TtiVisitor%s)',[S,A]);
+  AddlN(Strings,'Protected');
+  IncIndent;
+  Try
+    AddLn(Strings,'Procedure Init; override;');
+    AddLn(Strings,'Function AcceptVisitor : Boolean; override;');
+    AddLn(Strings,'Procedure SetupParams; override;');
+    If Not (V in [voCreate,voDelete,voUpdate]) then
+      AddLn(Strings,'Procedure MapRowToObject; override;');
+  Finally
+    DecIndent;
+  end;
+  AddlN(Strings,'end;');
+  AddlN(Strings);
+end;
+
+
+procedure TTiOPFCodeGenerator.DoGenerateImplementation(Strings: TStrings);
+
+Var
+  V : TVisitorOption;
+
+begin
+  inherited DoGenerateImplementation(Strings);
+  With TiOPFOptions do
+    begin
+    If caCreateList in ClassOptions then
+      CreateListImplementation(Strings,ObjectClassName,ListClassName);
+    For V:=Low(TVisitorOption) to High(TVisitorOption) do
+      If V in VisitorOptions then
+        WriteVisitorImplementation(Strings,V,ObjectClassName);
+    end;
+end;
+
+{ ---------------------------------------------------------------------
+  Visitor helper routines
+  ---------------------------------------------------------------------}
+
+procedure TTiOPFCodeGenerator.WriteVisitorImplementation(Strings : TStrings; V : TVisitorOption; Const ObjectClassName : String);
+
+begin
+  Case V of
+    voRead     : WriteReadVisitor(Strings,ObjectClassName);
+    voReadList : WriteReadListVisitor(Strings,ObjectClassName);
+    voCreate   : WriteCreateVisitor(Strings,ObjectClassName);
+    voDelete   : WriteDeleteVisitor(Strings,ObjectClassName);
+    voUpdate   : WriteUpdateVisitor(Strings,ObjectClassName);
+  end;
+end;
+
+Function TTiOPFCodeGenerator.BeginInit(Strings : TStrings; const AClass : String) : String;
+
+begin
+  Result:=Format('Procedure %s.Init;',[AClass]);
+  BeginMethod(Strings,Result);
+  AddLn(Strings,'begin');
+  IncIndent;
+end;
+
+Function TTiOPFCodeGenerator.BeginAcceptVisitor(Strings : TStrings; Const AClass, ObjectClassName: String) : String;
+
+begin
+  Result:=Format('Function %s.AcceptVisitor : Boolean;',[AClass]);
+  BeginMethod(Strings,Result);
+  AddLn(Strings,'begin');
+  IncIndent;
+  AddLn(Strings,'Result:=Visited is %s;',[ObjectClassName]);
+end;
+
+Function TTiOPFCodeGenerator.BeginSetupParams(Strings : TStrings; const AClass,ObjectClassName : String; DeclareObject : Boolean) : String;
+
+begin
+  Result:=Format('Procedure %s.SetupParams;',[AClass]);
+  BeginMethod(Strings,Result);
+  If DeclareObject Then
+    DeclareObjectVariable(Strings,ObjectClassName);
+  AddLn(Strings,'begin');
+  If DeclareObject Then
+    Addln(Strings,'O:=%s(Visited);',[ObjectClassName]);
+  IncIndent;
+end;
+
+Procedure TTiOPFCodeGenerator.DeclareObjectvariable(Strings : TStrings; Const ObjectClassName : String);
+
+begin
+  AddLn(Strings,'var');
+  IncIndent;
+  try
+    AddLn(Strings,'O : %s;',[ObjectClassName]);
+    AddLn(Strings);
+  finally
+    DecIndent;
+  end;
+end;
+
+Function TTiOPFCodeGenerator.BeginMapRowToObject(Strings : TStrings; Const AClass,ObjectClassName : String) : String;
+
+begin
+  Result:=Format('Procedure %s.MapRowToObject;',[AClass]);
+  BeginMethod(Strings,Result);
+  DeclareObjectVariable(Strings,ObjectClassName);
+  AddLn(Strings,'begin');
+  IncIndent;
+end;
+
+{ ---------------------------------------------------------------------
+  Read Visitor
+  ---------------------------------------------------------------------}
+
+procedure TTiOPFCodeGenerator.WriteReadVisitor(Strings : TStrings; Const ObjectClassName : String);
+
+Var
+  C,S : String;
+  I : Integer;
+
+begin
+  C:=Format('TRead%sVisitor',[StripType(ObjectClassName)]);
+  Addln(Strings,'{ %s }',[C]);
+  Addln(Strings);
+  // Init
+  S:=BeginInit(Strings,C);
+  Addln(Strings,'Query.SQL.Text:=SQLReadList;');
+  DecIndent;
+  EndMethod(Strings,S);
+  // AcceptVisitor
+  S:=BeginAcceptVisitor(Strings,C,ObjectClassName);
+  DecIndent;
+  EndMethod(Strings,S);
+  // AcceptSetupParams
+  S:=BeginSetupParams(Strings,C,'',False);
+  AddLn(Strings,'// Set up as needed');
+  DecIndent;
+  EndMethod(Strings,S);
+  // MapRowToObject
+  S:=BeginMapRowToObject(Strings,C,ObjectClassName);
+  Addln(Strings,'With Query do',[ObjectClassName]);
+  IncINdent;
+  try
+    Addln(Strings,'begin');
+    For I:=0 to Fields.Count-1 do
+      If Fields[i].Enabled then
+        WriteFieldAssign(Strings,Fields[i]);
+    Addln(Strings,'end');
+  finally
+    DecIndent;
+  end;
+  DecIndent;
+  EndMethod(Strings,S);
+end;
+
+procedure TTiOPFCodeGenerator.WriteFieldAssign(Strings : TStrings; F : TFieldPropDef);
+
+Var
+  PN,FN,SFN,R,S : String;
+
+begin
+  PN:=F.PropertyName;
+  FN:=F.FieldName;
+  SFN:=CreateString(FN);
+  Case F.PropertyType of
+    ptBoolean :
+      S:='AsBoolean';
+    ptShortint, ptByte,
+    ptSmallInt, ptWord,
+    ptLongint, ptCardinal :
+      S:='AsInteger';
+    ptInt64, ptQWord:
+      If F.FieldType=ftLargeInt then
+        R:=Format('O.%s:=(FieldByName(%s) as TLargeIntField).AsLargeInt;',[PN,SFN])
+      else
+        S:='AsInteger';
+    ptShortString, ptAnsiString, ptWideString :
+      S:='AsString';
+    ptSingle, ptDouble, ptExtended, ptComp :
+      S:='AsFloat';
+    ptCurrency :
+      S:='AsCurrency';
+    ptDateTime :
+      S:='AsDateTime';
+    ptEnumerated :
+      R:=Format('Integer(O.%s):=FieldAsInteger[%s];',[PN,SFN]);
+    ptSet :
+      S:=Format('// Add custom set loading code here for %s from %s',[PN,FN]);
+    ptStream :
+      R:=Format('FieldByName(%s).SaveToStream(O.%s);',[SFN,PN]);
+    ptTStrings :
+      R:=Format('O.%s.Text:=FieldAsString[%s];',[PN,SFN]);
+    ptCustom :
+      R:=Format('// Add custom loading code here for %s from %s',[PN,FN]);
+  end;
+  If (S<>'') then
+    R:=Format('O.%s:=Field%s[%s];',[PN,S,SFN]);
+  AddLn(Strings,R);
+end;
+
+procedure TTiOPFCodeGenerator.WriteParamAssign(Strings : TStrings; F : TFieldPropDef);
+
+Var
+  PN,FN,SFN,R,S : String;
+
+begin
+  PN:=F.PropertyName;
+  FN:=F.FieldName;
+  SFN:=CreateString(FN);
+  Case F.PropertyType of
+    ptBoolean :
+      S:='AsBoolean';
+    ptShortint, ptByte,
+    ptSmallInt, ptWord,
+    ptLongint, ptCardinal :
+      S:='AsInteger';
+    ptInt64, ptQWord:
+      If F.FieldType=ftLargeInt then
+        R:=Format('O.%s:=(Name(%s) as TLargeIntField).AsLargeInt;',[PN,SFN])
+      else
+        S:='AsInteger';
+    ptShortString, ptAnsiString, ptWideString :
+      S:='AsString';
+    ptSingle, ptDouble, ptExtended, ptComp :
+      S:='AsFloat';
+    ptCurrency :
+      S:='AsCurrency';
+    ptDateTime :
+      S:='AsDateTime';
+    ptEnumerated :
+      R:=Format('ParamAsInteger[%s]:=Integer(O.%s);',[SFN,PN]);
+    ptSet :
+      S:=Format('// Add custom set loading code here for %s from %s',[PN,FN]);
+    ptStream :
+      R:=Format('AssignParamFromStream(%s,%s);',[SFN,PN]);
+    ptTStrings :
+      R:=Format('ParamAsString[%s]:=O.%s.Text;',[SFN,PN]);
+    ptCustom :
+      R:=Format('// Add custom loading code here for %s from %s',[PN,FN]);
+  end;
+  If (S<>'') then
+    R:=Format('O.%s:=Param%s[%s];',[PN,S,SFN]);
+  AddLn(Strings,R);
+end;
+
+{ ---------------------------------------------------------------------
+  List Read Visitor
+  ---------------------------------------------------------------------}
+
+procedure TTiOPFCodeGenerator.WriteReadListVisitor(Strings : TStrings; Const ObjectClassName : String);
+
+Var
+  C,S,LN : String;
+  I : Integer;
+
+begin
+  LN:=tiOPFOptions.ListClassName;
+  C:=Format('TRead%sVisitor',[StripType(LN)]);
+  Addln(Strings,'{ %s }',[C]);
+  Addln(Strings);
+  // Init
+  S:=BeginInit(Strings,C);
+  Addln(Strings,'Query.SQL.Text:=SQLReadList;');
+  DecIndent;
+  EndMethod(Strings,C);
+  // AcceptVisitor
+  S:=BeginAcceptVisitor(Strings,C,LN);
+  DecIndent;
+  EndMethod(Strings,S);
+  // AcceptSetupParams
+  S:=BeginSetupParams(Strings,C,'',False);
+  DecIndent;
+  EndMethod(Strings,S);
+  // MapRowToObject
+  S:=BeginMapRowToObject(Strings,S,ObjectClassName);
+  Addln(Strings,'O:=%s.Create;',[ObjectClassName]);
+  For I:=0 to Fields.Count-1 do
+    If Fields[i].Enabled then
+      WriteFieldAssign(Strings,Fields[i]);
+  Addln(Strings,'O.ObjectState:=posClean;');
+  Addln(Strings,'%s(Visited).Add(O);',[LN]);
+  DecIndent;
+  EndMethod(Strings,S);
+end;
+
+{ ---------------------------------------------------------------------
+  Create Visitor
+  ---------------------------------------------------------------------}
+
+procedure TTiOPFCodeGenerator.WriteCreateVisitor(Strings : TStrings; Const ObjectClassName : String);
+
+
+Var
+  C,S : String;
+  I : Integer;
+
+begin
+  C:=Format('TCreate%sVisitor',[StripType(ObjectClassName)]);
+  Addln(Strings,'{ %s }',[C]);
+  Addln(Strings);
+  // Init
+  S:=BeginInit(Strings,C);
+  Addln(Strings,'Query.SQL.Text:=SQLCreateObject;');
+  DecIndent;
+  EndMethod(Strings,S);
+  // AcceptVisitor
+  S:=BeginAcceptVisitor(Strings,C,ObjectClassName);
+  AddLn(Strings,'Result:=Result and (Visited.ObjectState=posCreate);');
+  DecIndent;
+  EndMethod(Strings,S);
+  // SetupParams
+  S:=BeginSetupParams(Strings,C,ObjectClassName,True);
+  Addln(Strings,'With Query do',[ObjectClassName]);
+  IncINdent;
+  try
+    Addln(Strings,'begin');
+    For I:=0 to Fields.Count-1 do
+      If Fields[i].Enabled then
+        WriteParamAssign(Strings,Fields[i]);
+    Addln(Strings,'end;');
+  finally
+    DecIndent;
+  end;
+  DecIndent;
+  EndMethod(Strings,S);
+end;
+
+procedure TTiOPFCodeGenerator.WriteDeleteVisitor(Strings : TStrings; Const ObjectClassName : String);
+
+Var
+  C,S : String;
+
+begin
+  C:=Format('TDelete%sVisitor',[StripType(ObjectClassName)]);
+  Addln(Strings,'{ %s }',[C]);
+  // Init
+  S:=BeginInit(Strings,C);
+  Addln(Strings,'Query.SQL.Text:=SQLDeleteObject;');
+  DecIndent;
+  EndMethod(Strings,S);
+  // AcceptVisitor
+  S:=BeginAcceptVisitor(Strings,C,ObjectClassName);
+  AddLn(Strings,'Result:=Result and (Visited.ObjectState=posDelete);');
+  DecIndent;
+  EndMethod(Strings,S);
+  // SetupParams
+  S:=BeginSetupParams(Strings,C,ObjectClassName,True);
+  AddLn(Strings,'// Add parameter setup code here ');
+  DecIndent;
+  EndMethod(Strings,S);
+end;
+
+procedure TTiOPFCodeGenerator.WriteUpdateVisitor(Strings : TStrings; Const ObjectClassName : String);
+
+Var
+  C,S : String;
+  I : Integer;
+
+begin
+  C:=Format('TUpdate%sVisitor',[StripType(ObjectClassName)]);
+  Addln(Strings,'{ %s }',[C]);
+  Addln(Strings);
+  // Init
+  S:=BeginInit(Strings,C);
+  Addln(Strings,'Query.SQL.Text:=SQLUpdateObject;');
+  DecIndent;
+  EndMethod(Strings,S);
+  // AcceptVisitor
+  S:=BeginAcceptVisitor(Strings,C,ObjectClassName);
+  AddLn(Strings,'Result:=Result and (Visited.ObjectState=posUpdate);');
+  DecIndent;
+  EndMethod(Strings,S);
+  // SetupParams
+  S:=BeginSetupParams(Strings,C,ObjectClassName,True);
+  Addln(Strings,'With Query do',[ObjectClassName]);
+  IncINdent;
+  try
+    Addln(Strings,'begin');
+    For I:=0 to Fields.Count-1 do
+      If Fields[i].Enabled then
+        WriteParamAssign(Strings,Fields[i]);
+    Addln(Strings,'end;');
+  finally
+    DecIndent;
+  end;
+  DecIndent;
+  EndMethod(Strings,S);
+end;
+
+
+
+
+{ ---------------------------------------------------------------------
+  List object commands
+  ---------------------------------------------------------------------}
+
+procedure TTiOPFCodeGenerator.DoCreateListDeclaration(Strings: TStrings;
+  const ObjectClassName, ListClassName, ListAncestorName: String);
+begin
+  If caListItemsProperty in tiOPFOptions.ClassOptions then
+    begin
+    AddLn(Strings,'Private');
+    IncIndent;
+    Try
+      AddLn(Strings,'Function GetObj(Index : Integer) : %s;',[ObjectClassname]);
+      AddLn(Strings,'Procedure SetObj(Index : Integer; AValue : %s);',[ObjectClassname]);
+    Finally
+      DecIndent;
+    end;
+    end;
+  If (caListAddMethod in tiOPFOptions.ClassOptions) then
+    begin
+    AddLn(Strings,'Public');
+    IncIndent;
+    Try
+      Addln(Strings,'Procedure Add(AnItem : %s); reintroduce;',[ObjectClassName]);
+    Finally
+      DecIndent;
+    end;
+    end;
+  If (caListItemsProperty in tiOPFOptions.ClassOptions) then
+    begin
+    If Not (caListAddMethod in tiOPFOptions.ClassOptions) then
+      AddLn(Strings,'Public');
+    IncIndent;
+    Try
+      AddLn(Strings,'Property Items[Index : Integer] : %s Read GetObj Write SetObj; Default;',[ObjectClassname]);
+    Finally
+      DecIndent;
+    end;
+    end;
+end;
+
+procedure TTiOPFCodeGenerator.CreateListDeclaration(Strings: TStrings;
+  const ObjectClassName, ListClassName, ListAncestorName: String);
+begin
+  Addln(Strings);
+  Addln(Strings,'{ %s }',[ListClassName]);
+  Addln(Strings);
+  Addln(Strings,'%s = Class(%s)',[ListClassName,ListAncestorName]);
+  DoCreateListDeclaration(Strings,ObjectClassName,ListClassName,ListAncestorName);
+  AddLn(Strings,'end;');
+end;
+
+procedure TTiOPFCodeGenerator.WriteListAddObject(Strings: TStrings;
+  const ListClassName, ObjectClassName: String);
+  
+Var
+  S : String;
+  
+begin
+   S:=Format('Procedure %s.Add(AnItem : %s);',[ListClassName,ObjectClassName]);
+   BeginMethod(Strings,S);
+   Addln(Strings,'begin');
+   IncIndent;
+   try
+     Addln(Strings,'inherited Add(AnItem);');
+   finally
+     DecIndent;
+   end;
+   EndMethod(Strings,S);
+end;
+
+
+procedure TTiOPFCodeGenerator.CreateListImplementation(Strings: TStrings; const ObjectClassName, ListClassName: String);
+
+Var
+  S : String;
+
+begin
+  If caListItemsProperty in tiOPFOptions.ClassOptions then
+    begin
+    AddLn(Strings,'{ %s }',[ListClassName]);
+    AddLn(Strings);
+    S:=Format('Function %s.GetObj(Index : Integer) : %s;',[ListClassName,ObjectClassname]);
+    BeginMethod(Strings,S);
+    AddLn(Strings,'begin');
+    IncIndent;
+    try
+      AddLn(Strings,'Result:=%s(Inherited Items[Index]);',[ObjectClassname]);
+    finally
+      DecIndent;
+    end;
+    EndMethod(Strings,S);
+    S:=Format('Procedure %s.SetObj(Index : Integer; AValue : %s);',[ListClassName,ObjectClassname]);
+    BeginMethod(Strings,S);
+    AddLn(Strings,'begin');
+    IncIndent;
+    try
+      AddLn(Strings,'Inherited Items[Index]:=AValue;');
+    finally
+      DecIndent;
+    end;
+    EndMethod(Strings,S);
+    end;
+end;
+
+Initialization
+  RegisterCodeGenerator('tiOPF','tiOPF class and visitors for the data',TTiOPFCodeGenerator);
+
+Finalization
+  UnRegisterCodeGenerator(TTiOPFCodeGenerator);
+end.
+