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

components/tvplanit/examples/datastores/zeos/project1.lpi

@@ -9,6 +9,7 @@
       </Flags>
       <SessionStorage Value="InProjectDir"/>
       <Title Value="project1"/>
+      <Scaled Value="True"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
     </General>
@@ -65,9 +66,6 @@
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
     <Linking>
-      <Debugging>
-        <DebugInfoType Value="dsDwarf2Set"/>
-      </Debugging>
       <Options>
         <Win32>
           <GraphicApplication Value="True"/>

components/tvplanit/examples/datastores/zeos/project1.lpr

@@ -14,6 +14,7 @@ uses
 
 begin
   RequireDerivedFormResource := True;
+  Application.Scaled:=True;
   Application.Initialize;
   Application.CreateForm(TForm1, Form1);
   Application.Run;

components/tvplanit/examples/datastores/zeos/unit1.pas

@@ -5,7 +5,8 @@ unit Unit1;
 // Activate ONE of the following defines for the database system to be used:
 
 {.$DEFINE sqlite3}
-{$DEFINE firebird3}
+{.$DEFINE firebird3}
+{$DEFINE postgresql}
 
 interface
 
@@ -68,6 +69,9 @@ const
   {$IFDEF firebird3}
   DBFILENAME = 'data.fdb';
   {$ENDIF}
+  {$IFDEF postgresql}
+  DBFILENAME = 'data_pg';
+  {$ENDIF}
 
 { TForm1 }
 
@@ -89,13 +93,17 @@ end;
 procedure TForm1.FormCreate(Sender: TObject);
 var
   errMsg: String = '';
+  {$IFDEF postgresql}
+  L: TStringList;
+  {$ENDIF}
 begin
   try
-    ZConnection1.Database := Application.Location + DBFILENAME;
     {$IFDEF sqlite3}
+    ZConnection1.Database := Application.Location + DBFILENAME;
     ZConnection1.Protocol := 'sqlite';
     {$ENDIF}
     {$IFDEF firebird3}
+    ZConnection1.Database := Application.Location + DBFILENAME;
     ZConnection1.Protocol := 'firebird';
     ZConnection1.User := 'SYSDBA';
     ZConnection1.Password := 'masterkey';
@@ -109,12 +117,41 @@ begin
         ' PASSWORD ' + QuotedStr('masterkey') +
         ' PAGE_SIZE 4096 DEFAULT CHARACTER SET UTF8');
     {$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
 
     VpZeosDatastore1.Connection := ZConnection1;
     VpZeosDatastore1.AutoCreate := true;
-    {$IFDEF firebird3}
+    {$IF DEFINED(firebird3) or DEFINED(postgresql)}
     ZConnection1.Properties.Clear;
     {$ENDIF}
     VpZeosDatastore1.Connected := true;

components/tvplanit/source/addons/zeos/vpzeosds.pas

@@ -34,6 +34,7 @@ type
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
     procedure SetConnected(const AValue: Boolean); override;
     procedure SetTableConnections(AConnection: TZConnection);
+    function TableExists(ATableName: String): Boolean;
     function TablesExist: boolean;
 
   protected
@@ -82,19 +83,19 @@ begin
   FAutoCreate := false;
 
   FContactsTable := TZTable.Create(self);
-  FContactsTable.TableName := 'Contacts';
+  FContactsTable.TableName := ContactsTableName;
   FContactsTable.UpdateMode := umUpdateAll;
 
   FEventsTable := TZTable.Create(Self);
-  FEventsTable.TableName := 'Events';
+  FEventsTable.TableName := EventsTableName;
   FEventsTable.UpdateMode := umUpdateAll;
 
   FResourceTable := TZTable.Create(self);
-  FResourceTable.TableName := 'Resources';
+  FResourceTable.TableName := ResourceTableName;
   FResourceTable.UpdateMode := umUpdateAll;
 
   FTasksTable := TZTable.Create(self);
-  FTasksTable.TableName := 'Tasks';
+  FTasksTable.TableName := TasksTableName;
   FTasksTable.UpdateMode := umUpdateAll;
 end;
 
@@ -158,10 +159,10 @@ begin
       SetTableConnections(FConnection);
     end;
     FConnection.Connected := true;
-    if not FContactsTable.Exists then CreateTable(ContactsTableName);
-    if not FEventsTable.Exists then CreateTable(EventsTableName);
-    if not FResourceTable.Exists then CreateTable(ResourceTableName);
-    if not FTasksTable.Exists then CreateTable(TasksTableName);
+    if not TableExists(ContactsTableName) then CreateTable(ContactsTableName);
+    if not TableExists(EventsTableName) then CreateTable(EventsTableName);
+    if not TableExists(ResourceTableName) then CreateTable(ResourceTableName);
+    if not TableExists(TasksTableName) then CreateTable(TasksTableName);
   finally
     FConnection.Connected := wasConnected;
   end;
@@ -681,6 +682,24 @@ begin
   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;
 var
   L: TStringList;