examples/local-employeedb/ConsoleModeExample.lpr

(*
 *  IBX For Lazarus (Firebird Express)
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2015 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*) 
            
program ConsoleModeExample;

{
  Example Program to demonstrate console mode IBLocal Support.

  Requires Firebird Embedded Server - see readme.txt

  Compile and run the program at the command line console. No
  command line parameters are necessary. Local Database is
  created in default location as "employee2.fdb".

}

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, CustApp
  { you can add units after this }
  ,IBDatabase, IBQuery, IBCMLocalDBSupport, IBSQL;

const
  sqlExample =
'with recursive Depts As (   '+
'Select DEPT_NO, DEPARTMENT, HEAD_DEPT, cast(DEPARTMENT  as VarChar(256)) as DEPT_PATH,'+
'cast(DEPT_NO as VarChar(64)) as DEPT_KEY_PATH '+
'From DEPARTMENT Where HEAD_DEPT is NULL '+
'UNION ALL '+
'Select D.DEPT_NO, D.DEPARTMENT, D.HEAD_DEPT, Depts.DEPT_PATH ||  '' / '' || D.DEPARTMENT as DEPT_PATH,'+
'Depts.DEPT_KEY_PATH || '';'' || D.DEPT_NO as DEPT_KEY_PATH '+
'From DEPARTMENT D '+
'JOIN Depts On D.HEAD_DEPT = Depts.DEPT_NO '+
')'+

'Select First 2 A.EMP_NO, A.FIRST_NAME, A.LAST_NAME, A.PHONE_EXT, A.HIRE_DATE, A.DEPT_NO, A.JOB_CODE,'+
'A.JOB_GRADE, A.JOB_COUNTRY, A.SALARY, A.FULL_NAME, D.DEPT_PATH, D.DEPT_KEY_PATH '+
'From EMPLOYEE A '+
'JOIN Depts D On D.DEPT_NO = A.DEPT_NO';

type

  { TMyApplication }

  TMyApplication = class(TCustomApplication)
  private
    FIBDatabase: TIBDatabase;
    FIBTransaction: TIBTransaction;
    FLocalDB: TIBCMLocalDBSupport;
    procedure DoQuery;
    procedure HandleGetDBVersionNo(Sender: TObject; var VersionNo: integer);
    procedure HandleLogMessage(Sender: TObject; Msg: string);
  protected
    procedure DoRun; override;
  public
    constructor Create(TheOwner: TComponent); override;
    procedure WriteHelp; virtual;
  end;

{ TMyApplication }

procedure TMyApplication.DoQuery;
var i, rowno: integer;
begin
  with TIBQuery.Create(self) do
  try
     Database := FIBDatabase;
     AllowAutoActivateTransaction := true;
     SQL.Text := sqlExample;
     Active := true;
     rowno := 1;
     while not EOF do
     begin
       writeln('Record No. ',rowno);
       Inc(rowno);
       writeln;
       for i := 0 to FieldCount - 1 do
       begin
         writeln(Fields[i].FieldName + ': ',Fields[i].AsString);
       end;
       writeln;
       next;
     end;
  finally
    Free;
  end;
end;

procedure TMyApplication.HandleGetDBVersionNo(Sender: TObject;
  var VersionNo: integer);
begin
  VersionNo := 0;
  FIBTransaction.Active := true;
  try
    with TIBSQL.Create(nil) do
    try
      Database := FIBDatabase;
      Transaction := FIBTransaction;
      SQL.Text := 'Select * From RDB$RELATIONS Where RDB$RELATION_NAME = ''DBVERSIONINFO''';
      ExecQuery;
      try
        if EOF then Exit;
      finally
        Close;
      end;
    finally
      Free
    end;

    with TIBSQL.Create(nil)  do
    try
      Database := FIBDatabase;
      Transaction := FIBTransaction;
      SQL.Text := 'Select VersionNo From DBVersionInfo';
      ExecQuery;
      try
        VersionNo := FieldByName('VersionNo').AsInteger;
      finally
        Close;
      end;
    finally
      Free;
    end;
  finally
    FIBTransaction.Commit;
  end;
end;

procedure TMyApplication.HandleLogMessage(Sender: TObject; Msg: string);
begin
  writeln(stderr,Msg);
end;

procedure TMyApplication.DoRun;
var
  ErrorMsg: String;
begin
  // quick check parameters
  ErrorMsg:=CheckOptions('h','help');
  if ErrorMsg<>'' then begin
    ShowException(Exception.Create(ErrorMsg));
    Terminate;
    Exit;
  end;

  writeln(stderr,Title);

  // parse parameters
  if HasOption('h','help') then begin
    WriteHelp;
    Terminate;
    Exit;
  end;

  { add your program here }
  DoQuery;

  // stop program loop
  Terminate;
end;

