Аналог TSQLiteWrapper для FireBird

Любые обсуждения, не нарушающие правил форума.

Модератор: Модераторы

Ответить

Аналог TSQLiteWrapper для FireBird

Сообщение Nik » 31.05.2011 20:18:51

Интересно, есть ил в природе что-то похожее на TSQLiteWrapper для работы с FireBird (через fbclient.dll)? Чтобы можно было работать без связки DataSet/DataSource, а с помощью пары объектов.
Аватара пользователя
Nik
энтузиаст
 
Сообщения: 573
Зарегистрирован: 04.02.2006 00:08:09
Откуда: Киров
Вернуться к началу

Re: Аналог TSQLiteWrapper для FireBird

Сообщение Brainenjii » 31.05.2011 21:57:14

есть UIB, Zeos, IBX... Все они имеют что-нибудь вроде Query, с которыми можно работать без всяких DataSet'ов... Я как-то в своём развитии вообще упустил DataSet и подобное ^_^ Если интересно - то вот мой "wrapper" над UIB/IBX/TDS - работа с базой большую часть времени происходит через один объект - BQueryClass:
Код: Выделить всё
Unit BQueryUnit;

{$mode objfpc}{$H+}

Interface

Uses
  {$IFDEF TDS}
    TDSCTDataBase,
  {$ENDIF}
  {$IFDEF UIB}
    uib, uiblib,
  {$ENDIF}
  {$IFDEF IBX}
    IBDatabase, IBSQL,
  {$ENDIF}
  Classes, SysUtils, BSQLUnit;

Const
  STEP_MAX = 3;

  DB_FB = 1;
  DB_MS = 2;

Type

{ BQueryClass }

BQueryClass = Class
  Private
    bID, bKind: Integer;
    {$IFDEF UIB}
    bUIBQuery: TUIBQuery;
    bUIBDatabase: TUIBDataBase;
    bUIBWrite, bUIBRead: TUIBTransaction;
    {$ENDIF}
    {$IFDEF TDS}
    bTDSQuery: TTDSCTQuery;
    bTDSDatabase: TTDSCTDataBase;
    bTDSWrite, bTDSRead: TTDSCTTransaction;
    {$ENDIF}
    {$IFDEF IBX}
    bIBXQuery: TIBSQL;
    bIBXDatabase: TIBDataBase;
    bIBXWrite, bIBXRead: TIBTransaction;
    {$ENDIF}
    {$IFDEF UIB}
    Function GetUIB(Const aSQL: BSQLClass): Boolean;
    Function PostUIB(Const aSQL: BSQLClass): Boolean;
    {$ENDIF}
    {$IFDEF TDS}
    Function GetTDS(Const aSQL: BSQLClass): Boolean;
    Function PostTDS(Const aSQL: BSQLClass): Boolean;
    {$ENDIF}
    {$IFDEF IBX}
    Function GetIBX(Const aSQL: BSQLClass): Boolean;
    Function PostIBX(Const aSQL: BSQLClass): Boolean;
    {$ENDIF}
  Public
    Function ByString(Const aString: String): String;
    Function ByDouble(Const aString: String): Double;
    Function ByInteger(Const aString: String): Integer;
    Function ByInt64(Const aString: String): Int64;
    Function ByBoolean(Const aString: String): Boolean;
    Function ByDate(Const aString: String): TDateTime;
    Function ByDateTime(Const aString: String): TDateTime;
    Function Get(Const aSQL: BSQLClass): Boolean;
    Function Get(Const aString: String;
      Const ForExecute: Boolean = FALSE): Boolean;
    Function Post(Const aSQL: BSQLClass): Boolean; Overload;
    Function Post(Const aString: String;
      Const ForExecute: Boolean = FALSE): Boolean; Overload;
    Function EOF: Boolean;
    Procedure Go;
    Procedure Next;
    Procedure First;
    Constructor Build(Const aID: Integer = 0);
    Destructor Burn;
End;

Type

{ BDBManagerClass }

BDBManagerClass = Class
  Strict Private
    bPools: TThreadList;
  Public
    Procedure AddDatabase(Const aKind: Integer;
      Const aServer, aBase, aUser, aPassword: String; Const aLib:String='');
    Procedure RemoveDatabase(Const aIndex: Integer);
    Function GetKind(Const aIndex: Integer): Integer;
    Procedure Connect(Const aIndex: Integer = 0; Const aPoolSize: Integer = 1);
    {$IFDEF UIB}
    Procedure HoldUIBConnection(Const aIndex: Integer;
      Out aDatabase: TUIBDataBase; Out aRead, aWrite: TUIBTransaction);
    Procedure FreeUIBConnection(Const aIndex: Integer;
      Const aDatabase: TUIBDataBase);
    {$ENDIF}
    {$IFDEF TDS}
    Procedure HoldTDSConnection(Const aIndex: Integer;
      Out aDatabase: TTDSCTDataBase; Out aRead, aWrite: TTDSCTTransaction);
    Procedure FreeTDSConnection(Const aIndex: Integer;
      Const aDatabase: TTDSCTDataBase);
    {$ENDIF}
    {$IFDEF IBX}
    Procedure HoldIBXConnection(Const aIndex: Integer;
      Out aDatabase: TIBDataBase; Out aRead, aWrite: TIBTransaction);
    Procedure FreeIBXConnection(Const aIndex: Integer;
      Const aDatabase: TIBDataBase);
    {$ENDIF}
    Procedure Disconnect(Const aIndex: Integer = 0);
    Constructor Build;
    Destructor Burn;
End;

Var
  DBManager: BDBManagerClass;

Implementation

Const
  STR_MSSQL = '/usr/lib/libct.so';

Type

{ BConnectionClass }

BConnectionClass = Class
  Strict Private
    bBusy: Boolean;
    bKind: Integer;
    {$IFDEF UIB}
    bUIBDatabase: TUIBDataBase;
    bReadUIBTransaction: TUIBTransaction;
    bWriteUIBTransaction: TUIBTransaction;
    {$ENDIF}
    {$IFDEF TDS}
    bTDSDatabase: TTDSCTDataBase;
    bReadTDSTransaction: TTDSCTTransaction;
    bWriteTDSTransaction: TTDSCTTransaction;
    {$ENDIF}
    {$IFDEF IBX}
    bIBXDatabase: TIBDataBase;
    bReadIBXTransaction: TIBTransaction;
    bWriteIBXTransaction: TIBTransaction;
    {$ENDIF}
    Function GetConnected: Boolean;
  Public
    Property Kind: Integer Read bKind;
    Property Busy: Boolean Read bBusy;
    Property Connected: Boolean Read GetConnected;
    {$IFDEF UIB}
    Property UIBDatabase: TUIBDataBase Read bUIBDatabase;
    Procedure HoldUIBConnection(Out aDatabase: TUIBDataBase;
      Out aRead, aWrite: TUIBTransaction);
    Procedure FreeUIBConnection;
    {$ENDIF}
    {$IFDEF TDS}
    Property TDSDatabase: TTDSCTDataBase Read bTDSDatabase;
    Procedure HoldTDSConnection(Out aDatabase: TTDSCTDataBase;
      Out aRead, aWrite: TTDSCTTransaction);
    Procedure FreeTDSConnection;
    {$ENDIF}
    {$IFDEF IBX}
    Property IBXDatabase: TIBDataBase Read bIBXDatabase;
    Procedure HoldIBXConnection(Out aDatabase: TIBDataBase;
      Out aRead, aWrite: TIBTransaction);
    Procedure FreeIBXConnection;
    {$ENDIF}
    Constructor Build(Const aKind: Integer;
      Const aServer, aBase, aUser, aPassword, aLib: String);
    Destructor Burn;
End;

Type

{ BConnectionsPoolClass }

BConnectionsPoolClass = Class
  Strict Private
    bConnected: Boolean;
    bPool: TThreadList;
    bBase: String;
    bKind: Integer;
    bLib: String;
    bPassword: String;
    bServer: String;
    bUser: String;
    bPoolDepth: Integer;
    {$IFDEF UIB}
    bUIBDatabase: TUIBDataBase;
    bReadUIBTransaction: TUIBTransaction;
    bWriteUIBTransaction: TUIBTransaction;
    {$ENDIF}
    {$IFDEF TDS}
    bTDSDatabase: TTDSCTDataBase;
    bReadTDSTransaction: TTDSCTTransaction;
    bWriteTDSTransaction: TTDSCTTransaction;
    {$ENDIF}
    {$IFDEF IBX}
    bIBXDatabase: TIBDataBase;
    bReadIBXTransaction: TIBTransaction;
    bWriteIBXTransaction: TIBTransaction;
    {$ENDIF}
  Public
    Property Kind: Integer Read bKind;
    Property Server: String Read bServer;
    Property Base: String Read bBase;
    Property User: String Read bUser;
    Property Password: String Read bPassword;
    Property Lib: String Read bLib;
    Property Connected: Boolean Read bConnected;
    Property PoolDepth: Integer Read bPoolDepth;
    {$IFDEF UIB}
    Property ReadUIBTransaction: TUIBTransaction Read bReadUIBTransaction;
    Property WriteUIBTransaction: TUIBTransaction Read bWriteUIBTransaction;
    Property UIBDatabase: TUIBDataBase Read bUIBDatabase;
    Procedure HoldUIBConnection(Out aDatabase: TUIBDataBase;
      Out aRead, aWrite: TUIBTransaction);
    Procedure FreeUIBConnection(Const aDatabase: TUIBDataBase);
    {$ENDIF}
    {$IFDEF TDS}
    Property ReadTDSTransaction: TTDSCTTransaction Read bReadTDSTransaction;
    Property WriteTDSTransaction: TTDSCTTransaction Read bWriteTDSTransaction;
    Property TDSDatabase: TTDSCTDataBase Read bTDSDatabase;
    Procedure HoldTDSConnection(Out aDatabase: TTDSCTDataBase;
      Out aRead, aWrite: TTDSCTTransaction);
    Procedure FreeTDSConnection(Const aDatabase: TTDSCTDataBase);
    {$ENDIF}
    {$IFDEF IBX}
    Property ReadIBXTransaction: TIBTransaction Read bReadIBXTransaction;
    Property WriteIBXTransaction: TIBTransaction Read bWriteIBXTransaction;
    Property IBXDatabase: TIBDataBase Read bIBXDatabase;
    Procedure HoldIBXConnection(Out aDatabase: TIBDataBase;
      Out aRead, aWrite: TIBTransaction);
    Procedure FreeIBXConnection(Const aDatabase: TIBDataBase);
    {$ENDIF}
    Procedure Connect(Const aPoolDepth: Integer);
    Procedure Disconnect;
    Constructor Build(Const aKind: Integer;
      Const aServer, aBase, aUser, aPassword, aLib: String);
    Destructor Burn;
End;

{ BConnectionClass }

Function BConnectionClass.GetConnected: Boolean;
Begin
  Result := FALSE;
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}
      Result := Assigned(bUIBDatabase) And bUIBDatabase.Connected
      {$ENDIF}
      {$IFDEF IBX}
      Result := Assigned(bIBXDatabase) And bIBXDatabase.Connected
      {$ENDIF};
    DB_MS:
      {$IFDEF TDS}
      Result := Assigned(bTDSDatabase) And bTDSDatabase.Connected
      {$ENDIF};
  End;
