Chip 2005 May/CMCD0505.ISO/Software/Shareware/Programare/pgedri/Source/pgeDriverUtils.pas

Pascal/Delphi Source File | 2005-04-01 | 7.4 KB | 247 lines

{*******************************************************************}
{                                                                   }
{       Vita Voom Software                                          }
{       pgeDriverUtils.pas unit                                     }
{                                                                   }
{       Copyright (c) 1998-2003 Vita Voom Software                  }
{       ALL RIGHTS RESERVED                                         }
{*******************************************************************}
{                                                                   }
{ This unit contains utility functions for use with the pgExpress   }
{ driver.                                                           }
{                                                                   }
{ Please refer to the pgeExpress documentation for details.         }
{                                                                   }
{*******************************************************************}

unit pgeDriverUtils;

interface

uses
  SqlExpr, DB, DBXpress;

type
  EPGECancel = class(EDatabaseError);
  TCancelQuery = procedure(Handle: Pointer);
  PPGconn = Pointer;
  TCSQLConnection = class(TSQLConnection);

const
  strTTY = 'TTY';
  strBackendPID = 'BackendPID';
  strRetainCursor = 'RetainCursor';
  strPGVersion = 'PGVersion';
  strLanguage = 'Language';

  {$IF (RTLVersion >= 14.5) and Defined(MSWINDOWS)}
    {$DEFINE DELPHI7_OR_HIGHER}
  {$IFEND}

  {$IF RTLVersion < 16}
    // Before Delphi 8, the DBXERR_NONE constant was called 'SQL_SUCCESS'
    DBXERR_NONE = SQL_SUCCESS;
  {$IFEND}

{$IFDEF DELPHI7_OR_HIGHER}
  // Retrieves the PostgreSQL version number. D7+ Only.
  function GetPGVersion(Connection: TSQLConnection): Extended;

  // Returns the file or TTY debug for the connection. D7+ Only.
  function GetTTY(Connection: TSQLConnection): AnsiString;

  // Returns the server PID (process ID) for the connection. D7+ Only.
  function GetBackendPID(Connection: TSQLConnection): Integer;

  // Returns True if a connection to the server exists. D7+ Only.
  function GetOnline(Connection: TSQLConnection): Boolean;

  // Gets the internal RetainCursor variable. D7+ Only.
  function GetRetainCursor(Connection: TSQLConnection): Boolean;

  // Sets the internal RetainCursor variable. D7+ Only.
  procedure SetRetainCursor(Connection: TSQLConnection; Value: Boolean);

  // Gets the internal driver Language, for the error messages.
  function GetLanguage(Connection: TSQLConnection): AnsiString;

  // Sets the internal driver Language, for the error messages.
  // D7+ Only, and will work only for multilanguage driver, if language <> enUS.
  procedure SetLanguage(Connection: TSQLConnection; Value: AnsiString);

  procedure CancelQuery(Connection: TSQLConnection);
{$ENDIF}

implementation

uses
  Types, SysUtils
  {$IFDEF MSWINDOWS}
    , Windows
  {$ELSE}
    , Libc
  {$ENDIF};

// Auxiliar function.
procedure Check(Value: Word; Connection: TSQLConnection);
var
  S: AnsiString;
  Len: SmallInt;
begin
  if Value <> DBXERR_NONE then
  begin
    Len := Connection.SQLConnection.getErrorMessageLen(Len);
    SetLength(S, Len);
    Connection.SQLConnection.getErrorMessage(PChar(S));
    DatabaseError(S);
  end;
end;

function GetConn(Connection: TSQLConnection): PPGconn;
var
  Len: SmallInt;
begin
  if Connection.SQLConnection = nil then
    Result := nil
  else
    Connection.SQLConnection.GetOption(eConnNativeHandle, @Result, SizeOf(Result), Len)
end;

