|
|
@@ -0,0 +1,296 @@
|
|
|
+{$mode objfpc}
|
|
|
+{$h+}
|
|
|
+uses
|
|
|
+ custapp, sysutils, strutils, classes, db, sqldb, bufdataset, XMLDatapacketReader,
|
|
|
+ sqlite3conn, pqconnection, ibconnection, mssqlconn, oracleconnection,mysql55conn,mysql40conn,mysql51conn,mysql50conn;
|
|
|
+
|
|
|
+Const
|
|
|
+ CmdSep = [' ',#9,#10,#13,#12];
|
|
|
+
|
|
|
+type
|
|
|
+
|
|
|
+ { TSQLShellApplication }
|
|
|
+
|
|
|
+ TSQLShellApplication = class(TCustomApplication)
|
|
|
+ Private
|
|
|
+ FConn : TSQLConnection;
|
|
|
+ FTR : TSQLTransaction;
|
|
|
+ FQuery : TSQLQuery;
|
|
|
+ FConnType : String;
|
|
|
+ FCharset : String;
|
|
|
+ FDatabaseName: String;
|
|
|
+ FHostName : string;
|
|
|
+ FUserName : String;
|
|
|
+ FPassword : String;
|
|
|
+ FPort : INteger;
|
|
|
+ FAutoCommit : Boolean;
|
|
|
+ procedure ConnectToDatabase;
|
|
|
+ procedure DisconnectFromDatabase;
|
|
|
+ procedure ExecuteCommand(const ASQL: UTF8String);
|
|
|
+ procedure ExecuteSystemCommand(const S : UTF8String);
|
|
|
+ procedure MaybeCommit;
|
|
|
+ procedure MaybeRollBack;
|
|
|
+ function ParseArgs: Boolean;
|
|
|
+ procedure RunCommandLoop;
|
|
|
+ procedure SaveLast(FN: String);
|
|
|
+ procedure Usage(const Err: String);
|
|
|
+ procedure WriteHelp;
|
|
|
+ Protected
|
|
|
+ procedure DoRun; override;
|
|
|
+ Property Conn : TSQLConnection Read FConn;
|
|
|
+ Property AutoCommit : Boolean Read FAutoCommit;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+Procedure TSQLShellApplication.ConnectToDatabase;
|
|
|
+
|
|
|
+begin
|
|
|
+ FConn:=TSQLConnector.Create(Self);
|
|
|
+ TSQLConnector(FConn).ConnectorType:=FConnType;
|
|
|
+ FTR:=TSQLTransaction.Create(Self);
|
|
|
+ Conn.Transaction:=FTR;
|
|
|
+ Conn.DatabaseName:=FDatabaseName;
|
|
|
+ Conn.HostName:=FHostName;
|
|
|
+ Conn.UserName:=FUserName;
|
|
|
+ Conn.Password:=FPassword;
|
|
|
+ Conn.Connected:=True;
|
|
|
+ if FCharset<>'' then
|
|
|
+ Conn.CharSet:=FCharset;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+Procedure TSQLShellApplication.DisconnectFromDatabase;
|
|
|
+
|
|
|
+begin
|
|
|
+ FreeAndNil(FTr);
|
|
|
+ FreeAndNil(FConn);
|
|
|
+end;
|
|
|
+
|
|
|
+Procedure TSQLShellApplication.ExecuteCommand(Const ASQL : UTF8String);
|
|
|
+
|
|
|
+Var
|
|
|
+ Q : TSQLQuery;
|
|
|
+ F : TField;
|
|
|
+
|
|
|
+begin
|
|
|
+ FreeAndNil(FQuery);
|
|
|
+ Q:=TSQLQuery.Create(Conn);
|
|
|
+ Q.Database:=Conn;
|
|
|
+ Q.Transaction:=FTr;
|
|
|
+ if not FTR.Active then
|
|
|
+ FTR.StartTransaction;
|
|
|
+ Q.SQL.Text:=aSQL;
|
|
|
+ Q.Prepare;
|
|
|
+ if Q.StatementType<>stSelect then
|
|
|
+ begin
|
|
|
+ Q.ExecSQL;
|
|
|
+ Writeln('Rows affected : ',Q.RowsAffected);
|
|
|
+ if AutoCommit then
|
|
|
+ (Q.Transaction as TSQLTransaction).Commit;
|
|
|
+ Q.Free;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ Q.Open;
|
|
|
+ Write('|');
|
|
|
+ For F in Q.Fields do
|
|
|
+ Write(' ',F.FieldName,' |');
|
|
|
+ Writeln;
|
|
|
+ While not Q.EOF do
|
|
|
+ begin
|
|
|
+ Write('|');
|
|
|
+ For F in Q.Fields do
|
|
|
+ Write(F.AsString,' |');
|
|
|
+ Writeln;
|
|
|
+ Q.Next;
|
|
|
+ end;
|
|
|
+ FQuery:=Q;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+Procedure TSQLShellApplication.SaveLast(FN : String);
|
|
|
+
|
|
|
+begin
|
|
|
+ FN:=Trim(FN);
|
|
|
+ if FN='' then
|
|
|
+ begin
|
|
|
+ Write('Type filename to save data: ');
|
|
|
+ Readln(fn);
|
|
|
+ end;
|
|
|
+ if (FN<>'') then
|
|
|
+ FQuery.SaveToFile(FN,dfXML);
|
|
|
+end;
|
|
|
+
|
|
|
+Procedure TSQLShellApplication.MaybeCommit;
|
|
|
+begin
|
|
|
+ if FTR.Active then
|
|
|
+ FTR.Commit;
|
|
|
+end;
|
|
|
+
|
|
|
+Procedure TSQLShellApplication.MaybeRollBack;
|
|
|
+begin
|
|
|
+ if FTR.Active then
|
|
|
+ FTR.Commit;
|
|
|
+end;
|
|
|
+
|
|
|
+Procedure TSQLShellApplication.ExecuteSystemCommand(Const S : UTF8String);
|
|
|
+
|
|
|
+Var
|
|
|
+ Cmd,Args : String;
|
|
|
+
|
|
|
+begin
|
|
|
+ Cmd:=ExtractWord(1,S,CmdSep);
|
|
|
+ Args:=S;
|
|
|
+ Delete(Args,1,Length(Cmd)+Pos(Cmd,Args)-1);
|
|
|
+ While (Length(Args)>0) and (Args[1] in CmdSep) do
|
|
|
+ Delete(Args,1,1);
|
|
|
+ case Cmd of
|
|
|
+ 'a','autocommit' :
|
|
|
+ FAutoCommit:=Not FAutoCommit;
|
|
|
+ 'q','quit' :
|
|
|
+ begin
|
|
|
+ MaybeCommit;
|
|
|
+ Terminate;
|
|
|
+ end;
|
|
|
+ 'x','exit' :
|
|
|
+ begin
|
|
|
+ MaybeRollBack;
|
|
|
+ Terminate;
|
|
|
+ end;
|
|
|
+ 'c','commit' :
|
|
|
+ MaybeCommit;
|
|
|
+ 'r','collback':
|
|
|
+ MaybeRollBack;
|
|
|
+ 's',
|
|
|
+ 'save' : SaveLast(Args);
|
|
|
+ '?','h','help' : WriteHelp;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+Procedure TSQLShellApplication.WriteHelp;
|
|
|
+
|
|
|
+begin
|
|
|
+ Writeln('Commands : ');
|
|
|
+ Writeln('\a \autocommit Toggle autocommit (Current autocommit :',FAutoCommit,')');
|
|
|
+ Writeln('\c \commit commit');
|
|
|
+ Writeln('\h \help this help');
|
|
|
+ Writeln('\q \quit commit and quit');
|
|
|
+ Writeln('\r \rollback commit');
|
|
|
+ Writeln('\x \exit RollBack and quit');
|
|
|
+ Writeln('\s \save [FN] Save result of last select to XML file');
|
|
|
+end;
|
|
|
+
|
|
|
+Procedure TSQLShellApplication.RunCommandLoop;
|
|
|
+
|
|
|
+Var
|
|
|
+ S : UTF8String;
|
|
|
+
|
|
|
+begin
|
|
|
+ Writeln('Enter commands, end with \q. \?, \h or \help for help.');
|
|
|
+ Repeat
|
|
|
+ Write('SQL > ');
|
|
|
+ Readln(S);
|
|
|
+ try
|
|
|
+ While (Length(S)>0) and (S[1] in CmdSep) do
|
|
|
+ Delete(S,1,1);
|
|
|
+ if Copy(S,1,1)='\' then
|
|
|
+ begin
|
|
|
+ Delete(S,1,1);
|
|
|
+ ExecuteSystemCommand(S)
|
|
|
+ end
|
|
|
+ else
|
|
|
+ ExecuteCommand(S)
|
|
|
+ except
|
|
|
+ On E : Exception do
|
|
|
+ Writeln(Format('Error %s executing command : %s',[E.ClassName,E.Message]));
|
|
|
+ end;
|
|
|
+ until Terminated;
|
|
|
+ Terminate;
|
|
|
+end;
|
|
|
+
|
|
|
+Procedure TSQLShellApplication.Usage(Const Err : String);
|
|
|
+
|
|
|
+Var
|
|
|
+ L : TStrings;
|
|
|
+ S : String;
|
|
|
+
|
|
|
+begin
|
|
|
+ if (Err<>'') then
|
|
|
+ Writeln('Error : ',Err);
|
|
|
+ Writeln('Usage : ',ExtractFileName(Paramstr(0)),' [options]');
|
|
|
+ Writeln('Where options is one or more of:');
|
|
|
+ Writeln('-h --help This help text.');
|
|
|
+ Writeln('-t --type=TYPE Set connection type.');
|
|
|
+ Writeln('-d --database=DB Set database name.');
|
|
|
+ Writeln('-H --hostname=DB Set database hostname.');
|
|
|
+ Writeln('-u --username=NAME Set database user name.');
|
|
|
+ Writeln('-p --password=PWD Set database user password.');
|
|
|
+ Writeln('-c --charset=SET Set database character set.');
|
|
|
+ Writeln('-P --port=N Set database connection port.');
|
|
|
+ Writeln('Known connection types for this binary:');
|
|
|
+ L:=TStringList.Create;
|
|
|
+ try
|
|
|
+ GetConnectionList(L);
|
|
|
+ for S in L do
|
|
|
+ Writeln(' ',S);
|
|
|
+ finally
|
|
|
+ L.Free;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+Function TSQLShellApplication.ParseArgs : Boolean;
|
|
|
+
|
|
|
+Var
|
|
|
+ S : String;
|
|
|
+
|
|
|
+begin
|
|
|
+ Result:=False;
|
|
|
+ S:=CheckOptions('hH:d:t:u:p:c:P:',['help','hostname:','database:','type:','username:','password:','c:charset','port']);
|
|
|
+ if (S<>'') or (HasOption('h','help')) then
|
|
|
+ begin
|
|
|
+ Usage(S);
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ FConnType:=GetOptionValue('t','type');
|
|
|
+ FHostName:=GetOptionValue('H','hostname');
|
|
|
+ FDatabaseName:=GetOptionValue('d','database');
|
|
|
+ FUserName:=GetOptionValue('u','user');
|
|
|
+ FPassword:=GetOptionValue('p','password');
|
|
|
+ FCharset:=GetOptionValue('c','charset');
|
|
|
+ if HasOption('P','port') then
|
|
|
+ begin
|
|
|
+ FPort:=StrToIntDef(GetOptionValue('P','port'),-1);
|
|
|
+ if FPort=-1 then
|
|
|
+ Usage('Databasename not supplied');
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ Result:=(FDatabaseName<>'');
|
|
|
+ if not Result then
|
|
|
+ Usage('Databasename not supplied');
|
|
|
+end;
|
|
|
+
|
|
|
+Procedure TSQLShellApplication.DoRun;
|
|
|
+
|
|
|
+begin
|
|
|
+ StopOnException:=True;
|
|
|
+ if Not ParseArgs then
|
|
|
+ begin
|
|
|
+ terminate;
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ ConnectToDatabase;
|
|
|
+ RunCommandLoop;
|
|
|
+ DisconnectFromDatabase;
|
|
|
+end;
|
|
|
+
|
|
|
+begin
|
|
|
+ With TSQLShellApplication.Create(Nil) do
|
|
|
+ try
|
|
|
+ Initialize;
|
|
|
+ Run;
|
|
|
+ finally
|
|
|
+ Free;
|
|
|
+ end;
|
|
|
+end.
|
|
|
+
|
|
|
+
|
marco