Buscar

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.

 

Publicidade

Vote na dica




Quantidade de votos: 0 votos
Aceitação: 0%


Detalhes da dica

Categoria: Componentes
Adicionada dia: 19/05/10
Por: Marcos Fernando Barbosa
Visualizada: 11085 vezes

Planeta Delphi - Tudo sobre programação Delphi Planeta Delphi - www.planetadelphi.com.br - Todos os direitos reservados | Copyright 2001-2009