paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 23:49:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Initial implementation of data dictionary functionality

Browse Source 
git-svn-id: trunk@9175 -
This commit is contained in:
michael 2007-11-10 17:27:12 +00:00
parent fdb033097a
commit 422b5d916b
17 changed files with 5411 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
.gitattributes vendored
View File

@ -3958,6 +3958,22 @@ packages/fcl-db/src/README -text
packages/fcl-db/src/bufdataset.pas svneol=native#text/plain packages/fcl-db/src/bufdataset.pas svneol=native#text/plain
packages/fcl-db/src/bufdataset_parser.pp svneol=native#text/plain packages/fcl-db/src/bufdataset_parser.pp svneol=native#text/plain
packages/fcl-db/src/database.inc svneol=native#text/plain packages/fcl-db/src/database.inc 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/datadict/buildd.lpr svneol=native#text/plain
packages/fcl-db/src/datadict/fpdatadict.pp svneol=native#text/plain
packages/fcl-db/src/datadict/fpdddbf.pp svneol=native#text/plain
packages/fcl-db/src/datadict/fpddfb.pp svneol=native#text/plain
packages/fcl-db/src/datadict/fpddmysql40.pp svneol=native#text/plain
packages/fcl-db/src/datadict/fpddmysql41.pp svneol=native#text/plain
packages/fcl-db/src/datadict/fpddmysql50.pp svneol=native#text/plain
packages/fcl-db/src/datadict/fpddodbc.pp svneol=native#text/plain
packages/fcl-db/src/datadict/fpddoracle.pp svneol=native#text/plain
packages/fcl-db/src/datadict/fpddpq.pp svneol=native#text/plain
packages/fcl-db/src/datadict/fpddregstd.pp svneol=native#text/plain
packages/fcl-db/src/datadict/fpddsqldb.pp svneol=native#text/plain
packages/fcl-db/src/datadict/fpddsqlite3.pp svneol=native#text/plain
packages/fcl-db/src/dataset.inc svneol=native#text/plain packages/fcl-db/src/dataset.inc svneol=native#text/plain
packages/fcl-db/src/datasource.inc svneol=native#text/plain packages/fcl-db/src/datasource.inc svneol=native#text/plain
packages/fcl-db/src/db.pas svneol=native#text/plain packages/fcl-db/src/db.pas svneol=native#text/plain

2150
packages/fcl-db/src/datadict/Makefile Normal file
View File

File diff suppressed because it is too large Load Diff

23
packages/fcl-db/src/datadict/Makefile.fpc Normal file
View File

@ -0,0 +1,23 @@
#
# Makefile.fpc for SQL FCL db units
#
[package]
main=fcl-db
[target]
units=fpdatadict fpddfb fpddsqldb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc \
fpddpq fpddoracle fpddsqlite3 fpddregstd
rsts=fpdatadict fpddfb fpddsqldb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc \
fpddpq fpddoracle fpddsqlite3 fpddregstd
[compiler]
options=-S2h
[install]
fpcpackage=y
[default]
fpcdir=../../../..
[rules]

104
packages/fcl-db/src/datadict/buildd.lpi Normal file
View File

@ -0,0 +1,104 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="/"/>
<Version Value="6"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=""/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<Units Count="13">
<Unit0>
<Filename Value="buildd.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="buildd"/>
</Unit0>
<Unit1>
<Filename Value="fpddsqldb.pp"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpddsqldb"/>
</Unit1>
<Unit2>
<Filename Value="fpdatadict.pp"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpdatadict"/>
</Unit2>
<Unit3>
<Filename Value="fpdddbf.pp"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpddDbf"/>
</Unit3>
<Unit4>
<Filename Value="fpddfb.pp"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpddfb"/>
</Unit4>
<Unit5>
<Filename Value="fpddmysql40.pp"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpddmysql40"/>
</Unit5>
<Unit6>
<Filename Value="fpddmysql41.pp"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpddmysql41"/>
</Unit6>
<Unit7>
<Filename Value="fpddmysql50.pp"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpddmysql50"/>
</Unit7>
<Unit8>
<Filename Value="fpddpq.pp"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpddpq"/>
</Unit8>
<Unit9>
<Filename Value="fpddodbc.pp"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpddodbc"/>
</Unit9>
<Unit10>
<Filename Value="fpddoracle.pp"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpddoracle"/>
</Unit10>
<Unit11>
<Filename Value="fpddsqlite3.pp"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpddsqlite3"/>
</Unit11>
<Unit12>
<Filename Value="fpddregstd.pp"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpddregstd"/>
</Unit12>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

