Buscar por:
Unit de conexão com base de dados ORACLE, SQL SERVER, FIREBIRD

Código
unit SGDBDATABASE;

interface

uses

  SysUtils, Classes, DBXpress, DB, SqlExpr, Windows, DBClient, Variants;

type

  TSGDB = (FIREBIRD, SQLSERVER, ORACLE);

  TSGDBDATABASE = class(TComponent)

  private

    { Private declarations }

    FSQLConnection: TSQLConnection;

    FSGDB: TSGDB;

    FHost: String;

    FReferencia: String;

    FUsuario: String;

    FSenha: String;

    TD: TtransactionDesc;

    FConectado: Boolean;

    FDataHoraConexaoAbertura: TDateTime;

    FDataHoraConexaoFechamento: TDateTime;

    Ferro: String;

    procedure SetTipoBanco(const Value: TSGDB);

    procedure SetSQLConnection(const Value: TSQLConnection);

    procedure SetDataHoraConexaoAbertura(const Value: TDateTime);

    procedure SetDataHoraConexaoFechamento(const Value: TDateTime);

  protected

    { Protected declarations }

  public

    { Public declarations }

    constructor Create(AOwner: TComponent); override;

    destructor  Destroy; override;

    function  GetFirstTopString: String;

    function  GetDataHoraServidor: TDateTime;

    function  GetDataServidor: TDateTime;

    function  Conectado: Boolean;

    function  EmTransacao: Boolean;

    procedure CommitTransaction(DataSet: TDataSet);

    procedure IniciaTransacao;

    procedure Commit;

    procedure RollBack;

    function  ExecutaSQL(strSQL, Tipo: String): Variant;

    function  ProximoCodigo(Tabela, Campo: String): Integer;

    property  DataHoraConexaoAbertura: TDateTime read FDataHoraConexaoAbertura

      write SetDataHoraConexaoAbertura;

    property  DataHoraConexaoFechamento: TDateTime read FDataHoraConexaoFechamento

      write SetDataHoraConexaoFechamento;

    procedure ReconcileError(DataSet: TCustomClientDataSet;

      E: EReconcileError; UpdateKind: TUpdateKind;

      var Action: TReconcileAction);

  published

    { Published declarations }

    property SQLConnection: TSQLConnection read FSQLConnection write SetSQLConnection;

    property SGDB: TSGDB read FSGDB write setTipoBanco default FireBird;

    property Host: String read FHost write FHost;

    property Referencia: String read FReferencia write FReferencia;

    property Usuario: String read FUsuario write FUsuario;

    property Senha: String read FSenha write FSenha;

  end;

procedure Register;

implementation

procedure Register;

begin

  RegisterComponents('SGDBDATABASE', [TSGDBDATABASE]);

end;

{ TSGDBDATABASE }

constructor TSGDBDATABASE.Create(AOwner: TComponent);

begin

  inherited Create(AOwner);

  FSQLConnection := nil;

end;

procedure TSGDBDATABASE.CommitTransaction(DataSet: TDataSet);

var

  TransacaoMultipla: Boolean;

begin

  TransacaoMultipla := False;

  if not(EmTransacao) then begin

    IniciaTransacao;

  end else begin

    TransacaoMultipla := True;

  end;

  try

    if TClientDataSet(DataSet).ApplyUpdates(0) <> 0 then begin

      raise Exception.Create(FErro);

    end;

    if not(TransacaoMultipla) then begin

      Commit;

    end;

  except

    Rollback;

    FErro := '';

  end;

end;

procedure TSGDBDATABASE.ReconcileError(DataSet: TCustomClientDataSet;

  E: EReconcileError; UpdateKind: TUpdateKind;

  var Action: TReconcileAction);

begin

  FErro := E.Message;

  Action := raCancel;

end;

procedure TSGDBDATABASE.IniciaTransacao;

begin

  if not(EmTransacao) then begin

    TD.TransactionID :=

      StrToInt(FormatDateTime('NNSSZZZ', now) + IntToStr(Random(9)));

    TD.GlobalID := TD.TransactionID;

    TD.IsolationLevel := xilREADCOMMITTED;

    SQLConnection.StartTransaction(TD);

  end;

end;

