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;
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:	143
Committed:	Fri Feb 23 12:11:21 2018 UTC (6 years, 9 months ago) by tony
File size:	6008 byte(s)
Log Message:	Fixes Merged
#	User	Rev	Content
1	tony	143	(*
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	tony	37	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	tony	45	'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	tony	37	')'+
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	tony	45	AllowAutoActivateTransaction := true;
96	tony	37	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	tony	45	FIBTransaction.Active := true;
121	tony	37	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			end;
212
213			procedure TMyApplication.WriteHelp;
214			begin
215			writeln(stderr,'Usage: ',ExtractFileName(ExeName),' <options>');
216			writeln(stderr,'Options:');
217			writeln(stderr,'-h show this information');
218			end;
219
220			var
221			Application: TMyApplication;
222			begin
223			Application:=TMyApplication.Create(nil);
224			Application.Title:='Console Mode and TIBLocalSupport';
225			Application.Run;
226	tony	88	{$IFDEF WINDOWS}
227			Readln; {Gives a chance to see the program output}
228			{$ENDIF}
229	tony	37	Application.Free;
230			end.
231