ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/examples/fbsql/fbsql.lpr

Comparing ibx/trunk/examples/fbsql/fbsql.lpr (file contents):
Revision 37 by tony, Mon Feb 15 14:44:25 2016 UTC vs.
Revision 47 by tony, Mon Jan 9 15:31:51 2017 UTC

#	Line 31 | Line 31 | uses
31		{$IFDEF UNIX}{$IFDEF UseCThreads}
32		cthreads,
33		{$ENDIF}{$ENDIF}
34	+	{$IFDEF WINDOWS} Windows, {$ENDIF}
35		Classes, SysUtils, CustApp
36		{ you can add units after this }
37	<	,IBDatabase, ibxscript, IBExtract, IBQuery, DB;
37	>	,IBDatabase, ibxscript, IBExtract, DB, IBVersion,
38	>	IBDataOutput, RegExpr
39	>	{$IFDEF UNIX} ,TermIO, IOStream {$ENDIF}
40
41	<	resourcestring
41	>	;
42
43	<	sUnknownField = 'Unknown Field Type';
44	<	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';
43	>	const
44	>	FExceptionTrapped: boolean = false;
45
46		type
47	+	TInteractiveSQLProcessor = class;
48
49		{ TFBSQL }
50
#	Line 53 | Line 53 | type
53		FIBDatabase: TIBDatabase;
54		FIBTransaction: TIBTransaction;
55		FIBXScript: TIBXScript;
56	+	FISQLProcessor: TInteractiveSQLProcessor;
57		FExtract: TIBExtract;
58	<	FQuery: TIBQuery;
59	<	FSQL: TStringStream;
58	>	FOutputFile: TStream;
59	>	FDataOutputFormatter: TDataOutputFormatter;
60		procedure LogHandler(Sender: TObject; Msg: string);
61		procedure ErrorLogHandler(Sender: TObject; Msg: string);
62	<	procedure HandleSelectSQL(Sender: TObject; SQLText: string);
62	<	procedure WriteCSV;
62	>	procedure loginPrompt(Database: TIBDatabase; LoginParams: TStrings);
63		protected
64		procedure DoRun; override;
65		procedure ShowException(E: Exception); override;
66		public
67		constructor Create(TheOwner: TComponent); override;
68	–	destructor Destroy; override;
68		procedure WriteHelp; virtual;
69		end;
70
71	<	{ TFBSQL }
71	>	{ TInteractiveSQLProcessor }
72
73	<	procedure TFBSQL.LogHandler(Sender: TObject; Msg: string);
74	<	begin
75	<	writeln( Msg);
77	<	end;
73	>	{This is a TCustomIBXScript descendent that uses the console for input/output.
74	>	It additionally suported QUIT/EXIT Commands. The log file can either be redirected
75	>	to the console or sent to a separate file.}
76
77	<	procedure TFBSQL.ErrorLogHandler(Sender: TObject; Msg: string);
78	<	begin
79	<	writeln(stderr, Msg);
80	<	end;
77	>	TInteractiveSQLProcessor = class(TCustomIBXScript)
78	>	private
79	>	FUseLogFile: boolean;
80	>	protected
81	>	procedure Add2Log(const Msg: string; IsError: boolean=true); override;
82	>	function ProcessStatement(stmt: string): boolean; override;
83	>	public
84	>	constructor Create(aOwner: TComponent); override;
85	>	procedure Run;
86	>	property UseLogFile: boolean read FUseLogFile write FUseLogFile;
87	>	end;
88
89	<	procedure TFBSQL.HandleSelectSQL(Sender: TObject; SQLText: string);
89	>	{$IFDEF UNIX}
90	>	function getpassword: string;
91	>	var oldattr, newattr: termios;
92	>	stdinStream: TIOStream;
93	>	c: char;
94		begin
95	<	FQuery.SQL.Text := SQLText;
96	<	FQuery.Active := true;
95	>	Result := '';
96	>	stdinStream := TIOStream.Create(iosInput);
97		try
98	<	WriteCSV;
98	>	TCGetAttr(stdinStream.Handle, oldattr);
99	>	newattr := oldattr;
100	>	newattr.c_lflag := newattr.c_lflag and not (ICANON or ECHO);
101	>	TCSetAttr( stdinStream.Handle, TCSANOW, newattr );
102	>	try
103	>	repeat
104	>	read(c);
105	>	if c = #10 then break;
106	>	write('*');
107	>	Result += c;
108	>	until false;
109	>	writeln;
110	>	finally
111	>	TCSetAttr( stdinStream.Handle, TCSANOW, oldattr );
112	>	end;
113		finally
114	<	FQuery.Active := false;
114	>	stdinStream.Free;
115		end;
116		end;
117	+	{$ENDIF}
118	+	{$IFDEF WINDOWS}
119	+	function getpassword: string;
120	+	var oldmode, newmode: DWORD;
121	+	c: char;
122	+	begin
123	+	Result := '';
124	+	GetConsoleMode(GetStdHandle(STD_INPUT_HANDLE), oldmode);
125	+	newmode := oldmode - ENABLE_ECHO_INPUT - ENABLE_LINE_INPUT;
126	+	SetConsoleMode(GetStdHandle(STD_INPUT_HANDLE),newmode);
127	+	try
128	+	repeat
129	+	read(c);
130	+	if c = #13 then break;
131	+	write('*');
132	+	Result += c;
133	+	until false;
134	+	writeln;
135	+	finally
136	+	SetConsoleMode(GetStdHandle(STD_INPUT_HANDLE),oldmode);
137	+	end
138	+	end;
139	+	{$ENDIF}
140
141	<	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;
141	>	{ TInteractiveSQLProcessor }
142
143	<	procedure WriteFieldList(Fields: TFields);
144	<	var I: integer;
145	<	begin
146	<	for I := 0 to Fields.Count - 1 do
147	<	begin
148	<	if I > 0 then write(',');
149	<	write(Fields[I].FieldName)
150	<	end;
151	<	writeln;
152	<	end;
143	>	procedure TInteractiveSQLProcessor.Add2Log(const Msg: string; IsError: boolean);
144	>	begin
145	>	if UseLogFile then
146	>	inherited Add2Log(Msg,IsError)
147	>	else
148	>	if IsError then
149	>	writeln(stderr,msg)
150	>	else
151	>	writeln(msg);
152	>	end;
153
154	<	procedure WriteRecord;
155	<	var I: integer;
154	>	function TInteractiveSQLProcessor.ProcessStatement(stmt: string): boolean;
155	>	var  RegexObj: TRegExpr;
156	>	Terminator: char;
157	>	ucStmt: string;
158	>	begin
159	>	Result := inherited ProcessStatement(stmt);
160	>	if not Result then
161		begin
162	<	with FQuery do
163	<	begin
164	<	for I := 0 to FieldCount - 1 do
162	>	Terminator := FSymbolStream.Terminator;
163	>	ucStmt := AnsiUpperCase(stmt);
164	>	RegexObj := TRegExpr.Create;
165	>	try
166	>	RegexObj.Expression := '^ *(QUIT|EXIT) *(\' + Terminator + '|)';
167	>	if RegexObj.Exec(ucStmt) then
168		begin
169	<	if I <> 0 then write(',');
170	<	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
169	>	TInteractiveSymbolStream(FSymbolStream).Terminated := true;
170	>	Result := true;
171		end;
172	<	writeln;
172	>	finally
173	>	RegexObj.Free;
174		end;
175		end;
176	+	end;
177	+
178	+	constructor TInteractiveSQLProcessor.Create(aOwner: TComponent);
179		begin
180	<	with FQuery do
181	<	begin
182	<	WriteFieldList(Fields);
183	<	First;
184	<	while not EOF do
185	<	begin
186	<	WriteRecord;
187	<	Next
188	<	end;
189	<	end
180	>	inherited Create(aOwner);
181	>	FSymbolStream := TInteractiveSymbolStream.Create;
182	>	end;
183	>
184	>	procedure TInteractiveSQLProcessor.Run;
185	>	begin
186	>	ProcessStream;
187	>	end;
188	>
189	>	{ TFBSQL }
190	>
191	>	procedure TFBSQL.LogHandler(Sender: TObject; Msg: string);
192	>	begin
193	>	if FOutputFile <> nil then
194	>	FOutputFile.WriteAnsiString(Msg + LineEnding)
195	>	else
196	>	writeln( Msg);
197	>	end;
198	>
199	>	procedure TFBSQL.ErrorLogHandler(Sender: TObject; Msg: string);
200	>	begin
201	>	writeln(stderr, Msg);
202	>	end;
203	>
204	>	procedure TFBSQL.loginPrompt(Database: TIBDatabase; LoginParams: TStrings);
205	>	var password: string;
206	>	begin
207	>	write(LoginParams.Values['user_name'] + '''s Password:');
208	>	password := getpassword;
209	>	if password <> '' then
210	>	LoginParams.Values['password'] := password;
211		end;
212
213		procedure TFBSQL.DoRun;
#	Line 177 | Line 215 | var
215		ErrorMsg: String;
216		SQLFileName: string;
217		DoExtract: boolean;
218	+	OutputFileName: string;
219		i: integer;
220	+	ExtractTypes: TExtractTypes;
221	+	Opts,NonOpts: TStrings;
222	+	OutputFormat: string;
223	+	SQLStatement: string;
224		begin
225	<	writeln(stderr,'fbsql: a non-interactive SQL interpreter for Firebird');
226	<	writeln(stderr,'Copyright (c) MWA Software 2016');
225	>	writeln(stderr,'fbsql: an SQL interpreter for Firebird');
226	>	writeln(stderr,'Built using IBX ' + IBX_VERSION);
227	>	writeln(stderr,'Copyright (c) MWA Software 2017');
228	>
229		// quick check parameters
230	<	ErrorMsg:=CheckOptions('ahbeufprs',['help','user','pass','role']);
230	>	Opts := TStringList.Create;
231	>	NonOpts := TStringList.Create;
232	>	try
233	>	ErrorMsg := CheckOptions('aAhbeu:i:o:p:r:s:t:',['help','user','pass','role'],Opts,NonOpts);
234	>	{Database name is last parameter if given and not an option}
235	>	if (NonOpts.Count > 0) and ((Opts.Count = 0) or
236	>	((Opts.ValueFromIndex[Opts.Count-1] <> NonOpts[NonOpts.Count-1])) or
237	>	(ParamCount = 1) or (ParamStr(ParamCount-1)[2] in ['!','A','h','b','e']))then
238	>	FIBDatabase.DatabaseName := ParamStr(ParamCount);
239	>	finally
240	>	Opts.Free;
241	>	NonOpts.Free;
242	>	end;
243		if ErrorMsg<>'' then begin
244		ShowException(Exception.Create(ErrorMsg));
245		Terminate;
#	Line 190 | Line 247 | begin
247		end;
248
249		// parse parameters
250	<	if HasOption('h','help') or (ParamCount = 0) then
250	>	if HasOption('h','help') then
251		begin
252		WriteHelp;
253		Terminate;
#	Line 198 | Line 255 | begin
255		end;
256
257		SQLFileName := '';
258	+	OutputFileName := '';
259		DoExtract := false;
260	+	ExtractTypes := [];
261	+	FDataOutputFormatter := TIBBlockFormatOut;
262	+	SQLStatement := '';
263
264		{Initialise user_name and password from environment if available}
265
#	Line 210 | Line 271 | begin
271
272		{Process Command line options}
273
274	<	if HasOption('u','user') then
275	<	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'));
274	>	if HasOption('a') then
275	>	DoExtract := true;
276
277	<	if (ParamCount >= 1) and (ParamStr(ParamCount)[1] <> '-')  then
278	<	FIBDatabase.DatabaseName := ParamStr(ParamCount)
279	<	else
280	<	raise Exception.Create('Database Name Missing');
277	>	if HasOption('A') then
278	>	begin
279	>	DoExtract := true;
280	>	ExtractTypes := [etData];
281	>	end;
282
283		if not HasOption('b') then
284	+	begin
285		FIBXScript.StopOnFirstError := false;
286	+	FISQLProcessor.StopOnFirstError := false;
287	+	end;
288
289		if not HasOption('e') then
290		FIBXScript.Echo := false;
291
292	<	if HasOption('a') then
293	<	DoExtract := true;
292	>	if HasOption('i') then
293	>	SQLFileName := GetOptionValue('i');
294
295	<	if HasOption('f') then
296	<	SQLFileName := GetOptionValue('f');
295	>	if HasOption('o') then
296	>	begin
297	>	OutputFileName := GetOptionValue('o');
298	>	FISQLProcessor.UseLogFile := true;
299	>	end;
300	>
301	>	if HasOption('p','pass') then
302	>	FIBDatabase.Params.Values['password'] := GetOptionValue('p','pass');
303	>
304	>	if HasOption('r','role') then
305	>	FIBDatabase.Params.Values['sql_role_name'] := GetOptionValue('r','role');
306
307		if HasOption('s') then
308	+	SQLStatement := GetOptionValue('s');
309	+
310	+	if HasOption('t') then
311		begin
312	<	FSQL.WriteString(GetOptionValue('s'));
313	<	FSQL.Position := 0;
312	>	OutputFormat := GetOptionValue('t');
313	>	if OutputFormat = 'CSV' then
314	>	FDataOutputFormatter := TIBCSVDataOut
315	>	else
316	>	if OutputFormat = 'INS' then
317	>	FDataOutputFormatter := TIBInsertStmtsOut
318	>	else
319	>	if OutputFormat = 'BLK' then
320	>	FDataOutputFormatter := TIBBlockFormatOut
321	>	else
322	>	raise Exception.CreateFmt('Unrecognised data output format "%s"',[OutputFormat]);
323		end;
324
325	+	if HasOption('u','user') then
326	+	FIBDatabase.Params.Values['user_name'] := GetOptionValue('u','user');
327	+
328		{Validation}
329
330	+	FIBDatabase.LoginPrompt := (FIBDatabase.Params.IndexOfName('user_name') <> -1) and
331	+	(FIBDatabase.Params.Values['password'] = '');
332	+
333		if not DoExtract then
334		begin
335	<	if (SQLFileName = '') and (FSQL.DataString = '') then
336	<	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');
335	>	if (SQLStatement <> '') and (SQLFileName <> '') then
336	>	raise Exception.Create('An SQL Script File and text cannot be simultaneously requested');
337
338	<	if (FSQL.DataString = '') and not FileExists(SQLFileName) then
338	>	if (SQLStatement = '') and (SQLFileName <> '')  and not FileExists(SQLFileName) then
339		raise Exception.CreateFmt('SQL File "%s" not found!',[SQLFileName]);
340
341		end;
342
343	<	if DoExtract and ((SQLFileName <> '') or (FSQL.DataString <> '')) then
343	>	if DoExtract and ((SQLFileName <> '') or (SQLStatement <> '')) then
344		raise Exception.Create('Extract and script execution cannot be simulateously requested');
345
346		{This is where it all happens}
347
348	<	FIBDatabase.Connected := true;
348	>	FIBXScript.DataOutputFormatter := FDataOutputFormatter.Create(self);
349	>	FISQLProcessor.DataOutputFormatter := FDataOutputFormatter.Create(self);
350	>
351	>	if OutputFileName <> '' then
352	>	FOutputFile := TFileStream.Create(OutputFileName,fmCreate);
353	>
354	>	FIBDatabase.Connected := FIBDatabase.DatabaseName <> '';
355		try
356		if DoExtract then
357		begin
358	<	FExtract.ExtractObject(eoDatabase);
358	>	FExtract.ExtractObject(eoDatabase,'',ExtractTypes);
359	>	if FOutputFile <> nil then
360	>	FExtract.Items.SaveToStream(FOutputFile)
361	>	else
362		for i := 0 to FExtract.Items.Count - 1 do
363		writeln(FExtract.Items[i]);
364		end
365		else
366	<	if FSQL.DataString = '' then
367	<	FIBXScript.PerformUpdate(SQLFileName,true)
366	>	if SQLFileName <> '' then
367	>	FIBXScript.RunScript(SQLFileName)
368	>	else
369	>	if SQLStatement <> '' then
370	>	FIBXScript.ExecSQLScript(SQLStatement)
371		else
372	<	FIBXScript.PerformUpdate(FSQL,true);
372	>	FISQLProcessor.Run;
373		finally
374		FIBDatabase.Connected := false;
375	+	if FOutputFile <> nil then
376	+	FOutputFile.Free;
377		end;
378
379
#	Line 286 | Line 383 | end;
383
384		procedure TFBSQL.ShowException(E: Exception);
385		begin
386	+	FExceptionTrapped := true;
387		writeln(stderr,'Error: ' + E.Message);
388		end;
389
#	Line 293 | Line 391 | constructor TFBSQL.Create(TheOwner: TCom
391		begin
392		inherited Create(TheOwner);
393		StopOnException:=True;
296	–	FSQL := TStringStream.Create('');
394
395		{ Create Components }
396		FIBDatabase := TIBDatabase.Create(self);
397	+	FIBDatabase.OnLogin := @loginPrompt;
398	+	FIBDatabase.Params.Clear;
399	+	FIBDatabase.Params.Values['lc_ctype'] := 'UTF8';
400		FIBTransaction := TIBTransaction.Create(self);
401		FIBTransaction.DefaultDatabase := FIBDatabase;
402		FIBXScript := TIBXScript.Create(self);
#	Line 304 | Line 404 | begin
404		FIBXScript.Transaction := FIBTransaction;
405		FIBXScript.OnOutputLog := @LogHandler;
406		FIBXScript.OnErrorLog := @ErrorLogHandler;
407	<	FIBXScript.OnSelectSQL := @HandleSelectSQL;
407	>	FISQLProcessor := TInteractiveSQLProcessor.Create(self);
408	>	FISQLProcessor.Database := FIBDatabase;
409	>	FISQLProcessor.Transaction := FIBTransaction;
410	>	FISQLProcessor.OnOutputLog := @LogHandler;
411	>	FISQLProcessor.OnErrorLog := @ErrorLogHandler;
412		FExtract := TIBExtract.Create(self);
413		FExtract.Database := FIBDatabase;
414		FExtract.Transaction := FIBTransaction;
311	–	FQuery := TIBQuery.Create(self);
312	–	FQuery.Database := FIBDatabase;
313	–	FQuery.Transaction := FIBTransaction;
415
416		FIBTransaction.Params.Add('concurrency');
417		FIBTransaction.Params.Add('wait');
317	–	FIBDatabase.Params.Add('lc_ctype=UTF8');
418
419		end;
420
321	–	destructor TFBSQL.Destroy;
322	–	begin
323	–	if assigned(FSQL) then FSQL.Free;
324	–	inherited Destroy;
325	–	end;
326	–
421		procedure TFBSQL.WriteHelp;
422		begin
423		writeln(stderr,'Usage: ',ExtractFileName(ExeName),' <options> <database name>');
424		writeln(stderr,'Options:');
425		writeln(stderr,'-a            write database metadata to stdout');
426	+	writeln(stderr,'-A            write database metadata and table data to stdout');
427		writeln(stderr,'-b            stop on first error');
428		writeln(stderr,'-e            echo sql statements to stdout');
429	<	writeln(stderr,'-f <filename> execute SQL script from file');
429	>	writeln(stderr,'-i <filename> execute SQL script from file');
430		writeln(stderr,'-h            show this information');
431	+	writeln(stderr,'-o <filename> output to this file instead of stdout');
432		writeln(stderr,'-p <password> provide password on command line (insecure)');
433		writeln(stderr,'-r <rolename> open database with this rolename');
434		writeln(stderr,'-s <sql>      Execute SQL text');
435	+	writeln(stderr,'-t            specify output format for SQL Statements');
436	+	writeln(stderr,'              BLK (default) for block format');
437	+	writeln(stderr,'              CSV (default) for CSV format');
438	+	writeln(stderr,'              INS (default) for Insert Statement format');
439		writeln(stderr,'-u <username> open database with this username (defaults to SYSDBA)');
440		writeln;
441		writeln(stderr,'Environment Variables:');
#	Line 347 | Line 447 | var
447		Application: TFBSQL;
448		begin
449		Application:=TFBSQL.Create(nil);
350	–	Application.Title:='fbsql';
450		Application.Run;
451		Application.Free;
452	+	if FExceptionTrapped then
453	+	Halt(1);
454		end.
455

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines