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
#	User	Rev	Content
1	tony	37	(*
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