constructor TMyApplication.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException:=True;
  { In console Mode the application should own the database
    - ensures centralised exception handling }
  FIBDatabase := TIBDatabase.Create(self);
  FIBDatabase.LoginPrompt := false;
  FIBTransaction := TIBTransaction.Create(self);
  FIBDatabase.DatabaseName := 'employee';
  FIBDatabase.Params.Add('lc_ctype=UTF8');
  FIBTransaction.DefaultDatabase := FIBDatabase;
  FIBTransaction.Params.Add('concurrency');
  FIBTransaction.Params.Add('wait');
  FLocalDB := TIBCMLocalDBSupport.Create(self);
  FLocalDB.Database := FIBDatabase;
  FLocalDB.DatabaseName := 'employee2.fdb';
  FLocalDB.EmptyDBArchive := 'employee.gbk';
  FLocalDB.VendorName := 'MWA Software';
  FLocalDB.OnGetDBVersionNo := @HandleGetDBVersionNo;
  FLocalDB.OnLogMessage := @HandleLogMessage;
  FLocalDB.RequiredVersionNo := 2;
  FLocalDB.UpgradeConfFile := 'upgrade.conf'
end;

procedure TMyApplication.WriteHelp;
begin
  writeln(stderr,'Usage: ',ExtractFileName(ExeName),' <options>');
   writeln(stderr,'Options:');
   writeln(stderr,'-h            show this information');
end;

var
  Application: TMyApplication;
begin
  Application:=TMyApplication.Create(nil);
  Application.Title:='Console Mode and TIBLocalSupport';
  Application.Run;
  {$IFDEF WINDOWS}
  Readln; {Gives a chance to see the program output}
  {$ENDIF}
  Application.Free;
end.

