You've already forked lazarus-ccr
TPlanIt: Fix ZEOS datastore to work with PostgreSQL database and expand datastore example.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8285 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@@ -9,6 +9,7 @@
|
|||||||
</Flags>
|
</Flags>
|
||||||
<SessionStorage Value="InProjectDir"/>
|
<SessionStorage Value="InProjectDir"/>
|
||||||
<Title Value="project1"/>
|
<Title Value="project1"/>
|
||||||
|
<Scaled Value="True"/>
|
||||||
<ResourceType Value="res"/>
|
<ResourceType Value="res"/>
|
||||||
<UseXPManifest Value="True"/>
|
<UseXPManifest Value="True"/>
|
||||||
</General>
|
</General>
|
||||||
@@ -65,9 +66,6 @@
|
|||||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
</SearchPaths>
|
</SearchPaths>
|
||||||
<Linking>
|
<Linking>
|
||||||
<Debugging>
|
|
||||||
<DebugInfoType Value="dsDwarf2Set"/>
|
|
||||||
</Debugging>
|
|
||||||
<Options>
|
<Options>
|
||||||
<Win32>
|
<Win32>
|
||||||
<GraphicApplication Value="True"/>
|
<GraphicApplication Value="True"/>
|
||||||
|
@@ -14,6 +14,7 @@ uses
|
|||||||
|
|
||||||
begin
|
begin
|
||||||
RequireDerivedFormResource := True;
|
RequireDerivedFormResource := True;
|
||||||
|
Application.Scaled:=True;
|
||||||
Application.Initialize;
|
Application.Initialize;
|
||||||
Application.CreateForm(TForm1, Form1);
|
Application.CreateForm(TForm1, Form1);
|
||||||
Application.Run;
|
Application.Run;
|
||||||
|
@@ -5,7 +5,8 @@ unit Unit1;
|
|||||||
// Activate ONE of the following defines for the database system to be used:
|
// Activate ONE of the following defines for the database system to be used:
|
||||||
|
|
||||||
{.$DEFINE sqlite3}
|
{.$DEFINE sqlite3}
|
||||||
{$DEFINE firebird3}
|
{.$DEFINE firebird3}
|
||||||
|
{$DEFINE postgresql}
|
||||||
|
|
||||||
interface
|
interface
|
||||||
|
|
||||||
@@ -68,6 +69,9 @@ const
|
|||||||
{$IFDEF firebird3}
|
{$IFDEF firebird3}
|
||||||
DBFILENAME = 'data.fdb';
|
DBFILENAME = 'data.fdb';
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
{$IFDEF postgresql}
|
||||||
|
DBFILENAME = 'data_pg';
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
{ TForm1 }
|
{ TForm1 }
|
||||||
|
|
||||||
@@ -89,13 +93,17 @@ end;
|
|||||||
procedure TForm1.FormCreate(Sender: TObject);
|
procedure TForm1.FormCreate(Sender: TObject);
|
||||||
var
|
var
|
||||||
errMsg: String = '';
|
errMsg: String = '';
|
||||||
|
{$IFDEF postgresql}
|
||||||
|
L: TStringList;
|
||||||
|
{$ENDIF}
|
||||||
begin
|
begin
|
||||||
try
|
try
|
||||||
ZConnection1.Database := Application.Location + DBFILENAME;
|
|
||||||
{$IFDEF sqlite3}
|
{$IFDEF sqlite3}
|
||||||
ZConnection1.Protocol := 'sqlite';
|
ZConnection1.Database := Application.Location + DBFILENAME;
|
||||||
|
ZConnection1.Protocol := 'sqlite';
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$IFDEF firebird3}
|
{$IFDEF firebird3}
|
||||||
|
ZConnection1.Database := Application.Location + DBFILENAME;
|
||||||
ZConnection1.Protocol := 'firebird';
|
ZConnection1.Protocol := 'firebird';
|
||||||
ZConnection1.User := 'SYSDBA';
|
ZConnection1.User := 'SYSDBA';
|
||||||
ZConnection1.Password := 'masterkey';
|
ZConnection1.Password := 'masterkey';
|
||||||
@@ -109,12 +117,41 @@ begin
|
|||||||
' PASSWORD ' + QuotedStr('masterkey') +
|
' PASSWORD ' + QuotedStr('masterkey') +
|
||||||
' PAGE_SIZE 4096 DEFAULT CHARACTER SET UTF8');
|
' PAGE_SIZE 4096 DEFAULT CHARACTER SET UTF8');
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
{$IFDEF postgresql}
|
||||||
|
ZConnection1.Protocol := 'postgresql';
|
||||||
|
// Adjust the following specifications to your situation:
|
||||||
|
ZConnection1.LibraryLocation := 'C:\Program Files\PostgreSQL\14\bin\libpq.dll';
|
||||||
|
ZConnection1.User := 'postgres';
|
||||||
|
ZConnection1.Password := 'admin';
|
||||||
|
ZConnection1.HostName := 'localhost';
|
||||||
|
ZConnection1.TransactIsolationLevel := tiReadCommitted;
|
||||||
|
ZConnection1.Properties.Clear;
|
||||||
|
// We must connect with the system db first in order to check whether our db already exists.
|
||||||
|
ZConnection1.Database := 'postgres';
|
||||||
|
ZConnection1.Connect;
|
||||||
|
L := TStringList.Create;
|
||||||
|
try
|
||||||
|
L.CaseSensitive := false;
|
||||||
|
ZConnection1.GetCatalogNames(L);
|
||||||
|
if L.IndexOf(DBFILENAME) = -1 then
|
||||||
|
ZConnection1.ExecuteDirect(
|
||||||
|
'CREATE DATABASE ' + DBFILENAME +
|
||||||
|
' WITH' +
|
||||||
|
' OWNER = ' + ZConnection1.User +
|
||||||
|
' ENCODING = ' + QuotedStr('UTF8')
|
||||||
|
);
|
||||||
|
finally
|
||||||
|
L.Free;
|
||||||
|
end;
|
||||||
|
ZConnection1.Disconnect;
|
||||||
|
ZConnection1.Database := DBFILENAME;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
// ZConnection1.Connect; // activate this to test issue #33717
|
// ZConnection1.Connect; // activate this to test issue #33717
|
||||||
|
|
||||||
VpZeosDatastore1.Connection := ZConnection1;
|
VpZeosDatastore1.Connection := ZConnection1;
|
||||||
VpZeosDatastore1.AutoCreate := true;
|
VpZeosDatastore1.AutoCreate := true;
|
||||||
{$IFDEF firebird3}
|
{$IF DEFINED(firebird3) or DEFINED(postgresql)}
|
||||||
ZConnection1.Properties.Clear;
|
ZConnection1.Properties.Clear;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
VpZeosDatastore1.Connected := true;
|
VpZeosDatastore1.Connected := true;
|
||||||
|
@@ -34,6 +34,7 @@ type
|
|||||||
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||||
procedure SetConnected(const AValue: Boolean); override;
|
procedure SetConnected(const AValue: Boolean); override;
|
||||||
procedure SetTableConnections(AConnection: TZConnection);
|
procedure SetTableConnections(AConnection: TZConnection);
|
||||||
|
function TableExists(ATableName: String): Boolean;
|
||||||
function TablesExist: boolean;
|
function TablesExist: boolean;
|
||||||
|
|
||||||
protected
|
protected
|
||||||
@@ -82,19 +83,19 @@ begin
|
|||||||
FAutoCreate := false;
|
FAutoCreate := false;
|
||||||
|
|
||||||
FContactsTable := TZTable.Create(self);
|
FContactsTable := TZTable.Create(self);
|
||||||
FContactsTable.TableName := 'Contacts';
|
FContactsTable.TableName := ContactsTableName;
|
||||||
FContactsTable.UpdateMode := umUpdateAll;
|
FContactsTable.UpdateMode := umUpdateAll;
|
||||||
|
|
||||||
FEventsTable := TZTable.Create(Self);
|
FEventsTable := TZTable.Create(Self);
|
||||||
FEventsTable.TableName := 'Events';
|
FEventsTable.TableName := EventsTableName;
|
||||||
FEventsTable.UpdateMode := umUpdateAll;
|
FEventsTable.UpdateMode := umUpdateAll;
|
||||||
|
|
||||||
FResourceTable := TZTable.Create(self);
|
FResourceTable := TZTable.Create(self);
|
||||||
FResourceTable.TableName := 'Resources';
|
FResourceTable.TableName := ResourceTableName;
|
||||||
FResourceTable.UpdateMode := umUpdateAll;
|
FResourceTable.UpdateMode := umUpdateAll;
|
||||||
|
|
||||||
FTasksTable := TZTable.Create(self);
|
FTasksTable := TZTable.Create(self);
|
||||||
FTasksTable.TableName := 'Tasks';
|
FTasksTable.TableName := TasksTableName;
|
||||||
FTasksTable.UpdateMode := umUpdateAll;
|
FTasksTable.UpdateMode := umUpdateAll;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -158,10 +159,10 @@ begin
|
|||||||
SetTableConnections(FConnection);
|
SetTableConnections(FConnection);
|
||||||
end;
|
end;
|
||||||
FConnection.Connected := true;
|
FConnection.Connected := true;
|
||||||
if not FContactsTable.Exists then CreateTable(ContactsTableName);
|
if not TableExists(ContactsTableName) then CreateTable(ContactsTableName);
|
||||||
if not FEventsTable.Exists then CreateTable(EventsTableName);
|
if not TableExists(EventsTableName) then CreateTable(EventsTableName);
|
||||||
if not FResourceTable.Exists then CreateTable(ResourceTableName);
|
if not TableExists(ResourceTableName) then CreateTable(ResourceTableName);
|
||||||
if not FTasksTable.Exists then CreateTable(TasksTableName);
|
if not TableExists(TasksTableName) then CreateTable(TasksTableName);
|
||||||
finally
|
finally
|
||||||
FConnection.Connected := wasConnected;
|
FConnection.Connected := wasConnected;
|
||||||
end;
|
end;
|
||||||
@@ -681,6 +682,24 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TVpZeosDatastore.TableExists(ATableName: String): Boolean;
|
||||||
|
var
|
||||||
|
L: TStringList;
|
||||||
|
begin
|
||||||
|
Result := false;
|
||||||
|
if not FConnection.Connected then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
L := TStringList.Create;
|
||||||
|
try
|
||||||
|
L.CaseSensitive := false;
|
||||||
|
FConnection.GetTableNames('', L);
|
||||||
|
Result := L.IndexOf(ATablename) <> -1;;
|
||||||
|
finally
|
||||||
|
L.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
function TVpZeosDatastore.TablesExist: Boolean;
|
function TVpZeosDatastore.TablesExist: Boolean;
|
||||||
var
|
var
|
||||||
L: TStringList;
|
L: TStringList;
|
||||||
|
Reference in New Issue
Block a user