End;

{$IFDEF IBX}
Procedure BConnectionClass.HoldIBXConnection(Out aDatabase: TIBDataBase; Out
  aRead, aWrite: TIBTransaction);
Begin
  aDatabase := bIBXDatabase;
  aRead := bReadIBXTransaction;
  aWrite := bWriteIBXTransaction;
  bBusy := TRUE;
End;

Procedure BConnectionClass.FreeIBXConnection;
Begin
  If bReadIBXTransaction.InTransaction Then bReadIBXTransaction.Commit;
  If bWriteIBXTransaction.InTransaction Then bWriteIBXTransaction.RollBack;
  bBusy := FALSE;
End;
{$ENDIF}

{$IFDEF UIB}
Procedure BConnectionClass.HoldUIBConnection(Out aDatabase: TUIBDataBase;
  Out aRead, aWrite: TUIBTransaction);
Begin
  aDatabase := bUIBDatabase;
  aRead := bReadUIBTransaction;
  aWrite := bWriteUIBTransaction;
  bBusy := TRUE;
End;

Procedure BConnectionClass.FreeUIBConnection;
Begin
  If bReadUIBTransaction.InTransaction Then bReadUIBTransaction.Commit;
  If bWriteUIBTransaction.InTransaction Then bWriteUIBTransaction.RollBack;
  bBusy := FALSE;
End;

{$ENDIF}

{$IFDEF TDS}
Procedure BConnectionClass.HoldTDSConnection(Out aDatabase: TTDSCTDataBase;
  Out aRead, aWrite: TTDSCTTransaction);
Begin
  aDatabase := bTDSDatabase;
  aRead := bReadTDSTransaction;
  aWrite := bWriteTDSTransaction;
  bBusy := TRUE;
End;

Procedure BConnectionClass.FreeTDSConnection;
Begin
  If bReadTDSTransaction.Active Then bReadTDSTransaction.Commit;
  If bWriteTDSTransaction.Active Then bWriteTDSTransaction.Rollback;
  bBusy := FALSE;
End;

{$ENDIF}

Constructor BConnectionClass.Build(Const aKind: Integer; Const aServer, aBase,
  aUser, aPassword, aLib: String);
Begin
  bKind := aKind;
  Case Kind Of
    DB_FB:
      Begin
        {$IFDEF UIB}
        bUIBDatabase := TUIBDataBase.Create(nil);
        bUIBDatabase.DatabaseName := Format('%s:%s', [aServer, aBase]);
        bUIBDatabase.UserName := aUser;
        bUIBDatabase.PassWord := aPassword;
        bUIBDatabase.CharacterSet := csUTF8;
        If Not(aLib = '') Then bUIBDatabase.LibraryName := aLib;

        bReadUIBTransaction := TUIBTransaction.Create(nil);
        bReadUIBTransaction.DataBase := bUIBDatabase;
        bReadUIBTransaction.Options :=
          [tpRead, tpReadCommitted, tpNowait, tpRecVersion];

        bWriteUIBTransaction := TUIBTransaction.Create(nil);
        bWriteUIBTransaction.DataBase := bUIBDatabase;
        bWriteUIBTransaction.Options := [tpWrite, tpNowait];
        Try
          bUIBDatabase.Connected := TRUE;
        Except On E: Exception Do
          //Add Here some log or exception
          //SafeLog(E.Message);
        End;
        {$ENDIF};
        {$IFDEF IBX}
        bIBXDatabase := TIBDataBase.Create(nil);
        bIBXDatabase.DatabaseName := Format('%s:%s', [aServer, aBase]);
        bIBXDatabase.Params.Add(Format('user_name=%s', [aUser]));
        bIBXDatabase.Params.Add(Format('password=%s', [aPassword]));
        bIBXDatabase.Params.Add('lc_ctype=UTF-8');
        bIBXDatabase.LoginPrompt := FALSE;

        bReadIBXTransaction := TIBTransaction.Create(nil);
        bReadIBXTransaction.DefaultDatabase := bIBXDatabase;
        bReadIBXTransaction.DefaultAction := TACommit;
        bReadIBXTransaction.Params.Add('read_committed');
        bReadIBXTransaction.Params.Add('rec_version');
        bReadIBXTransaction.Params.Add('nowait');

        bWriteIBXTransaction := TIBTransaction.Create(nil);
        bWriteIBXTransaction.DefaultDatabase := bIBXDatabase;
        bWriteIBXTransaction.DefaultAction := TARollback;
        bWriteIBXTransaction.Params.Add('write');
        bWriteIBXTransaction.Params.Add('consistency');

        Try
          bIBXDatabase.Connected := TRUE;
        Except On E: Exception Do
          SafeLog(E.Message);
        End;
        {$ENDIF}
      End;
    DB_MS:
      Begin
        {$IFDEF TDS}
        bTDSDatabase := TTDSCTDataBase.Create(nil);
        bTDSDatabase.ServerVersion := svMSSQL2008;
        bTDSDatabase.ServerName := aServer;
        bTDSDatabase.Database := aBase;
        bTDSDatabase.UserName := aUser;
        bTDSDatabase.Password := aPassword;
        bTDSDatabase.LibraryName := aLib;

        bReadTDSTransaction := TTDSCTTransaction.Create(nil);
        bReadTDSTransaction.DataBase := bTDSDatabase;

        bWriteTDSTransaction := TTDSCTTransaction.Create(nil);
        bWriteTDSTransaction.DataBase := bTDSDatabase;

        Try
          bTDSDatabase.Connected := TRUE;
        Except On E: Exception Do
          SafeLog(E.Message);
        End;
        {$ENDIF};
      End;
  End;
End;

Destructor BConnectionClass.Burn;
Begin
  Case bKind Of
    DB_FB:
      Begin
        {$IFDEF UIB}
        If bReadUIBTransaction.InTransaction Then bReadUIBTransaction.Commit;
        If bWriteUIBTransaction.InTransaction Then
          bWriteUIBTransaction.Rollback;
        bReadUIBTransaction.Free;
        bWriteUIBTransaction.Free;
        bUIBDatabase.Free;
        {$ENDIF};
        {$IFDEF IBX}
        If bReadIBXTransaction.InTransaction Then bReadIBXTransaction.Commit;
        If bWriteIBXTransaction.InTransaction THen
          bWriteIBXTransaction.Rollback;
        bReadIBXTransaction.Free;
        bWriteIBXTransaction.Free;
        bIBXDatabase.Free;
        {$ENDIF}
      End;
    DB_MS:
      Begin
        {$IFDEF TDS}
        If bReadTDSTransaction.Active Then bReadTDSTransaction.Commit;
        If bWriteTDSTransaction.Active Then bWriteTDSTransaction.Rollback;
        bReadTDSTransaction.Free;
        bWriteTDSTransaction.Free;
        bTDSDatabase.Free;
        {$ENDIF};
      End;
  End;
End;

{ BConnectionPoolClass }

{$IFDEF UIB}
Procedure BConnectionsPoolClass.HoldUIBConnection(Out aDatabase: TUIBDataBase;
  Out aRead, aWrite: TUIBTransaction);
Var
  i, aStep: Integer;
  aWasFound: Boolean;
  aConnection: BConnectionClass;
Begin
  aStep := 0;
  aWasFound := FALSE;
  With bPool.LockList Do
    Repeat
      For i := 0 To Count - 1 Do
        Begin
          aConnection := BConnectionClass(Items[i]);
          If Not(aConnection.Busy) Then
            Begin
              aConnection.HoldUIBConnection(aDatabase, aRead, aWrite);
              aWasFound := TRUE;
              Break;
            End;
          Inc(aStep);
          Sleep(20);
        End;
    Until aWasFound Or (aStep < STEP_MAX);
  bPool.UnlockList;
End;

Procedure BConnectionsPoolClass.FreeUIBConnection(
  Const aDatabase: TUIBDataBase);
Var
  i: Integer;
Begin
  With bPool.LockList Do
    For i := 0 To Count - 1 Do
      If BConnectionClass(Items[i]).UIBDatabase = aDatabase Then
        Begin
          BConnectionClass(Items[i]).FreeUIBConnection;
          Break;
        End;
  bPool.UnlockList;
End;
{$ENDIF}

{$IFDEF TDS}
Procedure BConnectionsPoolClass.HoldTDSConnection(Out aDatabase: TTDSCTDataBase;
  Out aRead, aWrite: TTDSCTTransaction);
Var
  i, aStep: Integer;
  aWasFound: Boolean;
  aConnection: BConnectionClass;
Begin
  aWasFound := FALSE;
  aStep := 0;
  With bPool.LockList Do
    Repeat
      For i := 0 To Count - 1 Do
        Begin
          aConnection := BConnectionClass(Items[i]);
          If Not(aConnection.Busy) Then
            Begin
              aConnection.HoldTDSConnection(aDatabase, aRead, aWrite);
              aWasFound := TRUE;
              Break;
            End;
          Inc(aStep);
          Sleep(20);
        End;
    Until aWasFound Or (aStep < STEP_MAX);
  bPool.UnlockList;
End;

Procedure BConnectionsPoolClass.FreeTDSConnection(
  Const aDatabase: TTDSCTDataBase);
Var
  i: Integer;
Begin
  With bPool.LockList Do
    For i := 0 To Count - 1 Do
      If BConnectionClass(Items[i]).TDSDatabase = aDatabase Then
        Begin
          BConnectionClass(Items[i]).FreeTDSConnection;
          Break;
        End;
  bPool.UnlockList;
End;
{$ENDIF}

{$IFDEF IBX}
Procedure BConnectionsPoolClass.HoldIBXConnection(Out aDatabase: TIBDataBase;
  Out aRead, aWrite: TIBTransaction);
Var
  i, aStep: Integer;
  aWasFound: Boolean;
  aConnection: BConnectionClass;
Begin
  aWasFound := FALSE;
  aStep := 0;
  With bPool.LockList Do
    Repeat
      For i := 0 To Count - 1 Do
        Begin
          aConnection := BConnectionClass(Items[i]);
          If Not(aConnection.Busy) Then
            Begin
              aConnection.HoldIBXConnection(aDatabase, aRead, aWrite);
              aWasFound := TRUE;
              Break;
            End;
          Inc(aStep);
          Sleep(20);
        End;
    Until aWasFound Or (aStep < STEP_MAX);
  bPool.UnlockList;
End;

Procedure BConnectionsPoolClass.FreeIBXConnection(
  Const aDatabase: TIBDataBase);
Var
  i: Integer;
Begin
  With bPool.LockList Do
    For i := 0 To Count - 1 Do
      If BConnectionClass(Items[i]).IBXDatabase = aDatabase Then
        Begin
          BConnectionClass(Items[i]).FreeIBXConnection;
          Break;
        End;
  bPool.UnlockList;
End;
{$ENDIF}

