examples/fbsql/fbsql.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) 2014 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)
program fbsql;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, CustApp
  { you can add units after this }
  ,IBDatabase, ibxscript, IBExtract, IBQuery, DB;

resourcestring

  sUnknownField = 'Unknown Field Type';
  sBadGraphic   = 'Unable to generate CSV data for a Graphic Field';
  sBadParadox   = 'Unable to generate CSV data for a Paradox OLE Field';
  sBadDBase     = 'Unable to generate CSV data  for a DBase OLE Field';
  sBadBinary    = 'Unable to generate CSV data  for a Binary Field';
  sBadCursor    = 'Unable to generate CSV data  for a Cursor Field';

type

  { TFBSQL }

  TFBSQL = class(TCustomApplication)
  private
    FIBDatabase: TIBDatabase;
    FIBTransaction: TIBTransaction;
    FIBXScript: TIBXScript;
    FExtract: TIBExtract;
    FQuery: TIBQuery;
    FSQL: TStringStream;
    procedure LogHandler(Sender: TObject; Msg: string);
    procedure ErrorLogHandler(Sender: TObject; Msg: string);
    procedure HandleSelectSQL(Sender: TObject; SQLText: string);
    procedure WriteCSV;
  protected
    procedure DoRun; override;
    procedure ShowException(E: Exception); override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure WriteHelp; virtual;
  end;

{ TFBSQL }

procedure TFBSQL.LogHandler(Sender: TObject; Msg: string);
begin
  writeln( Msg);
end;

procedure TFBSQL.ErrorLogHandler(Sender: TObject; Msg: string);
begin
  writeln(stderr, Msg);
end;

procedure TFBSQL.HandleSelectSQL(Sender: TObject; SQLText: string);
begin
  FQuery.SQL.Text := SQLText;
  FQuery.Active := true;
  try
    WriteCSV;
  finally
    FQuery.Active := false;
  end;
end;

procedure TFBSQL.WriteCSV;

  procedure WriteQuotedText(Text: string);
  var Index: integer;
  begin
    Index := 1;
    while Index <= Length(Text) do
      if Text[Index] = '"' then
      begin
        Insert('"',Text,Index);
        Inc(Index,2)
      end
      else
        Inc(Index,1);
    write('"' + Text + '"')
  end;

  procedure WriteFieldList(Fields: TFields);
  var I: integer;
  begin
    for I := 0 to Fields.Count - 1 do
    begin
      if I > 0 then write(',');
      write(Fields[I].FieldName)
    end;
    writeln;
  end;

  procedure WriteRecord;
  var I: integer;
  begin
    with FQuery do
    begin
      for I := 0 to FieldCount - 1 do
      begin
        if I <> 0 then write(',');
        case Fields[I].DataType of
        ftUnknown:  raise Exception.Create(sUnknownField);
        ftString:   WriteQuotedText(Fields[I].AsString);
        ftSmallint,
        ftInteger,
        ftWord,
        ftLargeInt,
        ftBoolean:  write(Fields[I].DisplayText);
        ftFloat,
        ftCurrency,
        ftFmtBCD,
        ftBCD:      write(Fields[I].AsString);
        ftDate,
        ftTime:     write(DateTimeToStr(Fields[I].AsDateTime));
        ftDateTime: WriteQuotedText(Fields[I].AsString);
        ftBytes,
        ftVarBytes,
        ftBlob,
        ftAutoInc:  write(Fields[I].AsString);
        ftMemo:     WriteQuotedText(Fields[I].AsString);
        ftGraphic:  raise Exception.Create(sBadGraphic);
        ftFmtMemo:  WriteQuotedText(Fields[I].AsString);
        ftParadoxOle: raise Exception.Create(sBadParadox);
        ftDBaseOle:   raise Exception.Create(sBadDBase);
        ftTypedBinary:raise Exception.Create(sBadBinary);
        ftCursor:    raise Exception.Create(sBadCursor);
       end
      end;
      writeln;
    end;
  end;