procedure TSGDBDATABASE.Commit;

begin

  if EmTransacao then begin

    SQLConnection.Commit(TD);

  end else begin

    raise Exception.Create('Nenhuma transação ativa foi encontrada!');

  end;

end;

procedure TSGDBDATABASE.RollBack;

begin

  if EmTransacao then begin

    SQLConnection.Rollback(TD);

  end else begin

    raise Exception.Create('Nenhuma transação ativa foi encontrada!');

  end;

end;

function TSGDBDATABASE.GetDataServidor: TDateTime;

var

  Qry: TSQLQuery;

begin

  Qry := TSQLQuery.Create(nil);

  Qry.SQLConnection := SQLConnection;

  with Qry do begin

    Close;

    if FSGDB = FIREBIRD then begin

      SQL.Text := 'SELECT CAST(''NOW'' AS DATE) AS ATUAL FROM RDB$DATABASE';

    end else if FSGDB = SQLSERVER then begin

      SQL.Text := 'SELECT GETDATE() AS ATUAL';

    end else if FSGDB = ORACLE then begin

          SQL.Text := 'SELECT to_char(Sysdate,''dd/mm/yyyy'') as Atual from dual';

    end;

    Open;

    Result := FieldByName('ATUAL').AsDateTime;

  end;

  Qry.Free;

end;

function TSGDBDATABASE.GetDataHoraServidor: TDateTime;

var

  Qry: TSQLQuery;

begin

  Qry := TSQLQuery.Create(nil);

  Qry.SQLConnection := SQLConnection;

  with Qry do begin

    Close;

    if FSGDB = FIREBIRD then begin

      SQL.Text := 'SELECT CAST(''NOW'' AS TIMESTAMP) AS ATUAL FROM RDB$DATABASE';

    end else if FSGDB = SQLSERVER then begin

      SQL.Text := 'SELECT GETDATE() AS ATUAL';

    end else if FSGDB = ORACLE then begin

          SQL.Text := 'SELECT to_char(Sysdate,''hh:mm:ss'') as Atual from dual';

    end;

    Open;

    Result := FieldByName('ATUAL').AsDateTime;

  end;

  Qry.Free;

end;

function TSGDBDATABASE.GetFirstTopString: String;

begin

  if FSGDB = FIREBIRD then begin

    Result := ' FIRST ';

  end else if FSGDB = SQLSERVER then begin

    Result := ' TOP ';

  end else if FSGDB = ORACLE then begin

    Result := ' FIRST ';

  end;

end;

procedure TSGDBDATABASE.SetSQLConnection(const Value: TSQLConnection);

begin

  FSQLConnection := Value;

  FSQLConnection.Connected := False;  

  FSQLConnection.KeepConnection := False;

  FSQLConnection.LoginPrompt := False;

  SetTipoBanco(FSGDB);

end;

procedure TSGDBDATABASE.SetTipoBanco(const Value: TSGDB);

