unit zSql;
{
usage :
sql := TzSql.Create;
ConnectorType := Firebird | MSSQLServer | MySQL 5.7 | Oracle | PostgreSQL | SQLite3 | Sybase
uri := 'MSSQLServer://username:password@localhost//database?AutoCommit=True';
uri := 'PostgreSQL://username:password@localhost//database';
uri := 'SQLite3://username:password@localhost//database.db';
uri := 'MySQL://username:password@localhost//database';
// oracle and firebird not yet tested
sql.Query('select version()').Run;
account_id := 1; // Int32
sql.Query('exec dbo.get_account')
.Param('account_id', account_id)
.Exec;
sql.Free;
}
{$mode objfpc}
{$h+}
interface
uses Classes, SysUtils, StrUtils, URIParser, SqlDb, Db,
Sqlite3conn, MySql57conn, IBConnection,
OracleConnection, MSSqlConn, PqConnection;
type
TzSql = class (TObject)
private
FSqlConnector :TSqlConnector;
FSqlTransaction :TSqlTransaction;
FSqlQuery :TSqlQuery;
FMessage :String;
function AsTable :String;
public
constructor Create;
destructor Destroy; override;
function Connect(const AUri :String) :Boolean;
function Query(const AQuery :String) :TzSql;
function Param(const AName :String; const AValue :Boolean ) :TzSql; overload;
function Param(const AName :String; const AValue :Int16 ) :TzSql; overload;
function Param(const AName :String; const AValue :Int32 ) :TzSql; overload;
function Param(const AName :String; const AValue :Int64 ) :TzSql; overload;
function Param(const AName :String; const AValue :Double ) :TzSql; overload;
function Param(const AName :String; const AValue :Currency ) :TzSql; overload;
function Param(const AName :String; const AValue :TDateTime) :TzSql; overload;
function Param(const AName :String; const AValue :TGuid ) :TzSql; overload;
function Param(const AName :String; const AValue :String ) :TzSql; overload;
function Param(const AName :String; const AValue :TBytes ) :TzSql; overload;
function Exec :Int64;
function Run :String;
property Message :String read FMessage;
end;
implementation
constructor TzSql.Create;
begin
FSqlConnector := TSqlConnector.Create(nil);
FSqlTransaction := TSqlTransaction.Create(nil);
FSqlQuery := TSqlQuery.Create(nil);
end;
destructor TzSql.Destroy;
begin
if Assigned(FSqlQuery) then FreeAndNil(FSqlQuery);
if Assigned(FSqlTransaction) then FreeAndNil(FSqlTransaction);
if Assigned(FSqlConnector) then FreeAndNil(FSqlConnector);
end;
function TzSql.Connect(const AUri :String) :Boolean;
var uri :TUri;
begin
try
uri := ParseUri(AUri, True);
if uri.Protocol = 'MySQL' then uri.Protocol += ' 5.7'; // uri cannot accept ' '
FSqlConnector.ConnectorType := uri.Protocol;
FSqlConnector.Hostname := uri.Host;
FSqlConnector.DatabaseName := uri.Document;
FSqlConnector.Username := uri.Username;
FSqlConnector.Password := uri.Password;
FSqlConnector.Params.Text := uri.Params;
FSqlConnector.KeepConnection := True;
if FSqlConnector.ConnectorType = 'MSSQLServer' then
begin
FSqlConnector.Params.Text := 'AutoCommit=True'; // somehow SqlTransaction error when free
FSqlTransaction.Options := [stoUseImplicit]; // use implicit
end;
FSqlTransaction.Database := FSqlConnector;
FSqlQuery.PacketRecords := -1;
FSqlQuery.UniDirectional := True;
FSqlQuery.ReadOnly := True;
FSqlQuery.Transaction := FSqlTransaction;
FSqlConnector.Open;
FMessage := '';
result := FSqlConnector.Connected
except
on E: Exception do
begin
FMessage := E.Message;
result := false;
end;
end;
end;
function TzSql.Query(const AQuery :String) :TzSql;
begin
FSqlQuery.Params.Clear;
FSqlQuery.SQL.Text := AQuery;
result := self;
end;
function TzSql.Param(const AName :String; const AValue :Boolean) :TzSql; overload;
begin
FSqlQuery.SQL.Text := FSqlQuery.SQL.Text + ' :' + AName;
FSqlQuery.Params.ParamByName(AName).AsBoolean := AValue;
result := self;
end;
function TzSql.Param(const AName :String; const AValue :Int16) :TzSql; overload;
begin
FSqlQuery.SQL.Text := FSqlQuery.SQL.Text + ' :' + AName;
FSqlQuery.Params.ParamByName(AName).AsSmallInt := AValue;
result := self;
end;
function TzSql.Param(const AName :String; const AValue :Int32) :TzSql; overload;
begin
FSqlQuery.SQL.Text := FSqlQuery.SQL.Text + ' :' + AName;
FSqlQuery.Params.ParamByName(AName).AsInteger := AValue;
result := self;
end;
function TzSql.Param(const AName :String; const AValue :Int64) :TzSql; overload;
begin
FSqlQuery.SQL.Text := FSqlQuery.SQL.Text + ' :' + AName;
FSqlQuery.Params.ParamByName(AName).AsLargeInt := AValue;
result := self;
end;
function TzSql.Param(const AName :String; const AValue :Double) :TzSql; overload;
begin
FSqlQuery.SQL.Text := FSqlQuery.SQL.Text + ' :' + AName;
FSqlQuery.Params.ParamByName(AName).AsFloat := AValue;
result := self;
end;
function TzSql.Param(const AName :String; const AValue :Currency) :TzSql; overload;
begin
FSqlQuery.SQL.Text := FSqlQuery.SQL.Text + ' :' + AName;
FSqlQuery.Params.ParamByName(AName).AsCurrency := AValue;
result := self;
end;
function TzSql.Param(const AName :String; const AValue :TDateTime) :TzSql; overload;
begin
FSqlQuery.SQL.Text := FSqlQuery.SQL.Text + ' :' + AName;
FSqlQuery.Params.ParamByName(AName).AsDateTime := AValue;
result := self;
end;
function TzSql.Param(const AName :String; const AValue :TGuid) :TzSql; overload;
begin
FSqlQuery.SQL.Text := FSqlQuery.SQL.Text + ' :' + AName;
FSqlQuery.Params.ParamByName(AName).AsString := AValue.ToString;
result := self;
end;
function TzSql.Param(const AName :String; const AValue :String) :TzSql; overload;
begin
FSqlQuery.SQL.Text := FSqlQuery.SQL.Text + ' :' + AName;
FSqlQuery.Params.ParamByName(AName).AsString := AValue;
result := self;
end;
function TzSql.Param(const AName :String; const AValue :TBytes) :TzSql; overload;
begin
FSqlQuery.SQL.Text := FSqlQuery.SQL.Text + ' :' + AName;
FSqlQuery.Params.ParamByName(AName).AsBytes := AValue;
result := self;
end;
function TzSql.Exec :Int64;
begin
try
if not FSqlConnector.Connected then FSqlConnector.Open;
if not FSqlTransaction.Active then FSqlTransaction.StartTransaction;
FSqlQuery.Prepare;
FSqlQuery.ExecSql;
if FSqlTransaction.Active then FSqlTransaction.Commit;
FMessage := '';
result := 0; // := FSqlQuery.RowsAffected; // seems not working always -1
except
on E: Exception do
begin
if FSqlTransaction.Active then FSqlTransaction.Rollback;
FMessage := E.Message;
result := -1;
end;
end;
end;
function TzSql.Run :String;
begin
result := '';
try
FSqlQuery.Open;
// begin tran
if not FSqlTransaction.Active then FSqlTransaction.StartTransaction;
if not FSqlQuery.Eof then result := AsTable;
// commit tran
if FSqlTransaction.Active then FSqlTransaction.Commit;
FSqlQuery.Close;
FMessage := '';
except
on E :Exception do
begin
// rollback tran
if FSqlTransaction.Active then FSqlTransaction.Rollback;
FSqlQuery.Close;
FMessage := E.Message;
end;
end;
end;
function TzSql.AsTable :String;
var ncol, nrow, col :Int64;
var header, lines, first :String;
begin
result := '';
header := '';
lines := '';
first := '';
ncol := FSqlQuery.FieldCount;
nrow := 1;
// note: problemo with sql server display width
for col:=0 to ncol-1 do
with FSqlQuery.Fields[col] do
begin
if Alignment = TAlignment.taLeftJustify then
begin
header += PadRight(DisplayLabel, DisplayWidth) + ' ';
first += PadRight(AsString, DisplayWidth) + ' ';
end
else
begin
header += PadLeft (DisplayLabel, DisplayWidth) + ' ';
first += PadLeft (AsString, DisplayWidth) + ' ';
end;
lines += StringOfChar('-', DisplayWidth) + ' ';
end;
result := header + LineEnding
+ lines + LineEnding
+ first + LineEnding;
FSqlQuery.Next;
while not FSqlQuery.Eof do
begin
Inc(nrow);
for col:=0 to ncol-1 do
with FSqlQuery.Fields[col] do
begin
if Alignment = TAlignment.taLeftJustify then
result += PadRight(AsString, DisplayWidth) + ' '
else
result += PadLeft (AsString, DisplayWidth) + ' ';
end;
result += LineEnding;
FSqlQuery.Next;
end;
result += LineEnding + 'rows: ' + IntToStr(nrow) + LineEnding;
end;
end.
Recent