12
packages/fcl-db/src/datadict/buildd.lpr Normal file
View File

@ -0,0 +1,12 @@
program buildd;
uses
Classes
{ you can add units after this }, fpddsqldb, fpdatadict, fpdddbf, fpddfb,
fpddmysql40, fpddmysql41, fpddmysql50, fpddpq, fpddodbc, fpddoracle,
fpddsqlite3, fpddregstd;
begin
end.

1938
packages/fcl-db/src/datadict/fpdatadict.pp Normal file
View File

File diff suppressed because it is too large Load Diff

184
packages/fcl-db/src/datadict/fpdddbf.pp Normal file
View File

@ -0,0 +1,184 @@
{
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
DBF Data Dictionary Engine 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 fpddDbf;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, db,dbf, fpdatadict;
Type
{ TDBFDDimporter }
{ TDBFDDEngine }
TDBFDDEngine = Class(TFPDDEngine)
Private
FDBF : TDBF;
Public
Procedure Disconnect ; override;
Function Connect(const AConnectString : String) : Boolean; override;
Function GetTableList(List : TStrings) : Integer; override;
Function ImportFields(Table : TDDTableDef) : Integer; override;
Function ViewTable(Const TableName: String; DatasetOwner : TComponent) : TDataset; override;
Function GetTableIndexDefs(ATableName : String; Defs : TDDIndexDefs) : integer ; override;
Class function Description : string; override;
Class function DBType : String; override;
Class function EngineCapabilities : TFPDDEngineCapabilities; override;
end;
Procedure InitDBFImporter;
Procedure DoneDBFImporter;
implementation
uses dbf_idxfile;
procedure TDBFDDEngine.Disconnect;
begin
FConnectString:='';
FConnected:=False;
FreeAndNil(FDBF);
end;
function TDBFDDEngine.Connect(const AConnectString : String): Boolean;
begin
FDBF:=TDBF.Create(Self);
FDBF.FilePath:=AConnectString;
FConnected:=True;
FConnectString:=AConnectString;
Result:=True;
end;
Function TDBFDDEngine.GetTableList(List: TStrings) : Integer;
Var
Info : TSearchrec;
FN : String;
begin
Result:=0;
If Assigned(FDBF) then
begin
FN:=IncludeTrailingPathDelimiter(FDBF.FilePath);
If FindFirst(FN+'*.dbf',0,Info)=0 then
try
Repeat
inc(Result);
If Assigned(List) then
List.Add(info.name);
Until (FindNext(Info)<>0);
finally
FindClose(Info);
end;
end;
end;
Function TDBFDDEngine.ImportFields(Table: TDDTableDef) : Integer;
begin
Result:=0;
if Assigned(FDBF) then
begin
FDBF.TableName:=Table.TableName;
FDBF.Open;
Try
Table.ImportFromDataset(FDBF);
Finally
FDBF.Close;
end;
end;
end;
function TDBFDDEngine.ViewTable(const TableName: String;
DatasetOwner: TComponent): TDataset;
Var
D : TDBF;
begin
If DatasetOwner=Nil then
DatasetOwner:=Self;
D:=TDBF.Create(DatasetOwner);
D.FilePath:=FDBF.FilePath;
D.TableName:=TableName;
Result:=D;
end;
function TDBFDDEngine.GetTableIndexDefs(ATableName: String; Defs: TDDIndexDefs
): integer;
Var
D : TDBF;
DBD : TDBFIndexDef;
DD : TDDIndexDef;
I : Integer;
begin
D:=TDBF.Create(Self);
Try
D.FilePath:=FDBF.FilePath;
D.TableName:=ATableName;
D.IndexDefs.Update;
Defs.Clear;
For I:=0 to D.IndexDefs.Count-1 do
begin
DBD:=D.IndexDefs[i];
DD:=Defs.AddDDIndexDef(DBD.Name);
DD.Fields:=DBD.SortField;
DD.Options:=DBD.Options;
end;
Result:=Defs.Count;
Finally
D.Free;
end;
end;
Class function TDBFDDEngine.Description: string;
begin
Result:='DBase database dictionary importer';
end;
class function TDBFDDEngine.DBType: String;
begin
Result:='DBase files';
end;
class function TDBFDDEngine.EngineCapabilities: TFPDDEngineCapabilities;
begin
Result:=[ecImport,ecViewTable];
end;
Procedure InitDBFImporter;
begin
RegisterDictionaryEngine(TDBFDDEngine);
end;
Procedure DoneDBFImporter;
begin
UnRegisterDictionaryEngine(TDBFDDEngine);
end;
Initialization
InitDBFImporter;
Finalization
DoneDBFImporter;
end.

79
packages/fcl-db/src/datadict/fpddfb.pp Normal file
View File

@ -0,0 +1,79 @@
{
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
Firebird/Interbase Data Dictionary Engine 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 fpddfb;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, sqldb, fpdatadict, fpddsqldb;
Type
{ TSQLDBFBDDEngine }
TSQLDBFBDDEngine = Class(TSQLDBDDEngine)
Protected
Function CreateConnection(AConnectString : String) : TSQLConnection; override;
Public
Class function Description : string; override;
Class function DBType : String; override;
end;
// Backwards compatibility
TSQLDBIBDDEngine = TSQLDBFBDDEngine;
Procedure RegisterFBDDEngine;
Procedure UnRegisterFBDDEngine;
implementation
uses ibconnection;
Procedure RegisterFBDDEngine;
begin
RegisterDictionaryEngine(TSQLDBFBDDEngine);
end;
Procedure UnRegisterFBDDEngine;
begin
UnRegisterDictionaryEngine(TSQLDBFBDDEngine);
end;
{ TSQLDBFBDDEngine }
function TSQLDBFBDDEngine.CreateConnection(AConnectString: String
): TSQLConnection;
begin
Result:=TIBConnection.Create(Self);
end;
class function TSQLDBFBDDEngine.Description: string;
begin
Result:='Firebird/Interbase connection using SQLDB';
end;
class function TSQLDBFBDDEngine.DBType: String;
begin
Result:='Firebird/Interbase';
end;
end.

73
packages/fcl-db/src/datadict/fpddmysql40.pp Normal file
View File

@ -0,0 +1,73 @@
{
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
MySQL 4.0 Data Dictionary Engine 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 fpddmysql40;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, sqldb, fpdatadict, fpddsqldb;
Type
{ TSQLDBMySql40DDEngine }
TSQLDBMySql40DDEngine = Class(TSQLDBDDEngine)
Protected
Function CreateConnection(AConnectString : String) : TSQLConnection; override;
Public
Class function Description : string; override;
Class function DBType : String; override;
end;
Procedure RegisterMySQL40DDEngine;
Procedure UnRegisterMySQL40DDEngine;
implementation
uses mysql40conn;
procedure RegisterMySQL40DDEngine;
begin
RegisterDictionaryEngine(TSQLDBMySQL40DDEngine);
end;
procedure UnRegisterMySQL40DDEngine;
begin
UnRegisterDictionaryEngine(TSQLDBMySQL40DDEngine);
end;
{ TSQLDBMySql40DDEngine }
function TSQLDBMySql40DDEngine.CreateConnection(AConnectString: String
): TSQLConnection;
begin
Result:=mysql40conn.TMySQL40Connection.Create(Self);
end;
class function TSQLDBMySql40DDEngine.Description: string;
begin
Result:='Mysql 4.0 connection using SQLDB';
end;
class function TSQLDBMySql40DDEngine.DBType: String;
begin
Result:='MySQL 4.0';
end;
end.

74
packages/fcl-db/src/datadict/fpddmysql41.pp Normal file
View File

@ -0,0 +1,74 @@
{
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
MySQL 4.1 Data Dictionary Engine 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 fpddmysql41;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, sqldb, fpDataDict,fpddsqldb;
Type
{ TSQLDBMySql41DDEngine }
TSQLDBMySql41DDEngine = Class(TSQLDBDDEngine)
Protected
Function CreateConnection(AConnectString : String) : TSQLConnection; override;
Public
Class function Description : string; override;
Class function DBType : String; override;
end;
Procedure RegisterMySQL41DDEngine;
Procedure UnRegisterMySQL41DDEngine;
implementation
uses mysql41conn;
Procedure RegisterMySQL41DDEngine;
begin
RegisterDictionaryEngine(TSQLDBMySQL41DDEngine);
end;
Procedure UnRegisterMySQL41DDEngine;
begin
UnRegisterDictionaryEngine(TSQLDBMySQL41DDEngine);
end;
{ TSQLDBMySql41DDEngine }
function TSQLDBMySql41DDEngine.CreateConnection(AConnectString: String
): TSQLConnection;
begin
Result:=mysql41conn.TMySQL41Connection.Create(Self);
end;
class function TSQLDBMySql41DDEngine.Description: string;
begin
Result:='Mysql 4.1 connection using SQLDB';
end;
class function TSQLDBMySql41DDEngine.DBType: String;
begin
Result:='MySQL 4.1';
end;
end.

74
packages/fcl-db/src/datadict/fpddmysql50.pp Normal file
View File

@ -0,0 +1,74 @@
{
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
MySQL 5.0 Data Dictionary Engine 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 fpddmysql50;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, sqldb, fpdatadict, fpddsqldb;
Type
{ TSQLDBMySql5DDEngine }
TSQLDBMySql5DDEngine = Class(TSQLDBDDEngine)
Protected
Function CreateConnection(AConnectString : String) : TSQLConnection; override;
Public
Class function Description : string; override;
Class function DBType : String; override;
end;
Procedure RegisterMySQL50DDEngine;
Procedure UnRegisterMySQL50DDEngine;
implementation
uses mysql50conn;
Procedure RegisterMySQL50DDEngine;
begin
RegisterDictionaryEngine(TSQLDBMySQL5DDEngine);
end;
Procedure UnRegisterMySQL50DDEngine;
begin
UnRegisterDictionaryEngine(TSQLDBMySQL5DDEngine);
end;
{ TSQLDBMySql5DDEngine }
function TSQLDBMySql5DDEngine.CreateConnection(AConnectString: String
): TSQLConnection;
begin
Result:=mysql50conn.TMySQL50Connection.Create(Self);
end;
class function TSQLDBMySql5DDEngine.Description: string;
begin
Result:='Mysql 5.0 connection using SQLDB';
end;
class function TSQLDBMySql5DDEngine.DBType: String;
begin
Result:='MySQL 5.0';
end;
end.

72
packages/fcl-db/src/datadict/fpddodbc.pp Normal file
View File

@ -0,0 +1,72 @@
{
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
ODBC Data Dictionary Engine 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 fpddodbc;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, sqldb, fpdatadict, fpddsqldb;
Type
{ TSQLDBODBCDDEngine }
TSQLDBODBCDDEngine = Class(TSQLDBDDEngine)
Protected
Function CreateConnection(AConnectString : String) : TSQLConnection; override;
Public
Class function Description : string; override;
Class function DBType : String; override;
end;
Procedure RegisterODBCDDengine;
Procedure UnRegisterODBCDDengine;
implementation
uses odbcconn;
procedure RegisterODBCDDengine;
begin
RegisterDictionaryEngine(TSQLDBODBCDDEngine);
end;
procedure UnRegisterODBCDDengine;
begin
UnRegisterDictionaryEngine(TSQLDBODBCDDEngine);
end;
{ TSQLDBODBCDDEngine }
function TSQLDBODBCDDEngine.CreateConnection(AConnectString: String
): TSQLConnection;
begin
Result:=TODBCConnection.Create(Self);
end;
class function TSQLDBODBCDDEngine.Description: string;
begin
Result:='ODBC connection using SQLDB';
end;
class function TSQLDBODBCDDEngine.DBType: String;
begin
Result:='ODBC';
end;
end.

74
packages/fcl-db/src/datadict/fpddoracle.pp Normal file
View File

@ -0,0 +1,74 @@
{
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
Oracle Data Dictionary Engine 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 fpddoracle;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, sqldb, fpdatadict, fpddsqldb;
Type
{ TSQLDBORACLEEngine }
TSQLDBOracleDDEngine = Class(TSQLDBDDEngine)
Protected
Function CreateConnection(AConnectString : String) : TSQLConnection; override;
Public
Class function Description : string; override;
Class function DBType : String; override;
end;
Procedure RegisterOracleDDEngine;
Procedure UnRegisterOracleDDEngine;
implementation
uses oracleconnection;
procedure RegisterOracleDDEngine;
begin
RegisterDictionaryEngine(TSQLDBORACLEDDEngine);
end;
procedure UnRegisterOracleDDEngine;
begin
UnRegisterDictionaryEngine(TSQLDBORACLEDDEngine);
end;
{ TSQLDBORACLEDDEngine }
function TSQLDBORACLEDDEngine.CreateConnection(AConnectString: String
): TSQLConnection;
begin
Result:=TOracleConnection.Create(Self);
end;
class function TSQLDBORACLEDDEngine.Description: string;
begin
Result:='Oracle connection using SQLDB';
end;
class function TSQLDBORACLEDDEngine.DBType: String;
begin
Result:='Oracle';
end;
end.

72
packages/fcl-db/src/datadict/fpddpq.pp Normal file
View File

@ -0,0 +1,72 @@
{
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
Postgresql Data Dictionary Engine 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 fpddpq;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, sqldb, fpdatadict, fpddsqldb;
Type
{ TSQLDBPostGreSQLDDEngine }
TSQLDBPostGreSQLDDEngine = Class(TSQLDBDDEngine)
Protected
Function CreateConnection(AConnectString : String) : TSQLConnection; override;
Public
Class function Description : string; override;
Class function DBType : String; override;
end;
Procedure RegisterPostgreSQLDDengine;
Procedure UnRegisterPostgreSQLDDengine;
implementation
uses pqconnection;
procedure RegisterPostgreSQLDDengine;
begin
RegisterDictionaryEngine(TSQLDBPostGreSQLDDEngine);
end;
procedure UnRegisterPostgreSQLDDengine;
begin
UnRegisterDictionaryEngine(TSQLDBPostGreSQLDDEngine);
end;
{ TSQLDBPostGreSQLDDEngine }
function TSQLDBPostGreSQLDDEngine.CreateConnection(AConnectString: String
): TSQLConnection;
begin
Result:=TPQConnection.Create(Self);
end;
class function TSQLDBPostGreSQLDDEngine.Description: string;
begin
Result:='PostGreSQL using SQLDB';
end;
class function TSQLDBPostGreSQLDDEngine.DBType: String;
begin
Result:='PostGreSQL';
end;
end.

175
packages/fcl-db/src/datadict/fpddregstd.pp Normal file
View File

@ -0,0 +1,175 @@
{
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
Standard Data Dictionary Engines registration.
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.
**********************************************************************}
{
This unit has a routine and a component to register standard distributed
Data dictionary engines in an application. The Component version is meant for
use in Lazarus: Drop it on a form, set the engines you want to see
registered, and set active to true. When the form is created a run-time,
the selected engines will be registered.
The simple call takes an optional single argument, a set which tells
the call which engines to register. If none is specified, all formats
are registered.
}
unit fpddregstd;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpdatadict;
Type
TDataDictEngine = (teDBF,teFirebird,teOracle,teMySQL40,teMySQL41,teMySQL50,
tePostgreSQL,teSQLite3,teODBC);
TDataDictEngines = set of TDataDictEngine;
Const
AllStdDDEngines = [teDBF,teFirebird,teOracle,teMySQL40,teMySQL41,teMySQL50,
tePostgreSQL,teSQLite3,teODBC];
Type
{ TStandardDDEngines }
TStandardDDEngines = Class(TComponent)
Private
FActive: Boolean;
FRegistered,
FEngines: TDataDictEngines;
procedure SetActive(const AValue: Boolean);
Procedure DoRegister;
Procedure DoUnregister;
Public
Constructor Create(AOwner : TComponent); override;
Procedure Loaded; override;
Published
Property Active : Boolean Read FActive Write SetActive;
Property Engines : TDataDictEngines Read FEngines Write FEngines Default AllStdDDEngines;
end;
Function RegisterStdDDEngines(Engines : TDataDictEngines) : TDataDictEngines; overload;
Function RegisterStdDDEngines : TDataDictEngines; overload;
Function UnRegisterStdDDEngines(Engines : TDataDictEngines) : TDataDictEngines;
implementation
uses
fpdddbf,
fpddfb,
fpddpq,
fpddOracle,
fpddsqlite3,
fpddmysql40,
fpddmysql41,
fpddmysql50,
fpddodbc;
Const
StdEngineClasses : Array [TDataDictEngine] of TFPDDEngineClass
= (TDBFDDEngine, TSQLDBFBDDEngine, TSQLDBOracleDDEngine,
TSQLDBMySql40DDEngine, TSQLDBMySql41DDEngine ,
TSQLDBMySql5DDEngine, TSQLDBPostGreSQLDDEngine,
TSQLDBSQLite3DDEngine,TSQLDBODBCDDEngine);
StdEngineRegs : Array [TDataDictEngine] of procedure
= (@InitDBFImporter, @RegisterFBDDEngine, @RegisterOracleDDEngine,
@RegisterMySQL40DDEngine, @RegisterMySQL41DDEngine,
@RegisterMySQL50DDEngine, @RegisterPostgreSQLDDengine,
@RegisterSQLite3DDEngine, @RegisterODBCDDengine);
StdEngineUnRegs : Array [TDataDictEngine] of procedure
= (@DoneDBFImporter, @UnRegisterFBDDEngine, @UnRegisterOracleDDEngine,
@UnRegisterMySQL40DDEngine, @UnRegisterMySQL41DDEngine,
@UnRegisterMySQL50DDEngine, @UnRegisterPostgreSQLDDengine,
@UnRegisterSQLite3DDEngine, @UnRegisterODBCDDengine);
function RegisterStdDDEngines(Engines: TDataDictEngines): TDataDictEngines;
Var
E : TDataDictEngine;
begin
Result:=[];
For E:=Low(TDataDictEngine) to High(TDataDictEngine) do
If (E in Engines) and (Not IsDictionaryEngineRegistered(StdEngineClasses[E])) then
begin
StdEngineRegs[E];
Include(Result,E);
end;
end;
function RegisterStdDDEngines: TDataDictEngines;
begin
Result:=RegisterStdDDEngines(AllStdDDEngines);
end;
function UnRegisterStdDDEngines(Engines: TDataDictEngines): TDataDictEngines;
Var
E : TDataDictEngine;
begin
Result:=[];
For E:=Low(TDataDictEngine) to High(TDataDictEngine) do
If (E in Engines) and IsDictionaryEngineRegistered(StdEngineClasses[E]) then
begin
StdEngineUnRegs[E];
Include(Result,E);
end;
end;
{ TStandardDDEngines }
procedure TStandardDDEngines.SetActive(const AValue: Boolean);
begin
if FActive=AValue then
exit;
FActive:=AValue;
If Not (csLoading in ComponentState) then
If Active then
DoRegister
else
DoUnregister;
end;
procedure TStandardDDEngines.Loaded;
begin
If FActive then
DoRegister;
end;
procedure TStandardDDEngines.DoRegister;
begin
FRegistered:=RegisterSTDDDengines(FEngines);
end;
procedure TStandardDDEngines.DoUnregister;
begin
UnRegisterSTDDDengines(FRegistered);
end;
constructor TStandardDDEngines.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
end.

219
packages/fcl-db/src/datadict/fpddsqldb.pp Normal file
View File

@ -0,0 +1,219 @@
{
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
SQLDB Data Dictionary Engine common 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 fpddsqldb;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, DB, sqldb, fpdatadict;
Type
{ TSQLDBDDEngine }
TSQLDBDDEngine = Class(TFPDDEngine)
Private
FConn: TSQLConnection;
Protected
Function CreateConnection(AConnectString : String) : TSQLConnection; virtual; abstract;
Function CreateSQLQuery(ADatasetOwner: TComponent) : TSQLQuery;
Property Connection : TSQLConnection Read FConn;
Public
Procedure Disconnect ; override;
Function HostSupported: Boolean; virtual;
Function Connect(const AConnectString : String) : Boolean; override;
Function GetTableList(List : TStrings) : Integer; override;
Function ImportFields(Table : TDDTableDef) : Integer; override;
Function ViewTable(Const TableName: String; DatasetOwner : TComponent) : TDataset; override;
Function RunQuery(SQL : String) : Integer; override;
Function CreateQuery(SQL : String; DatasetOwner : TComponent) : TDataset; override;
Procedure SetQueryStatement(SQL : String; AQuery : TDataset); override;
Function GetTableIndexDefs(ATableName : String; Defs : TDDIndexDefs) : integer ; override;
Class function EngineCapabilities : TFPDDEngineCapabilities; override;
end;
Const
// used in connectionstring
KeyHostName = 'Host';
KeyDatabaseName = 'Database';
KeyUserName = 'User';
KeyPassword = 'Password';
KeyEncode = 'Trivial';
implementation
uses strutils;
Resourcestring
SErrQueryNotSQLQuery = 'Query object "%s" is not a SQL Query';
{ TSQLDBDDEngine }
function TSQLDBDDEngine.HostSupported: Boolean;
begin
Result:=True;
end;
function TSQLDBDDEngine.CreateSQLQuery(ADatasetOwner: TComponent): TSQLQuery;
begin
Result:=TSQLQuery.Create(ADatasetOwner);
Result.DataBase:=FConn;
Result.Transaction:=FConn.TRansaction;
end;
procedure TSQLDBDDEngine.Disconnect;
begin
FreeAndNil(FConn);
FConnectString:='';
FConnected:=False;
end;
function TSQLDBDDEngine.Connect(const AConnectString: String): Boolean;
Var
L : TStringList;
begin
FConn:=CreateConnection(AConnectString);
FConn.Transaction:=TSQLTransaction.Create(FConn);
L:=TStringList.Create;
Try
L.CommaText:=AConnectString;
If HostSupported then
FConn.HostName:=L.Values[KeyHostName];
FConn.DatabaseName:=L.Values[KeyDatabaseName];
FConn.UserName:=L.Values[KeyUserName];
FConn.Password:=XorDecode(KeyEncode,L.Values[KeyPassword]);
FConn.LoginPrompt:=False;
FConn.Connected:=True;
FConnected:=True;
FConnectString:=AConnectString;
Result:=True;
Finally
L.Free;
end;
end;
function TSQLDBDDEngine.GetTableList(List: TStrings): Integer;
begin
FConn.GetTableNames(List,False);
end;
function TSQLDBDDEngine.ImportFields(Table: TDDTableDef): Integer;
Const
SQL = 'SELECT * from %s where (1=0)';
Var
Q : TSQLQuery;
begin
Q:=CreateSQLQuery(Nil);
try
Q.Sql.Text:=Format(SQL,[Table.TableName]);
Q.Open;
try
Result:=Table.ImportFromDataset(Q);
finally
Q.CLose;
end;
finally
Q.Free;
end;
end;
function TSQLDBDDEngine.ViewTable(const TableName: String;
DatasetOwner: TComponent): TDataset;
Var
Q : TSQLQuery;
begin
Q:=CreateSQLQuery(DatasetOwner);
Q.SQL.Text:='SELECT * FROM '+TableName;
Result:=Q;
end;
function TSQLDBDDEngine.RunQuery(SQL: String): Integer;
Var
Q : TSQLQuery;
begin
Q:=CreateSQLQuery(Nil);
Try
Q.SQL.Text:=SQL;
Q.ExecSQL;
Result:=0;
Finally
Q.Free;
end;
end;
function TSQLDBDDEngine.CreateQuery(SQL: String; DatasetOwner: TComponent
): TDataset;
Var
Q : TSQLQuery;
begin
Q:=CreateSQLQuery(Nil);
Result:=Q;
Q.SQL.Text:=SQL;
Q.Open;
end;
procedure TSQLDBDDEngine.SetQueryStatement(SQL: String; AQuery: TDataset);
begin
If Not (AQuery is TSQLQuery) then
Raise EDataDict.CreateFmt(SErrQueryNotSQLQuery,[AQuery.ClassName]);
(AQuery as TSQLQuery).SQL.Text:=SQL;
end;
function TSQLDBDDEngine.GetTableIndexDefs(ATableName: String; Defs: TDDIndexDefs
): integer;
Var
Q : TSQLQuery;
begin
Q:=TSQLQuery.Create(Self);
Try
Q.Database:=FConn;
Q.Transaction:=FConn.Transaction;
Q.SQL.text:=Format('SELECT * FROM %s WHERE (1=2)',[ATAbleName]);
Q.ReadOnly:=False;
Q.Prepare;
Q.IndexDefs.Update;
IndexDefsToDDIndexDefs(Q.IndexDefs,Defs);
Result:=Defs.Count;
finally
Q.Free;
end;
end;
class function TSQLDBDDEngine.EngineCapabilities: TFPDDEngineCapabilities;
begin
Result:=[ecimport,ecViewTable, ecRunQuery, ecTableIndexes];
end;
end.

72
packages/fcl-db/src/datadict/fpddsqlite3.pp Normal file
View File

@ -0,0 +1,72 @@
{
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
SQLite3 Data Dictionary Engine 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 fpddsqlite3;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, sqldb, fpdatadict, fpddsqldb;
Type
{ TSQLDBSQLite3DDEngine }
TSQLDBSQLite3DDEngine = Class(TSQLDBDDEngine)
Protected
Function CreateConnection(AConnectString : String) : TSQLConnection; override;
Public
Class function Description : string; override;
Class function DBType : String; override;
end;
Procedure RegisterSQLite3DDEngine;
Procedure UnRegisterSQLite3DDEngine;
implementation
uses sqlite3conn;
procedure RegisterSQLite3DDEngine;
begin
RegisterDictionaryEngine(TSQLDBSQLITE3DDEngine);
end;
procedure UnRegisterSQLite3DDEngine;
begin
UnRegisterDictionaryEngine(TSQLDBSQLITE3DDEngine);
end;
{ TSQLDBSQLite3DDEngine }
function TSQLDBSQLite3DDEngine.CreateConnection(AConnectString: String
): TSQLConnection;
begin
Result:=TSQLITE3Connection.Create(Self);
end;
class function TSQLDBSQLite3DDEngine.Description: string;
begin
Result:='SQLite 3 database using SQLDB';
end;
class function TSQLDBSQLite3DDEngine.DBType: String;
begin
Result:='SQLITE3';
end;
end.