examples/local-employeedb/ConsoleModeExample.lpr

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 DEPT_NO, DEPARTMENT, HEAD_DEPT, Depts.DEPT_PATH ||  '' / '' || DEPARTMENT as DEPT_PATH,'+
'Depts.DEPT_KEY_PATH || '';'' || DEPT_NO as DEPT_KEY_PATH '+
'From DEPARTMENT '+
'JOIN Depts On 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;
     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;
  with FIBTransaction do
    if not InTransaction then StartTransaction;
  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;
  Application.Free;
end.

Revision:	37
Committed:	Mon Feb 15 14:44:25 2016 UTC (8 years, 2 months ago) by tony
File size:	5048 byte(s)
Log Message:	Committing updates for Release R1-4-0
#	User	Rev	Content
1	tony	37	program ConsoleModeExample;
2
3			{
4			Example Program to demonstrate console mode IBLocal Support.
5
6			Requires Firebird Embedded Server - see readme.txt
7
8			Compile and run the program at the command line console. No
9			command line parameters are necessary. Local Database is
10			created in default location as "employee2.fdb".
11
12			}
13
14			{$mode objfpc}{$H+}
15
16			uses
17			{$IFDEF UNIX}{$IFDEF UseCThreads}
18			cthreads,
19			{$ENDIF}{$ENDIF}
20			Classes, SysUtils, CustApp
21			{ you can add units after this }
22			,IBDatabase, IBQuery, IBCMLocalDBSupport, IBSQL;
23
24			const
25			sqlExample =
26			'with recursive Depts As ( '+
27			'Select DEPT_NO, DEPARTMENT, HEAD_DEPT, cast(DEPARTMENT as VarChar(256)) as DEPT_PATH,'+
28			'cast(DEPT_NO as VarChar(64)) as DEPT_KEY_PATH '+
29			'From DEPARTMENT Where HEAD_DEPT is NULL '+
30			'UNION ALL '+
31			'Select DEPT_NO, DEPARTMENT, HEAD_DEPT, Depts.DEPT_PATH \|\| '' / '' \|\| DEPARTMENT as DEPT_PATH,'+
32			'Depts.DEPT_KEY_PATH \|\| '';'' \|\| DEPT_NO as DEPT_KEY_PATH '+
33			'From DEPARTMENT '+
34			'JOIN Depts On HEAD_DEPT = Depts.DEPT_NO '+
35			')'+
36
37			'Select First 2 A.EMP_NO, A.FIRST_NAME, A.LAST_NAME, A.PHONE_EXT, A.HIRE_DATE, A.DEPT_NO, A.JOB_CODE,'+
38			'A.JOB_GRADE, A.JOB_COUNTRY, A.SALARY, A.FULL_NAME, D.DEPT_PATH, D.DEPT_KEY_PATH '+
39			'From EMPLOYEE A '+
40			'JOIN Depts D On D.DEPT_NO = A.DEPT_NO';
41
42			type
43
44			{ TMyApplication }
45
46			TMyApplication = class(TCustomApplication)
47			private
48			FIBDatabase: TIBDatabase;
49			FIBTransaction: TIBTransaction;
50			FLocalDB: TIBCMLocalDBSupport;
51			procedure DoQuery;
52			procedure HandleGetDBVersionNo(Sender: TObject; var VersionNo: integer);
53			procedure HandleLogMessage(Sender: TObject; Msg: string);
54			protected
55			procedure DoRun; override;
56			public
57			constructor Create(TheOwner: TComponent); override;
58			procedure WriteHelp; virtual;
59			end;
60
61			{ TMyApplication }
62
63			procedure TMyApplication.DoQuery;
64			var i, rowno: integer;
65			begin
66			with TIBQuery.Create(self) do
67			try
68			Database := FIBDatabase;
69			SQL.Text := sqlExample;
70			Active := true;
71			rowno := 1;
72			while not EOF do
73			begin
74			writeln('Record No. ',rowno);
75			Inc(rowno);
76			writeln;
77			for i := 0 to FieldCount - 1 do
78			begin
79			writeln(Fields[i].FieldName + ': ',Fields[i].AsString);
80			end;
81			writeln;
82			next;
83			end;
84			finally
85			Free;
86			end;
87			end;
88
89			procedure TMyApplication.HandleGetDBVersionNo(Sender: TObject;
90			var VersionNo: integer);
91			begin
92			VersionNo := 0;
93			with FIBTransaction do
94			if not InTransaction then StartTransaction;
95			try
96			with TIBSQL.Create(nil) do
97			try
98			Database := FIBDatabase;
99			Transaction := FIBTransaction;
100			SQL.Text := 'Select * From RDB$RELATIONS Where RDB$RELATION_NAME = ''DBVERSIONINFO''';
101			ExecQuery;
102			try
103			if EOF then Exit;
104			finally
105			Close;
106			end;
107			finally
108			Free
109			end;
110
111			with TIBSQL.Create(nil) do
112			try
113			Database := FIBDatabase;
114			Transaction := FIBTransaction;
115			SQL.Text := 'Select VersionNo From DBVersionInfo';
116			ExecQuery;
117			try
118			VersionNo := FieldByName('VersionNo').AsInteger;
119			finally
120			Close;
121			end;
122			finally
123			Free;
124			end;
125			finally
126			FIBTransaction.Commit;
127			end;
128			end;
129
130			procedure TMyApplication.HandleLogMessage(Sender: TObject; Msg: string);
131			begin
132			writeln(stderr,Msg);
133			end;
134
135			procedure TMyApplication.DoRun;
136			var
137			ErrorMsg: String;
138			begin
139			// quick check parameters
140			ErrorMsg:=CheckOptions('h','help');
141			if ErrorMsg<>'' then begin
142			ShowException(Exception.Create(ErrorMsg));
143			Terminate;
144			Exit;
145			end;
146
147			writeln(stderr,Title);
148
149			// parse parameters
150			if HasOption('h','help') then begin
151			WriteHelp;
152			Terminate;
153			Exit;
154			end;
155
156			{ add your program here }
157			DoQuery;
158
159			// stop program loop
160			Terminate;
161			end;
162
163			constructor TMyApplication.Create(TheOwner: TComponent);
164			begin
165			inherited Create(TheOwner);
166			StopOnException:=True;
167			{ In console Mode the application should own the database
168			- ensures centralised exception handling }
169			FIBDatabase := TIBDatabase.Create(self);
170			FIBDatabase.LoginPrompt := false;
171			FIBTransaction := TIBTransaction.Create(self);
172			FIBDatabase.DatabaseName := 'employee';
173			FIBDatabase.Params.Add('lc_ctype=UTF8');
174			FIBTransaction.DefaultDatabase := FIBDatabase;
175			FIBTransaction.Params.Add('concurrency');
176			FIBTransaction.Params.Add('wait');
177			FLocalDB := TIBCMLocalDBSupport.Create(self);
178			FLocalDB.Database := FIBDatabase;
179			FLocalDB.DatabaseName := 'employee2.fdb';
180			FLocalDB.EmptyDBArchive := 'employee.gbk';
181			FLocalDB.VendorName := 'MWA Software';
182			FLocalDB.OnGetDBVersionNo := @HandleGetDBVersionNo;
183			FLocalDB.OnLogMessage := @HandleLogMessage;
184			FLocalDB.RequiredVersionNo := 2;
185			end;
186
187			procedure TMyApplication.WriteHelp;
188			begin
189			writeln(stderr,'Usage: ',ExtractFileName(ExeName),' <options>');
190			writeln(stderr,'Options:');
191			writeln(stderr,'-h show this information');
192			end;
193
194			var
195			Application: TMyApplication;
196			begin
197			Application:=TMyApplication.Create(nil);
198			Application.Title:='Console Mode and TIBLocalSupport';
199			Application.Run;
200			Application.Free;
201			end.
202