Procedure BConnectionsPoolClass.Connect(Const aPoolDepth: Integer);
Var
  i: Integer;
  aConnection: BConnectionClass;
Begin
  If Connected Then
    Begin
      Raise Exception.Create('Already Connected');
      Exit;
    End;
  If Not(PoolDepth = 0) Then
    ;//Add Here some log or exception
    //SafeLog('Pool not empty on connect');
  bPoolDepth := 0;
  For i := 1 To aPoolDepth Do
    Begin
      aConnection := BConnectionClass.Build(Kind,Server,Base,User,Password,Lib);
      If aConnection.Connected Then
        Begin
          bPool.Add(aConnection);
          Inc(bPoolDepth);
        End;
    End;
  If Not(aPoolDepth=PoolDepth) Then
    ;//Add Here some log or exception
    //SafeLog('Not all connections established');
  bConnected := TRUE;
End;

Procedure BConnectionsPoolClass.Disconnect;
Var
  i: Integer;
Begin
  With bPool.LockList Do
    Begin
      For i := 0 To Count - 1 Do
        BConnectionClass(Items[i]).Burn;
      bPoolDepth := 0;
      bConnected := FALSE;
      Clear;
    End;
  bPool.UnlockList
End;

Constructor BConnectionsPoolClass.Build(Const aKind: Integer; Const aServer, aBase,
  aUser, aPassword, aLib: String);
Begin
  bKind := aKind;
  bServer := aServer;
  bBase := aBase;
  bUser := aUser;
  bPassword := aPassword;
  bLib := aLib;
  bPool := TThreadList.Create;
End;

Destructor BConnectionsPoolClass.Burn;
Var
  i: Integer;
Begin
  With bPool.LockList Do
    For i := 0 To Count - 1 Do
      BConnectionClass(Items[i]).Burn;
  bPool.UnlockList;
  bPool.Free;
End;

{  BQueryClass  }

Constructor BQueryClass.Build(Const aID: Integer);
Begin
  {$IFDEF UIB}
    bUIBQuery := TUIBQuery.Create(nil);
  {$ENDIF}
  {$IFDEF TDS}
    bTDSQuery := TTDSCTQuery.Create(nil);
  {$ENDIF}
  {$IFDEF IBX}
    bIBXQuery := TIBSQL.Create(nil);
  {$ENDIF}
  bID := aID;
  bKind := DBManager.GetKind(aID);
  Case bKind Of
    DB_FB:
      Begin
      {$IFDEF UIB}
        DBManager.HoldUIBConnection(aID, bUIBDatabase, bUIBRead,
          bUIBWrite);
        bUIBQuery.DataBase := bUIBDatabase;
      {$ENDIF}
      {$IFDEF IBX}
        DBManager.HoldIBXConnection(aID, bIBXDatabase, bIBXRead, bIBXWrite);
        bIBXQuery.Database := bIBXDatabase;
      {$ENDIF}
      End;

    DB_MS:
      Begin
      {$IFDEF TDS}
        DBManager.HoldTDSConnection(aID, bTDSDatabase, bTDSRead,
          bTDSWrite);
        bTDSQuery.DataBase := bTDSDatabase;
      {$ENDIF}
      End;
  End;
End;

Destructor BQueryClass.Burn;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}
      DBManager.FreeUIBConnection(bID, bUIBQuery.DataBase)
      {$ENDIF}
      {$IFDEF IBX}
      DBManager.FreeIBXConnection(bID, bIBXQuery.Database)
      {$ENDIF};
    DB_MS:
      Begin
        {$IFDEF TDS}
        DBManager.FreeTDSConnection(bID, bTDSQuery.DataBase);
        bTDSQuery.Free;
        {$ENDIF}
      End;
  End;
End;

{$IFDEF UIB}
Function BQueryClass.GetUIB(Const aSQL: BSQLClass): Boolean;
Var
  i: Integer;
Begin
  Result := FALSE;
  With bUIBQuery Do
    Begin
      Transaction := bUIBRead;
      If Not(Transaction.InTransaction) Then Transaction.StartTransaction;
      Params.Clear;
      SQL.Clear;
      SQL.Add(aSQL.SQL);
      For i := 0 To aSQL.Params.Count - 1 Do
        Params.ByNameAsString[BSQLParamClass(aSQL.Params[i]).Iterator] :=
          BSQLParamClass(aSQL.Params[i]).Value;
      Try
        If aSQL.IsProcedure Then Execute
        Else Open;
      Except On E: Exception Do
        Begin
          ;//Add Here some log or exception
          //Log(SQL.Text);
          //Log(E.Message);
        End;
      End;
    End;
  Result := TRUE;
End;

Function BQueryClass.PostUIB(Const aSQL: BSQLClass): Boolean;
Var
  i: Integer;
  aParam: BSQLParamClass;
Begin
  Result := FALSE;
  With bUIBQuery Do
    Begin
      Transaction := bUIBWrite;
      If Not(Transaction.InTransaction) Then Transaction.StartTransaction;
      Try
        Params.Clear;
        SQL.Text := aSQL.SQL;
        For i := 0 To aSQL.Params.Count - 1 Do
          Begin
            aParam := BSQLParamClass(aSQL.Params[i]);
            If aParam.Stream = nil Then
              Params.ByNameAsString[aParam.Iterator] :=  aParam.Value
            Else
              ParamsSetBlob(aParam.Iterator, aParam.Stream);
          End;
        If aSQL.IsProcedure Then Execute
        Else ExecSQL;
      Except On E: Exception Do
        Begin
          ;//Add Here some log or exception
          //Log(SQL.Text);
          //Log(E.Message);
          Transaction.Rollback;
          Exit;
        End;
      End;
    End;
  Result := TRUE;
End;
{$ENDIF}

{$IFDEF TDS}
Function BQueryClass.GetTDS(Const aSQL: BSQLClass): Boolean;
Var
  i: Integer;
Begin
  Result := FALSE;
  With bTDSQuery Do
    Begin
      Transaction := bTDSRead;
      Params.Clear;
      SQL.Text := aSQL.SQL;
      For i := 0 To aSQL.Params.Count - 1 Do
        Params.ParamByName(BSQLParamClass(aSQL.Params[i]).Iterator).AsString :=
          BSQLParamClass(aSQL.Params[i]).Value;
      Try
        If aSQL.IsProcedure Then ExecSQL
        Else Open;
      Except On E: Exception Do
        Begin
          DirectLog(SQL.Text);
          Log(E.Message);
        End;
      End;
    End;
  Result := TRUE;
End;

Function BQueryClass.PostTDS(Const aSQL: BSQLClass): Boolean;
Var
  i: Integer;
  aParam: BSQLParamClass;
Begin
  Result := FALSE;
  With bTDSQuery Do
    Begin
      Transaction := bTDSWrite;
      If Not(Transaction.Active) Then Transaction.StartTransaction;
      Try
        Params.Clear;
        SQL.Text := aSQL.SQL;
        For i := 0 To aSQL.Params.Count - 1 Do
          Begin
            aParam := BSQLParamClass(aSQL.Params[i]);
            // TODO: no blob support
            If aParam.Stream = nil Then
              ParamByName(aParam.Iterator).Value :=  aParam.Value;
          End;
        ExecSQL;
      Except On E: Exception Do
        Begin
          Log(SQL.Text);
          Log(E.Message);
          Transaction.Rollback;
          Exit;
        End;
      End;
    End;
  Result := TRUE;
End;
{$ENDIF}

{$IFDEF IBX}
Function BQueryClass.GetIBX(Const aSQL: BSQLClass): Boolean;
Var
  i: Integer;
Begin
  Result := FALSE;
  With bIBXQuery Do
    Begin
      If Open Then Close;
      Database := bIBXDatabase;
      Transaction := bIBXRead;
      If Not(Transaction.InTransaction) Then Transaction.StartTransaction;
      SQL.Text := aSQL.SQL;
      For i := 0 To aSQL.Params.Count - 1 Do
        Params.ByName(BSQLParamClass(aSQL.Params[i]).Iterator).AsString :=
          BSQLParamClass(aSQL.Params[i]).Value;
      Try
        ExecQuery;
      Except On E: Exception Do
        Begin
          SafeLog(SQL.Text);
          SafeLog(E.Message);
        End;
      End;
    End;
  Result := TRUE;
End;

Function BQueryClass.PostIBX(Const aSQL: BSQLClass): Boolean;
Var
  i: Integer;
  aParam: BSQLParamClass;
Begin
  Result := FALSE;
  With bIBXQuery Do
    Begin
      Transaction := bIBXWrite;
      If Not(Transaction.InTransaction) Then Transaction.StartTransaction;
      Try
        SQL.Text := aSQL.SQL;
        For i := 0 To aSQL.Params.Count - 1 Do
          Begin
            aParam := BSQLParamClass(aSQL.Params[i]);
            // TODO: no blob support
            If aParam.Stream = nil Then
              ParamByName(aParam.Iterator).Value :=  aParam.Value;
          End;
        ExecQuery;
      Except On E: Exception Do
        Begin
          SafeLog(SQL.Text);
          SafeLog(E.Message);
          Transaction.Rollback;
          Exit;
        End;
      End;
    End;
  Result := TRUE;
End;
{$ENDIF}

