ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/local-employeedb/ConsoleModeExample.lpr
Revision: 37
Committed: Mon Feb 15 14:44:25 2016 UTC (8 years, 1 month ago) by tony
File size: 5048 byte(s)
Log Message:
Committing updates for Release R1-4-0

File Contents

# Content
1 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