Revision:	315
Committed:	Thu Feb 25 11:56:36 2021 UTC (3 years, 1 month ago) by tony
File size:	6053 byte(s)
Log Message:	Updated for IBX 4 release
#	Content
1	(*
2	* IBX For Lazarus (Firebird Express)
3	*
4	* The contents of this file are subject to the Initial Developer's
5	* Public License Version 1.0 (the "License"); you may not use this
6	* file except in compliance with the License. You may obtain a copy
7	* of the License here:
8	*
9	* http://www.firebirdsql.org/index.php?op=doc&id=idpl
10	*
11	* Software distributed under the License is distributed on an "AS
12	* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
13	* implied. See the License for the specific language governing rights
14	* and limitations under the License.
15	*
16	* The Initial Developer of the Original Code is Tony Whyman.
17	*
18	* The Original Code is (C) 2015 Tony Whyman, MWA Software
19	* (http://www.mwasoftware.co.uk).
20	*
21	* All Rights Reserved.
22	*
23	* Contributor(s): ______________________________________.
24	*
25	*)
26
27	program ConsoleModeExample;
28
29	{
30	Example Program to demonstrate console mode IBLocal Support.
31
32	Requires Firebird Embedded Server - see readme.txt
33
34	Compile and run the program at the command line console. No
35	command line parameters are necessary. Local Database is
36	created in default location as "employee2.fdb".
37
38	}
39
40	{$mode objfpc}{$H+}
41
42	uses
43	{$IFDEF UNIX}{$IFDEF UseCThreads}
44	cthreads,
45	{$ENDIF}{$ENDIF}
46	Classes, SysUtils, CustApp
47	{ you can add units after this }
48	,IBDatabase, IBQuery, IBCMLocalDBSupport, IBSQL;
49
50	const
51	sqlExample =
52	'with recursive Depts As ( '+
53	'Select DEPT_NO, DEPARTMENT, HEAD_DEPT, cast(DEPARTMENT as VarChar(256)) as DEPT_PATH,'+
54	'cast(DEPT_NO as VarChar(64)) as DEPT_KEY_PATH '+
55	'From DEPARTMENT Where HEAD_DEPT is NULL '+
56	'UNION ALL '+
57	'Select D.DEPT_NO, D.DEPARTMENT, D.HEAD_DEPT, Depts.DEPT_PATH \|\| '' / '' \|\| D.DEPARTMENT as DEPT_PATH,'+
58	'Depts.DEPT_KEY_PATH \|\| '';'' \|\| D.DEPT_NO as DEPT_KEY_PATH '+
59	'From DEPARTMENT D '+
60	'JOIN Depts On D.HEAD_DEPT = Depts.DEPT_NO '+
61	')'+
62
63	'Select First 2 A.EMP_NO, A.FIRST_NAME, A.LAST_NAME, A.PHONE_EXT, A.HIRE_DATE, A.DEPT_NO, A.JOB_CODE,'+
64	'A.JOB_GRADE, A.JOB_COUNTRY, A.SALARY, A.FULL_NAME, D.DEPT_PATH, D.DEPT_KEY_PATH '+
65	'From EMPLOYEE A '+
66	'JOIN Depts D On D.DEPT_NO = A.DEPT_NO';
67
68	type
69
70	{ TMyApplication }
71
72	TMyApplication = class(TCustomApplication)
73	private
74	FIBDatabase: TIBDatabase;
75	FIBTransaction: TIBTransaction;
76	FLocalDB: TIBCMLocalDBSupport;
77	procedure DoQuery;
78	procedure HandleGetDBVersionNo(Sender: TObject; var VersionNo: integer);
79	procedure HandleLogMessage(Sender: TObject; Msg: string);
80	protected
81	procedure DoRun; override;
82	public
83	constructor Create(TheOwner: TComponent); override;
84	procedure WriteHelp; virtual;
85	end;
86
87	{ TMyApplication }
88
89	procedure TMyApplication.DoQuery;
90	var i, rowno: integer;
91	begin
92	with TIBQuery.Create(self) do
93	try
94	Database := FIBDatabase;
95	AllowAutoActivateTransaction := true;
96	SQL.Text := sqlExample;
97	Active := true;
98	rowno := 1;
99	while not EOF do
100	begin
101	writeln('Record No. ',rowno);
102	Inc(rowno);
103	writeln;
104	for i := 0 to FieldCount - 1 do
105	begin
106	writeln(Fields[i].FieldName + ': ',Fields[i].AsString);
107	end;
108	writeln;
109	next;
110	end;
111	finally
112	Free;
113	end;
114	end;
115
116	procedure TMyApplication.HandleGetDBVersionNo(Sender: TObject;
117	var VersionNo: integer);
118	begin
119	VersionNo := 0;
120	FIBTransaction.Active := true;
121	try
122	with TIBSQL.Create(nil) do
123	try
124	Database := FIBDatabase;
125	Transaction := FIBTransaction;
126	SQL.Text := 'Select * From RDB$RELATIONS Where RDB$RELATION_NAME = ''DBVERSIONINFO''';
127	ExecQuery;
128	try
129	if EOF then Exit;
130	finally
131	Close;
132	end;
133	finally
134	Free
135	end;
136
137	with TIBSQL.Create(nil) do
138	try
139	Database := FIBDatabase;
140	Transaction := FIBTransaction;
141	SQL.Text := 'Select VersionNo From DBVersionInfo';
142	ExecQuery;
143	try
144	VersionNo := FieldByName('VersionNo').AsInteger;
145	finally
146	Close;
147	end;
148	finally
149	Free;
150	end;
151	finally
152	FIBTransaction.Commit;
153	end;
154	end;
155
156	procedure TMyApplication.HandleLogMessage(Sender: TObject; Msg: string);
157	begin
158	writeln(stderr,Msg);
159	end;
160
161	procedure TMyApplication.DoRun;
162	var
163	ErrorMsg: String;
164	begin
165	// quick check parameters
166	ErrorMsg:=CheckOptions('h','help');
167	if ErrorMsg<>'' then begin
168	ShowException(Exception.Create(ErrorMsg));
169	Terminate;
170	Exit;
171	end;
172
173	writeln(stderr,Title);
174
175	// parse parameters
176	if HasOption('h','help') then begin
177	WriteHelp;
178	Terminate;
179	Exit;
180	end;
181
182	{ add your program here }
183	DoQuery;
184
185	// stop program loop
186	Terminate;
187	end;
188
189	constructor TMyApplication.Create(TheOwner: TComponent);
190	begin
191	inherited Create(TheOwner);
192	StopOnException:=True;
193	{ In console Mode the application should own the database
194	- ensures centralised exception handling }
195	FIBDatabase := TIBDatabase.Create(self);
196	FIBDatabase.LoginPrompt := false;
197	FIBTransaction := TIBTransaction.Create(self);
198	FIBDatabase.DatabaseName := 'employee';
199	FIBDatabase.Params.Add('lc_ctype=UTF8');
200	FIBTransaction.DefaultDatabase := FIBDatabase;
201	FIBTransaction.Params.Add('concurrency');
202	FIBTransaction.Params.Add('wait');
203	FLocalDB := TIBCMLocalDBSupport.Create(self);
204	FLocalDB.Database := FIBDatabase;
205	FLocalDB.DatabaseName := 'employee2.fdb';
206	FLocalDB.EmptyDBArchive := 'employee.gbk';
207	FLocalDB.VendorName := 'MWA Software';
208	FLocalDB.OnGetDBVersionNo := @HandleGetDBVersionNo;
209	FLocalDB.OnLogMessage := @HandleLogMessage;
210	FLocalDB.RequiredVersionNo := 2;
211	FLocalDB.UpgradeConfFile := 'upgrade.conf'
212	end;
213
214	procedure TMyApplication.WriteHelp;
215	begin
216	writeln(stderr,'Usage: ',ExtractFileName(ExeName),' <options>');
217	writeln(stderr,'Options:');
218	writeln(stderr,'-h show this information');
219	end;
220
221	var
222	Application: TMyApplication;
223	begin
224	Application:=TMyApplication.Create(nil);
225	Application.Title:='Console Mode and TIBLocalSupport';
226	Application.Run;
227	{$IFDEF WINDOWS}
228	Readln; {Gives a chance to see the program output}
229	{$ENDIF}
230	Application.Free;
231	end.
232