{$IFDEF DELPHI7_OR_HIGHER}
  // Retrieves the PostgreSQL version number. D7+ Only.
  function GetPGVersion(Connection: TSQLconnection): Extended;
  const
    BufSize: Byte = 50;
  var
    Len: SmallInt;
    Buffer: TByteDynArray;
  begin
    SetLength(Buffer, BufSize);
    StrCopy(@Buffer[0], strPGVersion);
    Check(Connection.SQLConnection.GetOption(eConnCustomInfo, @Buffer[0], Length(Buffer), Len), Connection);
    Result := PExtended(Buffer)^;
  end;

  // Returns the file or TTY debug for the connection. D7+ Only.
  function GetTTY(Connection: TSQLConnection): AnsiString;
  const
    BufSize: Byte = 50;
  var
    Buffer: TByteDynArray;
    Len: SmallInt;
  begin
    SetLength(Buffer, BufSize);
    try
      StrCopy(@Buffer[0], strTTY);
      Check(Connection.SQLConnection.GetOption(eConnCustomInfo, @Buffer[0], BufSize, Len), Connection);
      Result := StrPas(@Buffer[0]);
    finally
      Buffer := nil;
    end;
  end;

  // Returns the file or TTY debug for the connection. D7+ Only.
  function GetBackendPID(Connection: TSQLConnection): Integer;
  const
    BufSize: Byte = 20;
  var
    Buffer: TByteDynArray;
    Len: SmallInt;
  begin
    SetLength(Buffer, BufSize);
    try
      StrCopy(@Buffer[0], strBackendPID);
      Check(Connection.SQLConnection.GetOption(eConnCustomInfo, @Buffer[0], BufSize, Len), Connection);
      Result := PInteger(@Buffer[0])^;
    finally
      Buffer := nil;
    end;
  end;

  // Returns True if a connection to the server exists. D7+ Only.
  function GetOnline(Connection: TSQLConnection): Boolean;
  var
    Len: SmallInt;
    Value: Boolean;
  begin
    Check(Connection.SQLConnection.GetOption(eConnCustomInfo, @Value, SizeOf(Boolean), Len), Connection);
    Result := PBoolean(@Value)^;
  end;

  // Returns the internal RetainCursor variable. D7+ Only.
  function GetRetainCursor(Connection: TSQLConnection): Boolean;
  const
    BufSize: Byte = 20;
  var
    Buffer: TByteDynArray;
    Len: SmallInt;
  begin
    SetLength(Buffer, BufSize);
    try
      StrCopy(@Buffer[0], strRetainCursor);
      Check(Connection.SQLConnection.GetOption(eConnCustomInfo, @Buffer[0], BufSize, Len), Connection);
      Result := PBoolean(@Buffer[0])^;
    finally
      Buffer := nil;
    end;
  end;

  // Sets the internal RetainCursor variable. D7+ Only.
  procedure SetRetainCursor(Connection: TSQLConnection; Value: Boolean);
  var
    S: AnsiString;
  begin
    S := strRetainCursor + '=' + BoolToStr(Value, True);
    Check(Connection.SQLConnection.SetOption(eConnCustomInfo, Integer(PChar(S))), Connection);
  end;

  // Gets the internal driver Language, for the error messages.
  function GetLanguage(Connection: TSQLConnection): AnsiString;
  const
    BufSize: Byte = 10;
  var
    Buffer: TByteDynArray;
    Len: SmallInt;
  begin
    SetLength(Buffer, BufSize);
    try
      StrCopy(@Buffer[0], strLanguage);
      Check(Connection.SQLConnection.GetOption(eConnCustomInfo, @Buffer[0], BufSize, Len), Connection);
      Result := StrPas(@Buffer[0]);
    finally
      Buffer := nil;
    end;
  end;

  // Sets the internal driver Language, for the error messages.
  procedure SetLanguage(Connection: TSQLConnection; Value: AnsiString);
  var
    S: AnsiString;
  begin
    S := strLanguage + '=' + Value;
    Check(Connection.SQLConnection.SetOption(eConnCustomInfo, Integer(PChar(S))), Connection);
  end;
{$ENDIF}

// Cancels a query
procedure CancelQuery(Connection: TSQLConnection);
const
  ProcName = 'CancelQuery';
var
  LibHandle: THandle;
  CQ: TCancelQuery;
begin
  LibHandle := TCSQLConnection(Connection).SQLDllHandle;
  if LibHandle <> 0 then
  begin
    {$IFDEF MSWINDOWS}
      @CQ := GetProcAddress(LibHandle, ProcName);
    {$ELSE}
      @CQ := dlsym(Pointer(LibHandle), ProcName);
    {$ENDIF}
    CQ(GetConn(Connection));
  end
end;

end.