lazarus-ccr/components/tvplanit/examples/datastores/zeos/unit1.pas

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.