begin

  FSGDB := Value;

  if SQLConnection.Connected then begin

    try

      SQLConnection.Close;

    except

      raise exception.Create('Não foi possivel fechar o SQLConnection!');

      Exit;

    end;

  end;

  SQLConnection.Params.Clear;

  if FSGDB = FIREBIRD then begin

    SQLConnection.KeepConnection := False;

    SQLConnection.LoginPrompt := False;

    SQLConnection.DriverName := 'Interbase';

    SQLConnection.GetDriverFunc := 'getSQLDriverINTERBASE';

    SQLConnection.VendorLib := 'FBCLIENT.DLL';

    SQLConnection.LibraryName := 'dbexpint.dll';

    SQLConnection.Params.Add('BlobSize=-1');

    SQLConnection.Params.Add('CommitRetain=False');

    if FHost = 'localhost' then begin

      SQLConnection.Params.Add('Database=' + FReferencia);

    end else begin

      SQLConnection.Params.Add('Database=' + FHost + ':' + FReferencia);

    end;

    SQLConnection.Params.Add('ErrorResourceFile=');

    SQLConnection.Params.Add('LocaleCode=0000');

    SQLConnection.Params.Add('Password=' + FSenha);

    SQLConnection.Params.Add('RoleName=RoleName');

    SQLConnection.Params.Add('ServerCharSet=ISO8859_1');

    SQLConnection.Params.Add('SQLDialect=3');

    SQLConnection.Params.Add('Interbase TransIsolation=ReadCommited');

    SQLConnection.Params.Add('User_Name=' + FUsuario);

    SQLConnection.Params.Add('WaitOnLocks=True');

    SQLConnection.Params.Add('Trim Char=False');

  end else if FSGDB = SQLSERVER then begin

    SQLConnection.KeepConnection := False;

    SQLConnection.LoginPrompt := False;

    SQLConnection.DriverName := 'SQLServer';

    SQLConnection.GetDriverFunc := 'getSQLDriverSQLServer';

    SQLConnection.VendorLib := 'sqloledb.dll';

    SQLConnection.LibraryName := 'dbexpsda.dll';

    SQLConnection.Params.Add('BlobSize=-1');

    SQLConnection.Params.Add('HostName=' + FHost);

    SQLConnection.Params.Add('DataBase=' + FReferencia);

    SQLConnection.Params.Add('User_Name=' + FUsuario);

    SQLConnection.Params.Add('Password=' + FSenha);

  end else if FSGDB = ORACLE then begin 

    SQLConnection.KeepConnection := False;

    SQLConnection.LoginPrompt := False;

    SQLConnection.DriverName := 'Oracle';

    SQLConnection.GetDriverFunc := 'getSQLDriverORACLE';

    SQLConnection.VendorLib := 'oci.dll';

    SQLConnection.LibraryName := 'dbexpora.dll';

    SQLConnection.Params.Add('BlobSize=-1');

    SQLConnection.Params.Add('HostName=' + FHost);

    SQLConnection.Params.Add('DataBase=' + FReferencia);

    SQLConnection.Params.Add('User_Name=' + FUsuario);

    SQLConnection.Params.Add('Password=' + FSenha);

  end;

end;

function TSGDBDATABASE.Conectado: Boolean;

begin

  FConectado := SQLConnection.Connected;

end;

function TSGDBDATABASE.EmTransacao: Boolean;

begin

  Result := SQLConnection.InTransaction;

end;

function TSGDBDATABASE.ExecutaSQL(strSQL, Tipo: String): Variant;

var

  Qry: TSQLQuery;

begin

  Qry := TSQLQuery.Create(nil);

  Qry.SQLConnection := SQLConnection;

  try

    with Qry do begin

      Close;

      SQL.Text := strSQL;

      if Tipo = 'ABERTURA' then begin

        Open;

        Result := Fields[0].Value;

      end else begin

        ExecSql;

        Result := Null;

      end;

    end;

  except

    on erro: Exception do begin

      raise exception.Create('Erro ao executar SQL: ' + erro.Message);

    end;

  end;

  Qry.Free;

end;

destructor TSGDBDATABASE.Destroy;

begin

  FSQLConnection := nil;

  FHost := '';

  FReferencia := '';

  FUsuario := '';

  FSenha := '';

  inherited;

end;

function TSGDBDATABASE.ProximoCodigo(Tabela, Campo: String): Integer;

var

  Qry: TSQLQuery;

begin

  if trim(Tabela) = '' then begin

    raise Exception.Create('Tabela não foi informada!');

    Exit;

  end;

  if trim(Campo) = '' then begin

    raise Exception.Create('Campo da tabela não foi informado!');

    Exit;

  end;

  Qry := TSQLQuery.Create(nil);

  Qry.SQLConnection := SQLConnection;

  with Qry do

  begin

    Close;

    SQL.Text := 'SELECT MAX(' + Campo + ') AS MAXIMO FROM ' + Tabela;

    Open;

    if IsEmpty

      then Result := 1

      else Result := StrToInt(FieldByName('MAXIMO').AsString)+ 1

  end;

  Qry.Free;

end;

procedure TSGDBDATABASE.SetDataHoraConexaoAbertura(const Value: TDateTime);

begin

  FDataHoraConexaoAbertura := Value;

end;

procedure TSGDBDATABASE.SetDataHoraConexaoFechamento(const Value: TDateTime);

begin

  FDataHoraConexaoFechamento := Value;

end;

end.