ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/fbsql/fbsql.lpr
Revision: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (7 years, 3 months ago) by tony
File size: 9669 byte(s)
Log Message:
Committing updates for Release R2-0-0

File Contents

# 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) 2014 Tony Whyman, MWA Software
19 * (http://www.mwasoftware.co.uk).
20 *
21 * All Rights Reserved.
22 *
23 * Contributor(s): ______________________________________.
24 *
25 *)
26 program fbsql;
27
28 {$mode objfpc}{$H+}
29
30 uses
31 {$IFDEF UNIX}{$IFDEF UseCThreads}
32 cthreads,
33 {$ENDIF}{$ENDIF}
34 Classes, SysUtils, CustApp
35 { you can add units after this }
36 ,IBDatabase, ibxscript, IBExtract, IBQuery, DB;
37
38 resourcestring
39
40 sUnknownField = 'Unknown Field Type';
41 sBadGraphic = 'Unable to generate CSV data for a Graphic Field';
42 sBadParadox = 'Unable to generate CSV data for a Paradox OLE Field';
43 sBadDBase = 'Unable to generate CSV data for a DBase OLE Field';
44 sBadBinary = 'Unable to generate CSV data for a Binary Field';
45 sBadCursor = 'Unable to generate CSV data for a Cursor Field';
46
47 type
48
49 { TFBSQL }
50
51 TFBSQL = class(TCustomApplication)
52 private
53 FIBDatabase: TIBDatabase;
54 FIBTransaction: TIBTransaction;
55 FIBXScript: TIBXScript;
56 FExtract: TIBExtract;
57 FQuery: TIBQuery;
58 FSQL: TStringStream;
59 procedure LogHandler(Sender: TObject; Msg: string);
60 procedure ErrorLogHandler(Sender: TObject; Msg: string);
61 procedure HandleSelectSQL(Sender: TObject; SQLText: string);
62 procedure WriteCSV;
63 protected
64 procedure DoRun; override;
65 procedure ShowException(E: Exception); override;
66 public
67 constructor Create(TheOwner: TComponent); override;
68 destructor Destroy; override;
69 procedure WriteHelp; virtual;
70 end;
71
72 { TFBSQL }
73
74 procedure TFBSQL.LogHandler(Sender: TObject; Msg: string);
75 begin
76 writeln( Msg);
77 end;
78
79 procedure TFBSQL.ErrorLogHandler(Sender: TObject; Msg: string);
80 begin
81 writeln(stderr, Msg);
82 end;
83
84 procedure TFBSQL.HandleSelectSQL(Sender: TObject; SQLText: string);
85 begin
86 FQuery.SQL.Text := SQLText;
87 FQuery.Active := true;
88 try
89 WriteCSV;
90 finally
91 FQuery.Active := false;
92 end;
93 end;
94
95 procedure TFBSQL.WriteCSV;
96
97 procedure WriteQuotedText(Text: string);
98 var Index: integer;
99 begin
100 Index := 1;
101 while Index <= Length(Text) do
102 if Text[Index] = '"' then
103 begin
104 Insert('"',Text,Index);
105 Inc(Index,2)
106 end
107 else
108 Inc(Index,1);
109 write('"' + Text + '"')
110 end;
111
112 procedure WriteFieldList(Fields: TFields);
113 var I: integer;
114 begin
115 for I := 0 to Fields.Count - 1 do
116 begin
117 if I > 0 then write(',');
118 write(Fields[I].FieldName)
119 end;
120 writeln;
121 end;
122
123 procedure WriteRecord;
124 var I: integer;
125 begin
126 with FQuery do
127 begin
128 for I := 0 to FieldCount - 1 do
129 begin
130 if I <> 0 then write(',');
131 case Fields[I].DataType of
132 ftUnknown: raise Exception.Create(sUnknownField);
133 ftString: WriteQuotedText(Fields[I].AsString);
134 ftSmallint,
135 ftInteger,
136 ftWord,
137 ftLargeInt,
138 ftBoolean: write(Fields[I].DisplayText);
139 ftFloat,
140 ftCurrency,
141 ftFmtBCD,
142 ftBCD: write(Fields[I].AsString);
143 ftDate,
144 ftTime: write(DateTimeToStr(Fields[I].AsDateTime));
145 ftDateTime: WriteQuotedText(Fields[I].AsString);
146 ftBytes,
147 ftVarBytes,
148 ftBlob,
149 ftAutoInc: write(Fields[I].AsString);
150 ftMemo: WriteQuotedText(Fields[I].AsString);
151 ftGraphic: raise Exception.Create(sBadGraphic);
152 ftFmtMemo: WriteQuotedText(Fields[I].AsString);
153 ftParadoxOle: raise Exception.Create(sBadParadox);
154 ftDBaseOle: raise Exception.Create(sBadDBase);
155 ftTypedBinary:raise Exception.Create(sBadBinary);
156 ftCursor: raise Exception.Create(sBadCursor);
157 end
158 end;
159 writeln;
160 end;
161 end;
162 begin
163 with FQuery do
164 begin
165 WriteFieldList(Fields);
166 First;
167 while not EOF do
168 begin
169 WriteRecord;
170 Next
171 end;
172 end
173 end;
174
175 procedure TFBSQL.DoRun;
176 var
177 ErrorMsg: String;
178 SQLFileName: string;
179 DoExtract: boolean;
180 i: integer;
181 begin
182 writeln(stderr,'fbsql: a non-interactive SQL interpreter for Firebird');
183 writeln(stderr,'Copyright (c) MWA Software 2016');
184 // quick check parameters
185 ErrorMsg:=CheckOptions('ahbeufprs',['help','user','pass','role']);
186 if ErrorMsg<>'' then begin
187 ShowException(Exception.Create(ErrorMsg));
188 Terminate;
189 Exit;
190 end;
191
192 // parse parameters
193 if HasOption('h','help') or (ParamCount = 0) then
194 begin
195 WriteHelp;
196 Terminate;
197 Exit;
198 end;
199
200 SQLFileName := '';
201 DoExtract := false;
202
203 {Initialise user_name and password from environment if available}
204
205 if GetEnvironmentVariable('ISC_USER') <> '' then
206 FIBDatabase.Params.Add('user_name=' + GetEnvironmentVariable('ISC_USER'));
207
208 if GetEnvironmentVariable('ISC_PASSWORD') <> '' then
209 FIBDatabase.Params.Add('password=' + GetEnvironmentVariable('ISC_PASSWORD'));
210
211 {Process Command line options}
212
213 if HasOption('u','user') then
214 FIBDatabase.Params.Add('user_name=' + GetOptionValue('u','user'));
215
216 if HasOption('p','pass') then
217 FIBDatabase.Params.Add('password=' + GetOptionValue('p','pass'));
218
219 if HasOption('r','role') then
220 FIBDatabase.Params.Add('sql_role_name=' + GetOptionValue('r','role'));
221
222 if (ParamCount >= 1) and (ParamStr(ParamCount)[1] <> '-') then
223 FIBDatabase.DatabaseName := ParamStr(ParamCount)
224 else
225 raise Exception.Create('Database Name Missing');
226
227 if not HasOption('b') then
228 FIBXScript.StopOnFirstError := false;
229
230 if not HasOption('e') then
231 FIBXScript.Echo := false;
232
233 if HasOption('a') then
234 DoExtract := true;
235
236 if HasOption('f') then
237 SQLFileName := GetOptionValue('f');
238
239 if HasOption('s') then
240 begin
241 FSQL.WriteString(GetOptionValue('s'));
242 FSQL.Position := 0;
243 end;
244
245 {Validation}
246
247 if not DoExtract then
248 begin
249 if (SQLFileName = '') and (FSQL.DataString = '') then
250 raise Exception.Create('An SQL File must be provided');
251
252 if (FSQL.DataString <> '') and (SQLFileName <> '') then
253 raise Exception.Create('An SQL Script File and text cannot be simulateously requested');
254
255 if (FSQL.DataString = '') and not FileExists(SQLFileName) then
256 raise Exception.CreateFmt('SQL File "%s" not found!',[SQLFileName]);
257
258 end;
259
260 if DoExtract and ((SQLFileName <> '') or (FSQL.DataString <> '')) then
261 raise Exception.Create('Extract and script execution cannot be simulateously requested');
262
263 {This is where it all happens}
264
265 FIBDatabase.Connected := true;
266 try
267 if DoExtract then
268 begin
269 FExtract.ExtractObject(eoDatabase);
270 for i := 0 to FExtract.Items.Count - 1 do
271 writeln(FExtract.Items[i]);
272 end
273 else
274 if FSQL.DataString = '' then
275 FIBXScript.PerformUpdate(SQLFileName,true)
276 else
277 FIBXScript.PerformUpdate(FSQL,true);
278 finally
279 FIBDatabase.Connected := false;
280 end;
281
282
283 // stop program loop
284 Terminate;
285 end;
286
287 procedure TFBSQL.ShowException(E: Exception);
288 begin
289 writeln(stderr,'Error: ' + E.Message);
290 end;
291
292 constructor TFBSQL.Create(TheOwner: TComponent);
293 begin
294 inherited Create(TheOwner);
295 StopOnException:=True;
296 FSQL := TStringStream.Create('');
297
298 { Create Components }
299 FIBDatabase := TIBDatabase.Create(self);
300 FIBTransaction := TIBTransaction.Create(self);
301 FIBTransaction.DefaultDatabase := FIBDatabase;
302 FIBXScript := TIBXScript.Create(self);
303 FIBXScript.Database := FIBDatabase;
304 FIBXScript.Transaction := FIBTransaction;
305 FIBXScript.OnOutputLog := @LogHandler;
306 FIBXScript.OnErrorLog := @ErrorLogHandler;
307 FIBXScript.OnSelectSQL := @HandleSelectSQL;
308 FExtract := TIBExtract.Create(self);
309 FExtract.Database := FIBDatabase;
310 FExtract.Transaction := FIBTransaction;
311 FQuery := TIBQuery.Create(self);
312 FQuery.AllowAutoActivateTransaction := true;
313 FQuery.Database := FIBDatabase;
314 FQuery.Transaction := FIBTransaction;
315
316 FIBTransaction.Params.Add('concurrency');
317 FIBTransaction.Params.Add('wait');
318 FIBDatabase.Params.Add('lc_ctype=UTF8');
319
320 end;
321
322 destructor TFBSQL.Destroy;
323 begin
324 if assigned(FSQL) then FSQL.Free;
325 inherited Destroy;
326 end;
327
328 procedure TFBSQL.WriteHelp;
329 begin
330 writeln(stderr,'Usage: ',ExtractFileName(ExeName),' <options> <database name>');
331 writeln(stderr,'Options:');
332 writeln(stderr,'-a write database metadata to stdout');
333 writeln(stderr,'-b stop on first error');
334 writeln(stderr,'-e echo sql statements to stdout');
335 writeln(stderr,'-f <filename> execute SQL script from file');
336 writeln(stderr,'-h show this information');
337 writeln(stderr,'-p <password> provide password on command line (insecure)');
338 writeln(stderr,'-r <rolename> open database with this rolename');
339 writeln(stderr,'-s <sql> Execute SQL text');
340 writeln(stderr,'-u <username> open database with this username (defaults to SYSDBA)');
341 writeln;
342 writeln(stderr,'Environment Variables:');
343 writeln(stderr,'ISC_USER Login user Name');
344 writeln(stderr,'ISC_PASSWORD Login password');
345 end;
346
347 var
348 Application: TFBSQL;
349 begin
350 Application:=TFBSQL.Create(nil);
351 Application.Title:='fbsql';
352 Application.Run;
353 Application.Free;
354 end.
355