begin
  with FQuery do
  begin
    WriteFieldList(Fields);
    First;
    while not EOF do
    begin
      WriteRecord;
      Next
    end;
  end
end;

procedure TFBSQL.DoRun;
var
  ErrorMsg: String;
  SQLFileName: string;
  DoExtract: boolean;
  i: integer;
begin
  writeln(stderr,'fbsql: a non-interactive SQL interpreter for Firebird');
  writeln(stderr,'Copyright (c) MWA Software 2016');
  // quick check parameters
  ErrorMsg:=CheckOptions('ahbeufprs',['help','user','pass','role']);
  if ErrorMsg<>'' then begin
    ShowException(Exception.Create(ErrorMsg));
    Terminate;
    Exit;
  end;

  // parse parameters
  if HasOption('h','help') or (ParamCount = 0) then
  begin
    WriteHelp;
    Terminate;
    Exit;
  end;

  SQLFileName := '';
  DoExtract := false;

  {Initialise user_name and password from environment if available}

  if GetEnvironmentVariable('ISC_USER') <> '' then
    FIBDatabase.Params.Add('user_name=' + GetEnvironmentVariable('ISC_USER'));

  if GetEnvironmentVariable('ISC_PASSWORD') <> '' then
    FIBDatabase.Params.Add('password=' + GetEnvironmentVariable('ISC_PASSWORD'));

  {Process Command line options}

  if HasOption('u','user') then
    FIBDatabase.Params.Add('user_name=' + GetOptionValue('u','user'));

  if HasOption('p','pass') then
    FIBDatabase.Params.Add('password=' + GetOptionValue('p','pass'));

  if HasOption('r','role') then
    FIBDatabase.Params.Add('sql_role_name=' + GetOptionValue('r','role'));

  if (ParamCount >= 1) and (ParamStr(ParamCount)[1] <> '-')  then
    FIBDatabase.DatabaseName := ParamStr(ParamCount)
  else
    raise Exception.Create('Database Name Missing');

  if not HasOption('b') then
    FIBXScript.StopOnFirstError := false;

  if not HasOption('e') then
    FIBXScript.Echo := false;

  if HasOption('a') then
    DoExtract := true;

  if HasOption('f') then
    SQLFileName := GetOptionValue('f');

  if HasOption('s') then
  begin
    FSQL.WriteString(GetOptionValue('s'));
    FSQL.Position := 0;
  end;

  {Validation}

  if not DoExtract then
  begin
    if (SQLFileName = '') and (FSQL.DataString = '') then
      raise Exception.Create('An SQL File must be provided');

    if (FSQL.DataString <> '') and (SQLFileName <> '') then
       raise Exception.Create('An SQL Script File and text cannot be simulateously requested');

    if (FSQL.DataString = '') and not FileExists(SQLFileName) then
      raise Exception.CreateFmt('SQL File "%s" not found!',[SQLFileName]);

  end;

  if DoExtract and ((SQLFileName <> '') or (FSQL.DataString <> '')) then
    raise Exception.Create('Extract and script execution cannot be simulateously requested');

  {This is where it all happens}

  FIBDatabase.Connected := true;
  try
    if DoExtract then
    begin
      FExtract.ExtractObject(eoDatabase);
      for i := 0 to FExtract.Items.Count - 1 do
        writeln(FExtract.Items[i]);
    end
    else
    if FSQL.DataString = '' then
      FIBXScript.PerformUpdate(SQLFileName,true)
    else
      FIBXScript.PerformUpdate(FSQL,true);
  finally
    FIBDatabase.Connected := false;
  end;


  // stop program loop
  Terminate;
end;

procedure TFBSQL.ShowException(E: Exception);
begin
  writeln(stderr,'Error: ' + E.Message);
end;

