unit Unit1; {$mode objfpc}{$H+} // Activate ONE of the following defines for the database system to be used: {.$DEFINE sqlite3} {$DEFINE firebird3} {.$DEFINE postgresql} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, ComCtrls, ZConnection, ZDbcIntfs, VpData, VpBaseDS, VpZeosDs, VpDayView, VpWeekView, VpMonthView, VpTaskList, VpContactGrid, VpResEditDlg, VpContactButtons; type { TForm1 } TForm1 = class(TForm) BtnDeleteRes: TButton; BtnNewRes: TButton; BtnEditRes: TButton; PageControl1: TPageControl; Panel1: TPanel; Panel2: TPanel; Splitter1: TSplitter; Splitter2: TSplitter; Splitter3: TSplitter; TabSheet1: TTabSheet; TabSheet2: TTabSheet; VpContactButtonBar1: TVpContactButtonBar; VpContactGrid1: TVpContactGrid; VpControlLink1: TVpControlLink; VpDayView1: TVpDayView; VpMonthView1: TVpMonthView; VpResourceCombo1: TVpResourceCombo; VpResourceEditDialog1: TVpResourceEditDialog; VpTaskList1: TVpTaskList; VpWeekView1: TVpWeekView; VpZeosDatastore1: TVpZeosDatastore; ZConnection1: TZConnection; procedure BtnDeleteResClick(Sender: TObject); procedure BtnNewResClick(Sender: TObject); procedure BtnEditResClick(Sender: TObject); procedure FormCreate(Sender: TObject); private { private declarations } public { public declarations } end; var Form1: TForm1; implementation {$R *.lfm} uses LazFileUtils; const {$IFDEF sqlite3} DBFILENAME = 'data.db'; {$ENDIF} {$IFDEF firebird3} DBFILENAME = 'data.fdb'; {$ENDIF} {$IFDEF postgresql} DBFILENAME = 'data_pg'; {$ENDIF} { TForm1 } // Adds a new resource procedure TForm1.BtnNewResClick(Sender: TObject); begin VpResourceEditDialog1.AddNewResource; end; procedure TForm1.BtnDeleteResClick(Sender: TObject); var res: TVpResource; begin res := VpControlLink1.Datastore.Resource; if res = nil then exit; if MessageDlg(Format('Do you really want to delete resource "%s"? This will also delete its events, tasks and contacts.', [res.Description]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin VpControlLink1.Datastore.DeleteResource(res); end; end; // Edits the currently selected resource procedure TForm1.BtnEditResClick(Sender: TObject); begin // Open the resource editor dialog, everything is done here. VpResourceEditDialog1.Execute; end; // Setting up the database connection and the datastore. Preselect a resource // in the resource combo. procedure TForm1.FormCreate(Sender: TObject); var errMsg: String = ''; {$IFDEF postgresql} L: TStringList; {$ENDIF} begin try {$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'; ZConnection1.HostName := ''; ZConnection1.TransactIsolationLevel := tiReadCommitted; ZConnection1.Properties.Clear; if not FileExists(ZConnection1.Database) then ZConnection1.Properties.Add( 'CreateNewDatabase=CREATE DATABASE ' + QuotedStr(ZConnection1.Database) + ' USER ' + QuotedStr('SYSDBA') + ' 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; {$IF DEFINED(firebird3) or DEFINED(postgresql)} ZConnection1.Properties.Clear; {$ENDIF} VpZeosDatastore1.Connected := true; if VpZeosDatastore1.Resources.Count > 0 then VpZeosDatastore1.ResourceID := 1; except on E:Exception do begin {$IFDEF sqlite3} errMsg := LineEnding + 'Or copy sqlite3.dll to the exe folder.'; {$ENDIF} {$IFDEF firebird3} errMsg := LineEnding + 'Or copy fbclient.dll to the exe folder.'; {$ENDIF} MessageDlg(E.Message + errMsg, mtError, [mbOK], 0); Close; end; end; end; end.