Function BQueryClass.ByString(Const aString: String): String;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := bUIBQuery.Fields.ByNameAsString[aString]{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.FieldByName(aString).AsString{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.ByNameAsString[aString]{$ENDIF};
  End;
End;

Function BQueryClass.ByDouble(Const aString: String): Double;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := bUIBQuery.Fields.ByNameAsDouble[aString]{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.FieldByName(aString).AsFloat{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.ByNameAsFloat[aString]{$ENDIF};
  End;
End;

Function BQueryClass.ByInteger(Const aString: String): Integer;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := bUIBQuery.Fields.ByNameAsInteger[aString]{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.FieldByName(aString).AsInteger{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.ByNameAsInteger[aString]{$ENDIF};
  End;
End;

Function BQueryClass.ByInt64(Const aString: String): Int64;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := bUIBQuery.Fields.ByNameAsInt64[aString]{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.FieldByName(aString).AsInt64{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.ByNameAsInt64[aString]{$ENDIF};
  End;
End;

Function BQueryClass.ByBoolean(Const aString: String): Boolean;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result:=bUIBQuery.Fields.ByNameAsBoolean[aString]{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.FieldByName(aString).AsInteger=1{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.ByNameAsInteger[aString] = 1{$ENDIF};
  End;
End;

Function BQueryClass.ByDate(Const aString: String): TDateTime;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := bUIBQuery.Fields.ByNameAsDate[aString]{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.FieldByName(aString).AsDateTime{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.ByNameAsDate[aString]{$ENDIF};
  End;
End;

Function BQueryClass.ByDateTime(Const aString: String): TDateTime;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := bUIBQuery.Fields.ByNameAsDateTime[aString]{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.FieldByName(aString).AsDateTime{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.ByNameAsDateTime[aString]{$ENDIF};
  End;
End;

Function BQueryClass.Get(Const aSQL: BSQLClass): Boolean;
Begin
  Result := FALSE;
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := GetUIB(aSQL){$ENDIF}
      {$IFDEF IBX}Result := GetIBX(aSQL){$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := GetTDS(aSQL){$ENDIF};

  End;
End;

Function BQueryClass.Get(Const aString: String;
  Const ForExecute: Boolean = FALSE): Boolean;
Var
  aSQL: BSQLClass;
Begin
  aSQL := BSQLClass.Build(aString, ForExecute);
  Result := Get(aSQL);
  aSQL.Burn;
End;

Function BQueryClass.Post(Const aSQL: BSQLClass): Boolean;
Begin
  Result := FALSE;
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := PostUIB(aSQL){$ENDIF}
      {$IFDEF IBX}Result := PostIBX(aSQL){$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := PostTDS(aSQL){$ENDIF};
  End;
End;

Function BQueryClass.Post(Const aString: String;
  Const ForExecute: Boolean): Boolean;
Var
  aSQL: BSQLClass;
Begin
  aSQL := BSQLClass.Build(aString, ForExecute);
  Result := Post(aSQL);
  aSQL.Burn;
End;

Function BQueryClass.EOF: Boolean;
Begin
  Result := TRUE;
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := bUIBQuery.Eof{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.EOF{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.Eof{$ENDIF};
  End;
End;

Procedure BQueryClass.Go;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}
        With bUIBQuery Do
          Begin
            Transaction := bUIBWrite;
            If Transaction.InTransaction Then Transaction.Commit;
          End{$ENDIF}
      {$IFDEF IBX}
        With bIBXQuery Do
          Begin
            Transaction := bIBXWrite;
            If Transaction.InTransaction Then Transaction.Commit;
          End{$ENDIF};
    DB_MS:
      {$IFDEF TDS}
        With bTDSQuery Do
          Begin
            Transaction := bTDSWrite;
            If Transaction.Active Then Transaction.Commit;
          End{$ENDIF};

  End;
End;

Procedure BQueryClass.Next;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}bUIBQuery.Next{$ENDIF}
      {$IFDEF IBX}bIBXQuery.Next{$ENDIF};
    DB_MS:
      {$IFDEF TDS}bTDSQuery.Next{$ENDIF};
  End;
End;

Procedure BQueryClass.First;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}bUIBQuery.First{$ENDIF}
      {$IFDEF IBX}Raise Exception.Create('Not implemented'){$ENDIF};
    DB_MS:
      {$IFDEF TDS}Raise Exception.Create('Not implemented'){$ENDIF};
  End;
End;

{ BDBManagerClass }

Constructor BDBManagerClass.Build;
Begin
  bPools := TThreadList.Create;
End;

Destructor BDBManagerClass.Burn;
Var
  i: Integer;
Begin
  With bPools.LockList Do
    For i := 0 To Count - 1 Do
      BConnectionsPoolClass(Items[i]).Burn;
  bPools.UnlockList;
  bPools.Free;
End;

Procedure BDBManagerClass.AddDatabase(Const aKind: Integer;
  Const aServer, aBase, aUser, aPassword: String; Const aLib: String);
Begin
  bPools.Add(
    BConnectionsPoolClass.Build(aKind, aServer, aBase, aUser, aPassword, aLib));
End;

Procedure BDBManagerClass.RemoveDatabase(Const aIndex: Integer);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  With bPools.LockList Do
    Begin
      aConnectionPool := BConnectionsPoolClass(Items[aIndex]);
      aConnectionPool.Burn;
      Delete(aIndex);
    End;
  bPools.UnlockList;
End;

Function BDBManagerClass.GetKind(Const aIndex: Integer): Integer;
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  Result := aConnectionPool.Kind;
End;

Procedure BDBManagerClass.Connect(Const aIndex: Integer;
  Const aPoolSize: Integer);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.Connect(aPoolSize);
End;

{$IFDEF IBX}
Procedure BDBManagerClass.HoldIBXConnection(Const aIndex: Integer;
  Out aDatabase: TIBDataBase; Out aRead, aWrite: TIBTransaction);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.HoldIBXConnection(aDatabase, aRead, aWrite);
End;

Procedure BDBManagerClass.FreeIBXConnection(Const aIndex: Integer;
  Const aDatabase: TIBDataBase);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.FreeIBXConnection(aDatabase);
End;
{$ENDIF}

{$IFDEF UIB}
Procedure BDBManagerClass.HoldUIBConnection(Const aIndex: Integer;
  Out aDatabase: TUIBDataBase; Out aRead, aWrite: TUIBTransaction);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.HoldUIBConnection(aDatabase, aRead, aWrite);
End;

Procedure BDBManagerClass.FreeUIBConnection(Const aIndex: Integer;
  Const aDatabase: TUIBDataBase);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.FreeUIBConnection(aDatabase);
End;

{$ENDIF}

{$IFDEF TDS}
Procedure BDBManagerClass.HoldTDSConnection(Const aIndex: Integer;
  Out aDatabase: TTDSCTDataBase; Out aRead, aWrite: TTDSCTTransaction);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.HoldTDSConnection(aDatabase, aRead, aWrite);
End;

Procedure BDBManagerClass.FreeTDSConnection(Const aIndex: Integer;
  Const aDatabase: TTDSCTDataBase);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.FreeTDSConnection(aDatabase);
End;
{$ENDIF}

Procedure BDBManagerClass.Disconnect(Const aIndex: Integer);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.Disconnect;
End;

Initialization
Begin
  DBManager := BDBManagerClass.Build;
End;

Finalization
Begin
  DBManager.Burn;
End;

End.

Код: Выделить всё
Unit BSQLUnit;

{$mode objfpc}{$H+}

Interface

Uses
  Classes, SysUtils;

Type

{ BSQLParamClass }

BSQLParamClass = Class
  Private
    bIterator: String;
    bStream: TMemoryStream;
    bValue: String;
    bWithStream: Boolean;
  Public
    Property WithStream: Boolean Read bWithStream;
    Property Value: String Read bValue;
    Property Iterator: String Read bIterator;
    Property Stream: TMemoryStream Read bStream;
    Constructor Build(Const aIterator, aValue: String);
    Constructor Build(Const aIterator: String; Const aStream: TMemoryStream);
    Destructor Burn;
End;

Type

{ BSQLClass }

BSQLClass = Class
  Private
    bIsProcedure: Boolean;
    bParams: TList;
    bSQL: String;
    Procedure ClearParam(Const aIterator: String);
  Public
    Property SQL: String Read bSQL;
    Property Params: TList Read bParams;
    Property IsProcedure: Boolean Read bIsProcedure;
    Procedure AddParam(Const aIterator, aValue: String);
    Procedure AddParam(Const aIterator: String; Const aValue: Boolean);
    Procedure AddParam(Const aIterator: String; Const aValue: Integer);
    Procedure AddParam(Const aIterator: String; Const aValue: TDateTime;
      Const aFormat: String = 'dd.mm.yy');
    Procedure AddParam(Const aIterator: String; Const aStream: TMemoryStream);
    Constructor Build(Const aString: String; Const ForProcedure: Boolean = FALSE);
    Destructor Burn;
End;

Implementation

{ BSQLParamClass }

constructor BSQLParamClass.Build(const aIterator, aValue: String);
begin
  Inherited Create;
  bIterator := aIterator;
  bValue := aValue;
  bStream := nil;
end;

Constructor BSQLParamClass.Build(Const aIterator: String;
  Const aStream: TMemoryStream);
Begin
  Inherited Create;
  bIterator := aIterator;
  bStream := TMemoryStream.Create;
  Stream.LoadFromStream(aStream);
End;

Destructor BSQLParamClass.Burn;
Begin
  If Not(Stream = nil) Then
    Begin
      Stream.Clear;
      Stream.Free;
    End;
  Inherited Destroy;
End;

{ BSQLClass }

Procedure BSQLClass.AddParam(Const aIterator: String; Const aValue: Integer);
Begin
  ClearParam(aIterator);
  Params.Add(BSQLParamClass.Build(aIterator, IntToStr(aValue)));
End;

Procedure BSQLClass.AddParam(Const aIterator: String; Const aValue: TDateTime;
  Const aFormat: String);
Begin
  ClearParam(aIterator);
  Params.Add(BSQLParamClass.Build(aIterator, FormatDateTime(aFormat, aValue)));
End;

Procedure BSQLClass.AddParam(Const aIterator: String;
  Const aStream: TMemoryStream);
Begin
  ClearParam(aIterator);
  Params.Add(BSQLParamClass.Build(aIterator, aStream));
End;

Procedure BSQLClass.ClearParam(Const aIterator: String);
Var
  i: Integer;
Begin
  For i := 0 To Params.Count - 1 Do
    If BSQLParamClass(Params[i]).Iterator = aIterator Then
      Begin
        BSQLParamClass(Params[i]).Burn;
        Params.Delete(i);
        Exit;
      End;
End;

procedure BSQLClass.AddParam(const aIterator, aValue: String);
begin
  ClearParam(aIterator);
  Params.Add(BSQLParamClass.Build(aIterator, aValue));
end;

Procedure BSQLClass.AddParam(Const aIterator: String; Const aValue: Boolean);
Begin
  ClearParam(aIterator);
  Params.Add(BSQLParamClass.Build(aIterator, IntToStr(Integer(aValue))));
End;

Constructor BSQLClass.Build(Const aString: String; Const ForProcedure: Boolean);
Begin
  Inherited Create;
  bParams := TList.Create;
  bSQL := aString;
  bIsProcedure := ForProcedure;
End;

Destructor BSQLClass.Burn;
Var
  i: Integer;
Begin
  For i := 0 To Params.Count - 1 Do
    BSQLParamClass(Params[i]).Burn;
  Params.Free;
End;

End.

Вот ^_^ Уже выкладывал где-то на форуме. ВQueryClassUnit глобальная переменная DBManager. Когда будет известны все параметры для подключения к базе вызвывается что-то вроде
Код: Выделить всё
aConnectionIndex := DBManager.AddDatabase(FB_DB, 'server', 'DBAliasOrFile', 'SYSDBA', 'masterkey');
DBManager.Connect(aConnectionIndex, 2);

Вот, потом можно вызывать
Код: Выделить всё
Procedure Test;
Var
  aQuery: BQueryClass;
Begin
  aQuery := BQueryClass.Build(aConnectionIndex);
  aQuery.Get('SELECT * FROM MYTABLE');
  While Not(aQuery.EOF) Do
    Begin
      WriteLn(aQuery.ByString('MYFIELD'));
      aQuery.Next;
    End;
  aQuery.Burn;
End;

Procedure Test2;
Var
  aSQL: BSQLClass;
Begin
  // Второй параметр - магия ^_^ Нужен для UIB и Execute Statement или RETURNING
  aSQL := BSQLClass.Build('INSERT INTO MYTABLE(MYFIELD, MYDATE, MYINT) ' +
    'VALUES(:MYFIELD, :MYDATE, :MYINT) RETURNING MYFIELD', TRUE);
  aSQL.AddParam('MYFIELD', 'Hello world');
  aSQL.AddParam('MYDATE', Now);
  aSQL.AddParam('MYINT', 144);
  With BQueryClass.Build Do // Опускаем индекс если работа только с 1 базой
    Begin
      Post(aSQL);
      aSQL.AddParam('MYINT', 145); // Меняем значение параметра MYINT
      Post(aSQL);                  // остальные остаются без изменений
      Go;                          // Commit
      Burn;
    End;
End;
Аватара пользователя
Brainenjii
энтузиаст
 
Сообщения: 1351
Зарегистрирован: 10.05.2007 00:04:46
Вернуться к началу

Re: Аналог TSQLiteWrapper для FireBird

Сообщение Nik » 02.06.2011 20:14:18

2Brainenjii

Код: Выделить всё
aConnectionIndex := DBManager.AddDatabase(FB_DB, 'server', 'DBAliasOrFile', 'SYSDBA', 'masterkey');


aConnectionIndex и FB_DB - это что такое, если не секрет?

AddDatabase - это процедура, результата, соответственно не возвращает. Что присваивается aConnectionIndex - компилятор вообще не понял :) :(
Аватара пользователя
Nik
энтузиаст
 
Сообщения: 573
Зарегистрирован: 04.02.2006 00:08:09
Откуда: Киров
Вернуться к началу

Re: Аналог TSQLiteWrapper для FireBird

Сообщение Brainenjii » 02.06.2011 21:33:38

:-D Упс ^_^ Wrapper пользую довольно давно, код "применения" писал по памяти и, разумеется, не проверял. Видимо, "прикручивая" поддержку IBX я решил отказаться от функций, которых все-равно не использую...
Прошу прощения. Изображение
Вот исправленный и точно уж рабочий пример ^_^ И возвёрнутые ConnectionIndex'ы. DB_FB - это константа, указывающая, к какому серверу осуществляется соединение... В планах когда-нибудь добавить SQLite и PostgreSQL ^_^'
Код: Выделить всё
Unit BQueryUnit;

{$mode objfpc}{$H+}

Interface

Uses
  {$IFDEF TDS}
    TDSCTDataBase,
  {$ENDIF}
  {$IFDEF UIB}
    uib, uiblib,
  {$ENDIF}
  {$IFDEF IBX}
    IBDatabase, IBSQL,
  {$ENDIF}
  Classes, SysUtils, BSQLUnit;

Const
  STEP_MAX = 3;

  DB_FB = 1;
  DB_MS = 2;

Type

{ BQueryClass }

BQueryClass = Class
  Private
    bID, bKind: Integer;
    {$IFDEF UIB}
    bUIBQuery: TUIBQuery;
    bUIBDatabase: TUIBDataBase;
    bUIBWrite, bUIBRead: TUIBTransaction;
    {$ENDIF}
    {$IFDEF TDS}
    bTDSQuery: TTDSCTQuery;
    bTDSDatabase: TTDSCTDataBase;
    bTDSWrite, bTDSRead: TTDSCTTransaction;
    {$ENDIF}
    {$IFDEF IBX}
    bIBXQuery: TIBSQL;
    bIBXDatabase: TIBDataBase;
    bIBXWrite, bIBXRead: TIBTransaction;
    {$ENDIF}
    {$IFDEF UIB}
    Function GetUIB(Const aSQL: BSQLClass): Boolean;
    Function PostUIB(Const aSQL: BSQLClass): Boolean;
    {$ENDIF}
    {$IFDEF TDS}
    Function GetTDS(Const aSQL: BSQLClass): Boolean;
    Function PostTDS(Const aSQL: BSQLClass): Boolean;
    {$ENDIF}
    {$IFDEF IBX}
    Function GetIBX(Const aSQL: BSQLClass): Boolean;
    Function PostIBX(Const aSQL: BSQLClass): Boolean;
    {$ENDIF}
  Public
    Function ByString(Const aString: String): String;
    Function ByDouble(Const aString: String): Double;
    Function ByInteger(Const aString: String): Integer;
    Function ByInt64(Const aString: String): Int64;
    Function ByBoolean(Const aString: String): Boolean;
    Function ByDate(Const aString: String): TDateTime;
    Function ByDateTime(Const aString: String): TDateTime;
    Function Get(Const aSQL: BSQLClass): Boolean;
    Function Get(Const aString: String;
      Const ForExecute: Boolean = FALSE): Boolean;
    Function Post(Const aSQL: BSQLClass): Boolean;
    Function Post(Const aString: String;
      Const ForExecute: Boolean = FALSE): Boolean;
    Function Post(Const aMask: String; Const aParams: Array Of Const): Boolean;
    Function EOF: Boolean;
    Procedure Go;
    Procedure Next;
    Procedure First;
    Constructor Build(Const aID: Integer = 0);
    Destructor Burn;
End;

Type

{ BDBManagerClass }

BDBManagerClass = Class
  Strict Private
    bPools: TThreadList;
  Public
    Function AddDatabase(Const aKind: Integer; Const aServer, aBase, aUser,
      aPassword: String; Const aLib:String=''): Integer;
    Procedure RemoveDatabase(Const aIndex: Integer);
    Function GetKind(Const aIndex: Integer): Integer;
    Procedure Connect(Const aIndex: Integer = 0; Const aPoolSize: Integer = 1);
    {$IFDEF UIB}
    Procedure HoldUIBConnection(Const aIndex: Integer;
      Out aDatabase: TUIBDataBase; Out aRead, aWrite: TUIBTransaction);
    Procedure FreeUIBConnection(Const aIndex: Integer;
      Const aDatabase: TUIBDataBase);
    {$ENDIF}
    {$IFDEF TDS}
    Procedure HoldTDSConnection(Const aIndex: Integer;
      Out aDatabase: TTDSCTDataBase; Out aRead, aWrite: TTDSCTTransaction);
    Procedure FreeTDSConnection(Const aIndex: Integer;
      Const aDatabase: TTDSCTDataBase);
    {$ENDIF}
    {$IFDEF IBX}
    Procedure HoldIBXConnection(Const aIndex: Integer;
      Out aDatabase: TIBDataBase; Out aRead, aWrite: TIBTransaction);
    Procedure FreeIBXConnection(Const aIndex: Integer;
      Const aDatabase: TIBDataBase);
    {$ENDIF}
    Procedure Disconnect(Const aIndex: Integer = 0);
    Constructor Build;
    Destructor Burn;
End;

Var
  DBManager: BDBManagerClass;

Implementation

Const
  STR_MSSQL = '/usr/lib/libct.so';

Type

{ BConnectionClass }

BConnectionClass = Class
  Strict Private
    bBusy: Boolean;
    bKind: Integer;
    {$IFDEF UIB}
    bUIBDatabase: TUIBDataBase;
    bReadUIBTransaction: TUIBTransaction;
    bWriteUIBTransaction: TUIBTransaction;
    {$ENDIF}
    {$IFDEF TDS}
    bTDSDatabase: TTDSCTDataBase;
    bReadTDSTransaction: TTDSCTTransaction;
    bWriteTDSTransaction: TTDSCTTransaction;
    {$ENDIF}
    {$IFDEF IBX}
    bIBXDatabase: TIBDataBase;
    bReadIBXTransaction: TIBTransaction;
    bWriteIBXTransaction: TIBTransaction;
    {$ENDIF}
    Function GetConnected: Boolean;
  Public
    Property Kind: Integer Read bKind;
    Property Busy: Boolean Read bBusy;
    Property Connected: Boolean Read GetConnected;
    {$IFDEF UIB}
    Property UIBDatabase: TUIBDataBase Read bUIBDatabase;
    Procedure HoldUIBConnection(Out aDatabase: TUIBDataBase;
      Out aRead, aWrite: TUIBTransaction);
    Procedure FreeUIBConnection;
    {$ENDIF}
    {$IFDEF TDS}
    Property TDSDatabase: TTDSCTDataBase Read bTDSDatabase;
    Procedure HoldTDSConnection(Out aDatabase: TTDSCTDataBase;
      Out aRead, aWrite: TTDSCTTransaction);
    Procedure FreeTDSConnection;
    {$ENDIF}
    {$IFDEF IBX}
    Property IBXDatabase: TIBDataBase Read bIBXDatabase;
    Procedure HoldIBXConnection(Out aDatabase: TIBDataBase;
      Out aRead, aWrite: TIBTransaction);
    Procedure FreeIBXConnection;
    {$ENDIF}
    Constructor Build(Const aKind: Integer;
      Const aServer, aBase, aUser, aPassword, aLib: String);
    Destructor Burn;
End;

Type

{ BConnectionsPoolClass }

BConnectionsPoolClass = Class
  Strict Private
    bConnected: Boolean;
    bPool: TThreadList;
    bBase: String;
    bKind: Integer;
    bLib: String;
    bPassword: String;
    bServer: String;
    bUser: String;
    bPoolDepth: Integer;
    {$IFDEF UIB}
    bUIBDatabase: TUIBDataBase;
    bReadUIBTransaction: TUIBTransaction;
    bWriteUIBTransaction: TUIBTransaction;
    {$ENDIF}
    {$IFDEF TDS}
    bTDSDatabase: TTDSCTDataBase;
    bReadTDSTransaction: TTDSCTTransaction;
    bWriteTDSTransaction: TTDSCTTransaction;
    {$ENDIF}
    {$IFDEF IBX}
    bIBXDatabase: TIBDataBase;
    bReadIBXTransaction: TIBTransaction;
    bWriteIBXTransaction: TIBTransaction;
    {$ENDIF}
  Public
    Property Kind: Integer Read bKind;
    Property Server: String Read bServer;
    Property Base: String Read bBase;
    Property User: String Read bUser;
    Property Password: String Read bPassword;
    Property Lib: String Read bLib;
    Property Connected: Boolean Read bConnected;
    Property PoolDepth: Integer Read bPoolDepth;
    {$IFDEF UIB}
    Property ReadUIBTransaction: TUIBTransaction Read bReadUIBTransaction;
    Property WriteUIBTransaction: TUIBTransaction Read bWriteUIBTransaction;
    Property UIBDatabase: TUIBDataBase Read bUIBDatabase;
    Procedure HoldUIBConnection(Out aDatabase: TUIBDataBase;
      Out aRead, aWrite: TUIBTransaction);
    Procedure FreeUIBConnection(Const aDatabase: TUIBDataBase);
    {$ENDIF}
    {$IFDEF TDS}
    Property ReadTDSTransaction: TTDSCTTransaction Read bReadTDSTransaction;
    Property WriteTDSTransaction: TTDSCTTransaction Read bWriteTDSTransaction;
    Property TDSDatabase: TTDSCTDataBase Read bTDSDatabase;
    Procedure HoldTDSConnection(Out aDatabase: TTDSCTDataBase;
      Out aRead, aWrite: TTDSCTTransaction);
    Procedure FreeTDSConnection(Const aDatabase: TTDSCTDataBase);
    {$ENDIF}
    {$IFDEF IBX}
    Property ReadIBXTransaction: TIBTransaction Read bReadIBXTransaction;
    Property WriteIBXTransaction: TIBTransaction Read bWriteIBXTransaction;
    Property IBXDatabase: TIBDataBase Read bIBXDatabase;
    Procedure HoldIBXConnection(Out aDatabase: TIBDataBase;
      Out aRead, aWrite: TIBTransaction);
    Procedure FreeIBXConnection(Const aDatabase: TIBDataBase);
    {$ENDIF}
    Procedure Connect(Const aPoolDepth: Integer);
    Procedure Disconnect;
    Constructor Build(Const aKind: Integer;
      Const aServer, aBase, aUser, aPassword, aLib: String);
    Destructor Burn;
End;

{ BConnectionClass }

Function BConnectionClass.GetConnected: Boolean;
Begin
  Result := FALSE;
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}
      Result := Assigned(bUIBDatabase) And bUIBDatabase.Connected
      {$ENDIF}
      {$IFDEF IBX}
      Result := Assigned(bIBXDatabase) And bIBXDatabase.Connected
      {$ENDIF};
    DB_MS:
      {$IFDEF TDS}
      Result := Assigned(bTDSDatabase) And bTDSDatabase.Connected
      {$ENDIF};
  End;
End;

{$IFDEF IBX}
Procedure BConnectionClass.HoldIBXConnection(Out aDatabase: TIBDataBase; Out
  aRead, aWrite: TIBTransaction);
Begin
  aDatabase := bIBXDatabase;
  aRead := bReadIBXTransaction;
  aWrite := bWriteIBXTransaction;
  bBusy := TRUE;
End;

Procedure BConnectionClass.FreeIBXConnection;
Begin
  If bReadIBXTransaction.InTransaction Then bReadIBXTransaction.Commit;
  If bWriteIBXTransaction.InTransaction Then bWriteIBXTransaction.RollBack;
  bBusy := FALSE;
End;
{$ENDIF}

{$IFDEF UIB}
Procedure BConnectionClass.HoldUIBConnection(Out aDatabase: TUIBDataBase;
  Out aRead, aWrite: TUIBTransaction);
Begin
  aDatabase := bUIBDatabase;
  aRead := bReadUIBTransaction;
  aWrite := bWriteUIBTransaction;
  bBusy := TRUE;
End;

Procedure BConnectionClass.FreeUIBConnection;
Begin
  If bReadUIBTransaction.InTransaction Then bReadUIBTransaction.Commit;
  If bWriteUIBTransaction.InTransaction Then bWriteUIBTransaction.RollBack;
  bBusy := FALSE;
End;

{$ENDIF}

{$IFDEF TDS}
Procedure BConnectionClass.HoldTDSConnection(Out aDatabase: TTDSCTDataBase;
  Out aRead, aWrite: TTDSCTTransaction);
Begin
  aDatabase := bTDSDatabase;
  aRead := bReadTDSTransaction;
  aWrite := bWriteTDSTransaction;
  bBusy := TRUE;
End;

Procedure BConnectionClass.FreeTDSConnection;
Begin
  If bReadTDSTransaction.Active Then bReadTDSTransaction.Commit;
  If bWriteTDSTransaction.Active Then bWriteTDSTransaction.Rollback;
  bBusy := FALSE;
End;

{$ENDIF}

Constructor BConnectionClass.Build(Const aKind: Integer; Const aServer, aBase,
  aUser, aPassword, aLib: String);
Begin
  bKind := aKind;
  Case Kind Of
    DB_FB:
      Begin
        {$IFDEF UIB}
        bUIBDatabase := TUIBDataBase.Create(nil);
        bUIBDatabase.DatabaseName := Format('%s:%s', [aServer, aBase]);
        bUIBDatabase.UserName := aUser;
        bUIBDatabase.PassWord := aPassword;
        bUIBDatabase.CharacterSet := csUTF8;
        If Not(aLib = '') Then bUIBDatabase.LibraryName := aLib;

        bReadUIBTransaction := TUIBTransaction.Create(nil);
        bReadUIBTransaction.DataBase := bUIBDatabase;
        bReadUIBTransaction.Options :=
          [tpRead, tpReadCommitted, tpNowait, tpRecVersion];

        bWriteUIBTransaction := TUIBTransaction.Create(nil);
        bWriteUIBTransaction.DataBase := bUIBDatabase;
        bWriteUIBTransaction.Options := [tpWrite, tpNowait];
        Try
          bUIBDatabase.Connected := TRUE;
        Except On E: Exception Do
          //Add Here some log or exception
          //SafeLog(E.Message);
        End;
        {$ENDIF};
        {$IFDEF IBX}
        bIBXDatabase := TIBDataBase.Create(nil);
        bIBXDatabase.DatabaseName := Format('%s:%s', [aServer, aBase]);
        bIBXDatabase.Params.Add(Format('user_name=%s', [aUser]));
        bIBXDatabase.Params.Add(Format('password=%s', [aPassword]));
        bIBXDatabase.Params.Add('lc_ctype=UTF-8');
        bIBXDatabase.LoginPrompt := FALSE;

        bReadIBXTransaction := TIBTransaction.Create(nil);
        bReadIBXTransaction.DefaultDatabase := bIBXDatabase;
        bReadIBXTransaction.DefaultAction := TACommit;
        bReadIBXTransaction.Params.Add('read_committed');
        bReadIBXTransaction.Params.Add('rec_version');
        bReadIBXTransaction.Params.Add('nowait');

        bWriteIBXTransaction := TIBTransaction.Create(nil);
        bWriteIBXTransaction.DefaultDatabase := bIBXDatabase;
        bWriteIBXTransaction.DefaultAction := TARollback;
        bWriteIBXTransaction.Params.Add('write');
        bWriteIBXTransaction.Params.Add('consistency');

        Try
          bIBXDatabase.Connected := TRUE;
        Except On E: Exception Do
          Raise E;
          //SafeLog(E.Message);
        End;
        {$ENDIF}
      End;
    DB_MS:
      Begin
        {$IFDEF TDS}
        bTDSDatabase := TTDSCTDataBase.Create(nil);
        bTDSDatabase.ServerVersion := svMSSQL2008;
        bTDSDatabase.ServerName := aServer;
        bTDSDatabase.Database := aBase;
        bTDSDatabase.UserName := aUser;
        bTDSDatabase.Password := aPassword;
        bTDSDatabase.LibraryName := aLib;

        bReadTDSTransaction := TTDSCTTransaction.Create(nil);
        bReadTDSTransaction.DataBase := bTDSDatabase;

        bWriteTDSTransaction := TTDSCTTransaction.Create(nil);
        bWriteTDSTransaction.DataBase := bTDSDatabase;

        Try
          bTDSDatabase.Connected := TRUE;
        Except On E: Exception Do
          SafeLog(E.Message);
        End;
        {$ENDIF};
      End;
  End;
End;

Destructor BConnectionClass.Burn;
Begin
  Case bKind Of
    DB_FB:
      Begin
        {$IFDEF UIB}
        If bReadUIBTransaction.InTransaction Then bReadUIBTransaction.Commit;
        If bWriteUIBTransaction.InTransaction Then
          bWriteUIBTransaction.Rollback;
        bReadUIBTransaction.Free;
        bWriteUIBTransaction.Free;
        bUIBDatabase.Free;
        {$ENDIF};
        {$IFDEF IBX}
        If bReadIBXTransaction.InTransaction Then bReadIBXTransaction.Commit;
        If bWriteIBXTransaction.InTransaction THen
          bWriteIBXTransaction.Rollback;
        bReadIBXTransaction.Free;
        bWriteIBXTransaction.Free;
        bIBXDatabase.Free;
        {$ENDIF}
      End;
    DB_MS:
      Begin
        {$IFDEF TDS}
        If bReadTDSTransaction.Active Then bReadTDSTransaction.Commit;
        If bWriteTDSTransaction.Active Then bWriteTDSTransaction.Rollback;
        bReadTDSTransaction.Free;
        bWriteTDSTransaction.Free;
        bTDSDatabase.Free;
        {$ENDIF};
      End;
  End;
End;

{ BConnectionPoolClass }

{$IFDEF UIB}
Procedure BConnectionsPoolClass.HoldUIBConnection(Out aDatabase: TUIBDataBase;
  Out aRead, aWrite: TUIBTransaction);
Var
  i, aStep: Integer;
  aWasFound: Boolean;
  aConnection: BConnectionClass;
Begin
  aStep := 0;
  aWasFound := FALSE;
  With bPool.LockList Do
    Repeat
      For i := 0 To Count - 1 Do
        Begin
          aConnection := BConnectionClass(Items[i]);
          If Not(aConnection.Busy) Then
            Begin
              aConnection.HoldUIBConnection(aDatabase, aRead, aWrite);
              aWasFound := TRUE;
              Break;
            End;
          Inc(aStep);
          Sleep(20);
        End;
    Until aWasFound Or (aStep < STEP_MAX);
  bPool.UnlockList;
End;

Procedure BConnectionsPoolClass.FreeUIBConnection(
  Const aDatabase: TUIBDataBase);
Var
  i: Integer;
Begin
  With bPool.LockList Do
    For i := 0 To Count - 1 Do
      If BConnectionClass(Items[i]).UIBDatabase = aDatabase Then
        Begin
          BConnectionClass(Items[i]).FreeUIBConnection;
          Break;
        End;
  bPool.UnlockList;
End;
{$ENDIF}

{$IFDEF TDS}
Procedure BConnectionsPoolClass.HoldTDSConnection(Out aDatabase: TTDSCTDataBase;
  Out aRead, aWrite: TTDSCTTransaction);
Var
  i, aStep: Integer;
  aWasFound: Boolean;
  aConnection: BConnectionClass;
Begin
  aWasFound := FALSE;
  aStep := 0;
  With bPool.LockList Do
    Repeat
      For i := 0 To Count - 1 Do
        Begin
          aConnection := BConnectionClass(Items[i]);
          If Not(aConnection.Busy) Then
            Begin
              aConnection.HoldTDSConnection(aDatabase, aRead, aWrite);
              aWasFound := TRUE;
              Break;
            End;
          Inc(aStep);
          Sleep(20);
        End;
    Until aWasFound Or (aStep < STEP_MAX);
  bPool.UnlockList;
End;

Procedure BConnectionsPoolClass.FreeTDSConnection(
  Const aDatabase: TTDSCTDataBase);
Var
  i: Integer;
Begin
  With bPool.LockList Do
    For i := 0 To Count - 1 Do
      If BConnectionClass(Items[i]).TDSDatabase = aDatabase Then
        Begin
          BConnectionClass(Items[i]).FreeTDSConnection;
          Break;
        End;
  bPool.UnlockList;
End;
{$ENDIF}

{$IFDEF IBX}
Procedure BConnectionsPoolClass.HoldIBXConnection(Out aDatabase: TIBDataBase;
  Out aRead, aWrite: TIBTransaction);
Var
  i, aStep: Integer;
  aWasFound: Boolean;
  aConnection: BConnectionClass;
Begin
  aWasFound := FALSE;
  aStep := 0;
  With bPool.LockList Do
    Repeat
      For i := 0 To Count - 1 Do
        Begin
          aConnection := BConnectionClass(Items[i]);
          If Not(aConnection.Busy) Then
            Begin
              aConnection.HoldIBXConnection(aDatabase, aRead, aWrite);
              aWasFound := TRUE;
              Break;
            End;
          Inc(aStep);
          Sleep(20);
        End;
    Until aWasFound Or (aStep < STEP_MAX);
  If Not(aWasFound) Then Raise Exception.Create('No one free connection');
  bPool.UnlockList;
End;

Procedure BConnectionsPoolClass.FreeIBXConnection(
  Const aDatabase: TIBDataBase);
Var
  i: Integer;
Begin
  With bPool.LockList Do
    For i := 0 To Count - 1 Do
      If BConnectionClass(Items[i]).IBXDatabase = aDatabase Then
        Begin
          BConnectionClass(Items[i]).FreeIBXConnection;
          Break;
        End;
  bPool.UnlockList;
End;
{$ENDIF}

Procedure BConnectionsPoolClass.Connect(Const aPoolDepth: Integer);
Var
  i: Integer;
  aConnection: BConnectionClass;
Begin
  If Connected Then
    Begin
      Raise Exception.Create('Already Connected');
      Exit;
    End;
  If Not(PoolDepth = 0) Then
    ;//Add Here some log or exception
    //SafeLog('Pool not empty on connect');
  bPoolDepth := 0;
  For i := 1 To aPoolDepth Do
    Begin
      aConnection := BConnectionClass.Build(Kind,Server,Base,User,Password,Lib);
      If aConnection.Connected Then
        Begin
          bPool.Add(aConnection);
          Inc(bPoolDepth);
        End;
    End;
  If Not(aPoolDepth=PoolDepth) Then
    ;//Add Here some log or exception
    //SafeLog('Not all connections established');
  bConnected := TRUE;
End;

Procedure BConnectionsPoolClass.Disconnect;
Var
  i: Integer;
Begin
  With bPool.LockList Do
    Begin
      For i := 0 To Count - 1 Do
        BConnectionClass(Items[i]).Burn;
      bPoolDepth := 0;
      bConnected := FALSE;
      Clear;
    End;
  bPool.UnlockList
End;

Constructor BConnectionsPoolClass.Build(Const aKind: Integer; Const aServer, aBase,
  aUser, aPassword, aLib: String);
Begin
  bKind := aKind;
  bServer := aServer;
  bBase := aBase;
  bUser := aUser;
  bPassword := aPassword;
  bLib := aLib;
  bPool := TThreadList.Create;
End;

Destructor BConnectionsPoolClass.Burn;
Var
  i: Integer;
Begin
  With bPool.LockList Do
    For i := 0 To Count - 1 Do
      BConnectionClass(Items[i]).Burn;
  bPool.UnlockList;
  bPool.Free;
End;

{  BQueryClass  }

Constructor BQueryClass.Build(Const aID: Integer);
Begin
  {$IFDEF UIB}
    bUIBQuery := TUIBQuery.Create(nil);
  {$ENDIF}
  {$IFDEF TDS}
    bTDSQuery := TTDSCTQuery.Create(nil);
  {$ENDIF}
  {$IFDEF IBX}
    bIBXQuery := TIBSQL.Create(nil);
  {$ENDIF}
  bID := aID;
  bKind := DBManager.GetKind(aID);
  Case bKind Of
    DB_FB:
      Begin
      {$IFDEF UIB}
        DBManager.HoldUIBConnection(aID, bUIBDatabase, bUIBRead,
          bUIBWrite);
        bUIBQuery.DataBase := bUIBDatabase;
      {$ENDIF}
      {$IFDEF IBX}
        DBManager.HoldIBXConnection(aID, bIBXDatabase, bIBXRead, bIBXWrite);
        bIBXQuery.Database := bIBXDatabase;
      {$ENDIF}
      End;

    DB_MS:
      Begin
      {$IFDEF TDS}
        DBManager.HoldTDSConnection(aID, bTDSDatabase, bTDSRead,
          bTDSWrite);
        bTDSQuery.DataBase := bTDSDatabase;
      {$ENDIF}
      End;
  End;
End;

Destructor BQueryClass.Burn;
Begin
  Case bKind Of
    DB_FB:
      Begin
        {$IFDEF UIB}
        DBManager.FreeUIBConnection(bID, bUIBQuery.DataBase);
        bUIBQuery.Free;
        {$ENDIF}
        {$IFDEF IBX}
        DBManager.FreeIBXConnection(bID, bIBXQuery.Database);
        bIBXQuery.Free;
        {$ENDIF}
      End;
    DB_MS:
      Begin
        {$IFDEF TDS}
        DBManager.FreeTDSConnection(bID, bTDSQuery.DataBase);
        bTDSQuery.Free;
        {$ENDIF}
      End;
  End;
End;

{$IFDEF UIB}
Function BQueryClass.GetUIB(Const aSQL: BSQLClass): Boolean;
Var
  i: Integer;
Begin
  Result := FALSE;
  With bUIBQuery Do
    Begin
      Transaction := bUIBRead;
      If Not(Transaction.InTransaction) Then Transaction.StartTransaction;
      Params.Clear;
      SQL.Clear;
      SQL.Add(aSQL.SQL);
      For i := 0 To aSQL.Params.Count - 1 Do
        Params.ByNameAsString[BSQLParamClass(aSQL.Params[i]).Iterator] :=
          BSQLParamClass(aSQL.Params[i]).Value;
      Try
        If aSQL.IsProcedure Then Execute
        Else Open;
      Except On E: Exception Do
        Begin
          ;//Add Here some log or exception
          //Log(SQL.Text);
          //Log(E.Message);
        End;
      End;
    End;
  Result := TRUE;
End;

Function BQueryClass.PostUIB(Const aSQL: BSQLClass): Boolean;
Var
  i: Integer;
  aParam: BSQLParamClass;
Begin
  Result := FALSE;
  With bUIBQuery Do
    Begin
      Transaction := bUIBWrite;
      If Not(Transaction.InTransaction) Then Transaction.StartTransaction;
      Try
        Params.Clear;
        SQL.Text := aSQL.SQL;
        For i := 0 To aSQL.Params.Count - 1 Do
          Begin
            aParam := BSQLParamClass(aSQL.Params[i]);
            If aParam.Stream = nil Then
              Params.ByNameAsString[aParam.Iterator] :=  aParam.Value
            Else
              ParamsSetBlob(aParam.Iterator, aParam.Stream);
          End;
        If aSQL.IsProcedure Then Execute
        Else ExecSQL;
      Except On E: Exception Do
        Begin
          ;//Add Here some log or exception
          //Log(SQL.Text);
          //Log(E.Message);
          Transaction.Rollback;
          Exit;
        End;
      End;
    End;
  Result := TRUE;
End;
{$ENDIF}

{$IFDEF TDS}
Function BQueryClass.GetTDS(Const aSQL: BSQLClass): Boolean;
Var
  i: Integer;
Begin
  Result := FALSE;
  With bTDSQuery Do
    Begin
      Transaction := bTDSRead;
      Params.Clear;
      SQL.Text := aSQL.SQL;
      For i := 0 To aSQL.Params.Count - 1 Do
        Params.ParamByName(BSQLParamClass(aSQL.Params[i]).Iterator).AsString :=
          BSQLParamClass(aSQL.Params[i]).Value;
      Try
        If aSQL.IsProcedure Then ExecSQL
        Else Open;
      Except On E: Exception Do
        Begin
          DirectLog(SQL.Text);
          Log(E.Message);
        End;
      End;
    End;
  Result := TRUE;
End;

Function BQueryClass.PostTDS(Const aSQL: BSQLClass): Boolean;
Var
  i: Integer;
  aParam: BSQLParamClass;
Begin
  Result := FALSE;
  With bTDSQuery Do
    Begin
      Transaction := bTDSWrite;
      If Not(Transaction.Active) Then Transaction.StartTransaction;
      Try
        Params.Clear;
        SQL.Text := aSQL.SQL;
        For i := 0 To aSQL.Params.Count - 1 Do
          Begin
            aParam := BSQLParamClass(aSQL.Params[i]);
            // TODO: no blob support
            If aParam.Stream = nil Then
              ParamByName(aParam.Iterator).Value :=  aParam.Value;
          End;
        ExecSQL;
      Except On E: Exception Do
        Begin
          Log(SQL.Text);
          Log(E.Message);
          Transaction.Rollback;
          Exit;
        End;
      End;
    End;
  Result := TRUE;
End;
{$ENDIF}

{$IFDEF IBX}
Function BQueryClass.GetIBX(Const aSQL: BSQLClass): Boolean;
Var
  i: Integer;
Begin
  Result := FALSE;
  With bIBXQuery Do
    Begin
      If Open Then Close;
      Database := bIBXDatabase;
      Transaction := bIBXRead;
      If Not(Transaction.InTransaction) Then Transaction.StartTransaction;
      SQL.Text := aSQL.SQL;
      For i := 0 To aSQL.Params.Count - 1 Do
        Params.ByName(BSQLParamClass(aSQL.Params[i]).Iterator).AsString :=
          BSQLParamClass(aSQL.Params[i]).Value;
      Try
        ExecQuery;
      Except On E: Exception Do
        Begin
          Raise E;
          //SafeLog(SQL.Text);
          //SafeLog(E.Message);
        End;
      End;
    End;
  Result := TRUE;
End;

Function BQueryClass.PostIBX(Const aSQL: BSQLClass): Boolean;
Var
  i: Integer;
  aParam: BSQLParamClass;
Begin
  Result := FALSE;
  With bIBXQuery Do
    Begin
      Transaction := bIBXWrite;
      If Not(Transaction.InTransaction) Then Transaction.StartTransaction;
      Try
        SQL.Text := aSQL.SQL;
        For i := 0 To aSQL.Params.Count - 1 Do
          Begin
            aParam := BSQLParamClass(aSQL.Params[i]);
            // TODO: no blob support
            If aParam.Stream = nil Then
              ParamByName(aParam.Iterator).Value :=  aParam.Value;
          End;
        If Open Then Close;
        ExecQuery;
      Except On E: Exception Do
        Begin
          //SafeLog(SQL.Text);
          //SafeLog(E.Message);
          Transaction.Rollback;
          Raise E;
          Exit;
        End;
      End;
    End;
  Result := TRUE;
End;
{$ENDIF}

Function BQueryClass.ByString(Const aString: String): String;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := bUIBQuery.Fields.ByNameAsString[aString]{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.FieldByName(aString).AsString{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.ByNameAsString[aString]{$ENDIF};
  End;
End;

Function BQueryClass.ByDouble(Const aString: String): Double;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := bUIBQuery.Fields.ByNameAsDouble[aString]{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.FieldByName(aString).AsFloat{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.ByNameAsFloat[aString]{$ENDIF};
  End;
End;

Function BQueryClass.ByInteger(Const aString: String): Integer;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := bUIBQuery.Fields.ByNameAsInteger[aString]{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.FieldByName(aString).AsInteger{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.ByNameAsInteger[aString]{$ENDIF};
  End;
End;

Function BQueryClass.ByInt64(Const aString: String): Int64;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := bUIBQuery.Fields.ByNameAsInt64[aString]{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.FieldByName(aString).AsInt64{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.ByNameAsInt64[aString]{$ENDIF};
  End;
End;

Function BQueryClass.ByBoolean(Const aString: String): Boolean;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result:=bUIBQuery.Fields.ByNameAsBoolean[aString]{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.FieldByName(aString).AsInteger=1{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.ByNameAsInteger[aString] = 1{$ENDIF};
  End;
End;

Function BQueryClass.ByDate(Const aString: String): TDateTime;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := bUIBQuery.Fields.ByNameAsDate[aString]{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.FieldByName(aString).AsDateTime{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.ByNameAsDate[aString]{$ENDIF};
  End;
End;

Function BQueryClass.ByDateTime(Const aString: String): TDateTime;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := bUIBQuery.Fields.ByNameAsDateTime[aString]{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.FieldByName(aString).AsDateTime{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.ByNameAsDateTime[aString]{$ENDIF};
  End;
End;

Function BQueryClass.Get(Const aSQL: BSQLClass): Boolean;
Begin
  Result := FALSE;
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := GetUIB(aSQL){$ENDIF}
      {$IFDEF IBX}Result := GetIBX(aSQL){$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := GetTDS(aSQL){$ENDIF};

  End;
End;

Function BQueryClass.Get(Const aString: String;
  Const ForExecute: Boolean = FALSE): Boolean;
Var
  aSQL: BSQLClass;
Begin
  aSQL := BSQLClass.Build(aString, ForExecute);
  Result := Get(aSQL);
  aSQL.Burn;
End;

Function BQueryClass.Post(Const aSQL: BSQLClass): Boolean;
Begin
  Result := FALSE;
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := PostUIB(aSQL){$ENDIF}
      {$IFDEF IBX}Result := PostIBX(aSQL){$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := PostTDS(aSQL){$ENDIF};
  End;
End;

Function BQueryClass.Post(Const aString: String;
  Const ForExecute: Boolean): Boolean;
Var
  aSQL: BSQLClass;
Begin
  aSQL := BSQLClass.Build(aString, ForExecute);
  Result := Post(aSQL);
  aSQL.Burn;
End;

Function BQueryClass.Post(Const aMask: String;
  Const aParams: Array Of Const): Boolean;
Begin
  Result := Post(Format(aMask, aParams));
End;

Function BQueryClass.EOF: Boolean;
Begin
  Result := TRUE;
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}Result := bUIBQuery.Eof{$ENDIF}
      {$IFDEF IBX}Result := bIBXQuery.EOF{$ENDIF};
    DB_MS:
      {$IFDEF TDS}Result := bTDSQuery.Eof{$ENDIF};
  End;
End;

Procedure BQueryClass.Go;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}
        With bUIBQuery Do
          Begin
            Transaction := bUIBWrite;
            If Transaction.InTransaction Then Transaction.Commit;
          End{$ENDIF}
      {$IFDEF IBX}
        With bIBXQuery Do
          Begin
            Transaction := bIBXWrite;
            If Transaction.InTransaction Then Transaction.Commit;
          End{$ENDIF};
    DB_MS:
      {$IFDEF TDS}
        With bTDSQuery Do
          Begin
            Transaction := bTDSWrite;
            If Transaction.Active Then Transaction.Commit;
          End{$ENDIF};

  End;
End;

Procedure BQueryClass.Next;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}bUIBQuery.Next{$ENDIF}
      {$IFDEF IBX}bIBXQuery.Next{$ENDIF};
    DB_MS:
      {$IFDEF TDS}bTDSQuery.Next{$ENDIF};
  End;
End;

Procedure BQueryClass.First;
Begin
  Case bKind Of
    DB_FB:
      {$IFDEF UIB}bUIBQuery.First{$ENDIF}
      {$IFDEF IBX}Raise Exception.Create('First is not implemented'){$ENDIF};
    DB_MS:
      {$IFDEF TDS}Raise Exception.Create('First is not implemented'){$ENDIF};
  End;
End;

{ BDBManagerClass }

Constructor BDBManagerClass.Build;
Begin
  bPools := TThreadList.Create;
End;

Destructor BDBManagerClass.Burn;
Var
  i: Integer;
Begin
  With bPools.LockList Do
    For i := 0 To Count - 1 Do
      BConnectionsPoolClass(Items[i]).Burn;
  bPools.UnlockList;
  bPools.Free;
End;

Function BDBManagerClass.AddDatabase(Const aKind: Integer;
  Const aServer, aBase, aUser, aPassword: String; Const aLib: String): Integer;
Begin
  With bPools.LockList Do
    Begin
      Result := Count;
      Add(BConnectionsPoolClass.Build(aKind,aServer,aBase,aUser,aPassword,aLib))
    End;
  bPools.UnlockList;
End;

Procedure BDBManagerClass.RemoveDatabase(Const aIndex: Integer);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  With bPools.LockList Do
    Begin
      If (Count = 0) Or Not(aIndex < Count) Then
        Raise Exception.Create('Illegal Index on Remove Database');
      aConnectionPool := BConnectionsPoolClass(Items[aIndex]);
      aConnectionPool.Burn;
      Delete(aIndex);
    End;
  bPools.UnlockList;
End;

Function BDBManagerClass.GetKind(Const aIndex: Integer): Integer;
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  Result := aConnectionPool.Kind;
End;

Procedure BDBManagerClass.Connect(Const aIndex: Integer;
  Const aPoolSize: Integer);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.Connect(aPoolSize);
End;

{$IFDEF IBX}
Procedure BDBManagerClass.HoldIBXConnection(Const aIndex: Integer;
  Out aDatabase: TIBDataBase; Out aRead, aWrite: TIBTransaction);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.HoldIBXConnection(aDatabase, aRead, aWrite);
End;

Procedure BDBManagerClass.FreeIBXConnection(Const aIndex: Integer;
  Const aDatabase: TIBDataBase);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.FreeIBXConnection(aDatabase);
End;
{$ENDIF}

{$IFDEF UIB}
Procedure BDBManagerClass.HoldUIBConnection(Const aIndex: Integer;
  Out aDatabase: TUIBDataBase; Out aRead, aWrite: TUIBTransaction);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.HoldUIBConnection(aDatabase, aRead, aWrite);
End;

Procedure BDBManagerClass.FreeUIBConnection(Const aIndex: Integer;
  Const aDatabase: TUIBDataBase);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.FreeUIBConnection(aDatabase);
End;

{$ENDIF}

{$IFDEF TDS}
Procedure BDBManagerClass.HoldTDSConnection(Const aIndex: Integer;
  Out aDatabase: TTDSCTDataBase; Out aRead, aWrite: TTDSCTTransaction);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.HoldTDSConnection(aDatabase, aRead, aWrite);
End;

Procedure BDBManagerClass.FreeTDSConnection(Const aIndex: Integer;
  Const aDatabase: TTDSCTDataBase);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.FreeTDSConnection(aDatabase);
End;
{$ENDIF}

Procedure BDBManagerClass.Disconnect(Const aIndex: Integer);
Var
  aConnectionPool: BConnectionsPoolClass;
Begin
  aConnectionPool := BConnectionsPoolClass(bPools.LockList.Items[aIndex]);
  bPools.UnlockList;
  aConnectionPool.Disconnect;
End;

Initialization
Begin
  DBManager := BDBManagerClass.Build;
End;

Finalization
Begin
  DBManager.Burn;
End;

End.


Код: Выделить всё
program Project1;

{$mode objfpc}{$H+}

uses
  {$DEFINE IBX} // Use Flags -dIBX, -dUIB, -dTDS instead {$DEFINE}
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  interfaces,
  Classes, BQueryUnit, BSQLUnit;


{$R *.res}
Var
  aSQL: BSQLClass;
  aMyQuery, anAlienQuery: BQueryClass;
  aMyBaseIndex, anAlienBaseIndex: Integer;

begin
  aMyBaseIndex := DBManager.AddDatabase(DB_FB, 'localhost',
    '/var/lib/firebird/data/mybase.fdb', 'SYSDBA', 'masterkey');
  DBManager.Connect(aMyBaseIndex, 1); // Only one connection available
  aMyQuery := BQueryClass.Build(aMyBaseIndex);
  aMyQuery.Post('INSERT INTO MY_TABLE(ID, CAPTION) VALUES(100, %s)',
    [#39'Hello World'#39]);
  aMyQuery.Go;
  Try  // No way
    With BQueryClass.Build(aMyBaseIndex) Do
      Burn;
  Except
    WriteLn('Some memory leak protection?');
  End;
  aMyQuery.Burn; // After this we are able to create anoter connection
  With BQueryClass.Build(aMyBaseIndex) Do
    Begin
      Get('SELECT * FROM MY_TABLE WHERE ID = 100');
      WriteLn(ByString('CAPTION'));
      Burn;
    End;

  aSQL := BSQLClass.Build('INSERT INTO ALIEN_TABLE(ID,CAPTION) ' +
    'VALUES(100, :CAPTION)');
  aSQL.AddParam('CAPTION', 'tata for now');

  anAlienBaseIndex := DBManager.AddDatabase(DB_FB, 'localhost', 'alienbase',
    'SYSDBA', 'masterkey');
  DBManager.Connect(anAlienBaseIndex, 2); // Two for now ^_^
  anAlienQuery := BQueryClass.Build(anAlienBaseIndex);
  anAlienQuery.Post(aSQL);
  aSQL.AddParam('CAPTION', 'See''ya');
  anAlienQuery.Post(aSQL);
  anAlienQuery.Go;

  With BQueryClass.Build(anAlienBaseIndex) Do
    Begin
      aMyQuery := BQueryClass.Build(aMyBaseIndex); // Work with two bases
      aMyQuery.Get('SELECT * FROM MY_TABLE WHERE ID = 100');
      Get('SELECT * FROM ALIEN_TABLE WHERE ID = 100');
      While Not(aMyQuery.EOF) Do
        Begin
          WriteLn(aMyQuery.ByString('CAPTION'));
          aMyQuery.Next;
        End;
      While Not(EOF) Do
        Begin
          WriteLn(ByString('CAPTION'));
          Next;
        End;

      Post('DELETE FROM ALIEN_TABLE');
      Go;
      Burn;

      aMyQuery.Post('DELETE FROM MY_TABLE');
      aMyQuery.Go;
      aMyQuery.Burn;
    End;
  anAlienQuery.Burn;
  aSQL.Burn;
end.
Аватара пользователя
Brainenjii
энтузиаст
 
Сообщения: 1351
Зарегистрирован: 10.05.2007 00:04:46
Вернуться к началу

Re: Аналог TSQLiteWrapper для FireBird

Сообщение Nik » 03.06.2011 12:17:44

2Brainenjii
Теперь компилируется. Спасибо! :) Буду разбираться.
Аватара пользователя
Nik
энтузиаст
 
Сообщения: 573
Зарегистрирован: 04.02.2006 00:08:09
Откуда: Киров
Вернуться к началу
Ответить

Вернуться в Потрепаться

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 10

Powered by phpBB® Forum Software © phpBB Group
Русская поддержка phpBB
Рейтинг@Mail.ru