constructor TFBSQL.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException:=True;
  FSQL := TStringStream.Create('');

  { Create Components }
  FIBDatabase := TIBDatabase.Create(self);
  FIBTransaction := TIBTransaction.Create(self);
  FIBTransaction.DefaultDatabase := FIBDatabase;
  FIBXScript := TIBXScript.Create(self);
  FIBXScript.Database := FIBDatabase;
  FIBXScript.Transaction := FIBTransaction;
  FIBXScript.OnOutputLog := @LogHandler;
  FIBXScript.OnErrorLog := @ErrorLogHandler;
  FIBXScript.OnSelectSQL := @HandleSelectSQL;
  FExtract := TIBExtract.Create(self);
  FExtract.Database := FIBDatabase;
  FExtract.Transaction := FIBTransaction;
  FQuery := TIBQuery.Create(self);
  FQuery.Database := FIBDatabase;
  FQuery.Transaction := FIBTransaction;

  FIBTransaction.Params.Add('concurrency');
  FIBTransaction.Params.Add('wait');
  FIBDatabase.Params.Add('lc_ctype=UTF8');

end;

destructor TFBSQL.Destroy;
begin
  if assigned(FSQL) then FSQL.Free;
  inherited Destroy;
end;

procedure TFBSQL.WriteHelp;
begin
  writeln(stderr,'Usage: ',ExtractFileName(ExeName),' <options> <database name>');
  writeln(stderr,'Options:');
  writeln(stderr,'-a            write database metadata to stdout');
  writeln(stderr,'-b            stop on first error');
  writeln(stderr,'-e            echo sql statements to stdout');
  writeln(stderr,'-f <filename> execute SQL script from file');
  writeln(stderr,'-h            show this information');
  writeln(stderr,'-p <password> provide password on command line (insecure)');
  writeln(stderr,'-r <rolename> open database with this rolename');
  writeln(stderr,'-s <sql>      Execute SQL text');
  writeln(stderr,'-u <username> open database with this username (defaults to SYSDBA)');
  writeln;
  writeln(stderr,'Environment Variables:');
  writeln(stderr,'ISC_USER      Login user Name');
  writeln(stderr,'ISC_PASSWORD  Login password');
end;

var
  Application: TFBSQL;
begin
  Application:=TFBSQL.Create(nil);
  Application.Title:='fbsql';
  Application.Run;
  Application.Free;
end.

Revision:	37
Committed:	Mon Feb 15 14:44:25 2016 UTC (8 years, 9 months ago) by tony
File size:	9622 byte(s)
Log Message:	Committing updates for Release R1-4-0
#	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.Database := FIBDatabase;
313	FQuery.Transaction := FIBTransaction;
314
315	FIBTransaction.Params.Add('concurrency');
316	FIBTransaction.Params.Add('wait');
317	FIBDatabase.Params.Add('lc_ctype=UTF8');
318
319	end;
320
321	destructor TFBSQL.Destroy;
322	begin
323	if assigned(FSQL) then FSQL.Free;
324	inherited Destroy;
325	end;
326
327	procedure TFBSQL.WriteHelp;
328	begin
329	writeln(stderr,'Usage: ',ExtractFileName(ExeName),' <options> <database name>');
330	writeln(stderr,'Options:');
331	writeln(stderr,'-a write database metadata to stdout');
332	writeln(stderr,'-b stop on first error');
333	writeln(stderr,'-e echo sql statements to stdout');
334	writeln(stderr,'-f <filename> execute SQL script from file');
335	writeln(stderr,'-h show this information');
336	writeln(stderr,'-p <password> provide password on command line (insecure)');
337	writeln(stderr,'-r <rolename> open database with this rolename');
338	writeln(stderr,'-s <sql> Execute SQL text');
339	writeln(stderr,'-u <username> open database with this username (defaults to SYSDBA)');
340	writeln;
341	writeln(stderr,'Environment Variables:');
342	writeln(stderr,'ISC_USER Login user Name');
343	writeln(stderr,'ISC_PASSWORD Login password');
344	end;
345
346	var
347	Application: TFBSQL;
348	begin
349	Application:=TFBSQL.Create(nil);
350	Application.Title:='fbsql';
351	Application.Run;
352	Application.Free;
353	end.
354