--- ibx/trunk/runtime/IB.pas	2013/02/28 16:56:14	16
+++ ibx/trunk/runtime/IB.pas	2013/12/28 19:22:24	17
@@ -1,521 +1,521 @@
-{************************************************************************}
-{                                                                        }
-{       Borland Delphi Visual Component Library                          }
-{       InterBase Express core components                                }
-{                                                                        }
-{       Copyright (c) 1998-2000 Inprise Corporation                      }
-{                                                                        }
-{    InterBase Express is based in part on the product                   }
-{    Free IB Components, written by Gregory H. Deatz for                 }
-{    Hoagland, Longo, Moran, Dunst & Doukas Company.                     }
-{    Free IB Components is used under license.                           }
-{                                                                        }
-{    The contents of this file are subject to the InterBase              }
-{    Public License Version 1.0 (the "License"); you may not             }
-{    use this file except in compliance with the License. You            }
-{    may obtain a copy of the License at http://www.Inprise.com/IPL.html }
-{    Software distributed under the License is distributed on            }
-{    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
-{    express or implied. See the License for the specific language       }
-{    governing rights and limitations under the License.                 }
-{    The Original Code was created by InterBase Software Corporation     }
-{       and its successors.                                              }
-{    Portions created by Inprise Corporation are Copyright (C) Inprise   }
-{       Corporation. All Rights Reserved.                                }
-{    Contributor(s): Jeff Overcash                                       }
-{                                                                        }
-{    IBX For Lazarus (Firebird Express)                                  }
-{    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
-{    Portions created by MWA Software are copyright McCallum Whyman      }
-{    Associates Ltd 2011                                                 }
-{                                                                        }
-{************************************************************************}
-
-unit IB;
-
-{$Mode Delphi}
-
-interface
-
-uses
-{$IFDEF WINDOWS }
-  Windows,
-{$ELSE}
-  unix,
-{$ENDIF}
-  SysUtils, Classes, IBExternals, IBUtils, DB, IBXConst;
-
-type
-  TTraceFlag = (tfQPrepare, tfQExecute, tfQFetch, tfError, tfStmt, tfConnect,
-     tfTransact, tfBlob, tfService, tfMisc);
-  TTraceFlags = set of TTraceFlag;
-
-  EIBError                  = class(EDatabaseError)
-  private
-    FSQLCode: Long;
-    FIBErrorCode: Long;
-  public
-    constructor Create(ASQLCode: Long; Msg: string); overload;
-    constructor Create(ASQLCode: Long; AIBErrorCode: Long; Msg: string); overload;
-    property SQLCode: Long read FSQLCode;
-    property IBErrorCode: Long read FIBErrorCode;
-  end;
-
-  EIBInterBaseError         = class(EIBError);
-  EIBClientError            = class(EIBError);
-
-  TIBDataBaseErrorMessage    = (ShowSQLCode,
-                                ShowIBMessage,
-                                ShowSQLMessage);
-  TIBDataBaseErrorMessages   = set of TIBDataBaseErrorMessage;
-  TIBClientError            = (
-    ibxeUnknownError,
-    ibxeInterBaseMissing,
-    ibxeInterBaseInstallMissing,
-    ibxeIB60feature,
-    ibxeNotSupported,
-    ibxeNotPermitted,
-    ibxeFileAccessError,
-    ibxeConnectionTimeout,
-    ibxeCannotSetDatabase,
-    ibxeCannotSetTransaction,
-    ibxeOperationCancelled,
-    ibxeDPBConstantNotSupported,
-    ibxeDPBConstantUnknown,
-    ibxeTPBConstantNotSupported,
-    ibxeTPBConstantUnknown,
-    ibxeDatabaseClosed,
-    ibxeDatabaseOpen,
-    ibxeDatabaseNameMissing,
-    ibxeNotInTransaction,
-    ibxeInTransaction,
-    ibxeTimeoutNegative,
-    ibxeNoDatabasesInTransaction,
-    ibxeUpdateWrongDB,
-    ibxeUpdateWrongTR,
-    ibxeDatabaseNotAssigned,
-    ibxeTransactionNotAssigned,
-    ibxeXSQLDAIndexOutOfRange,
-    ibxeXSQLDANameDoesNotExist,
-    ibxeEOF,
-    ibxeBOF,
-    ibxeInvalidStatementHandle,
-    ibxeSQLOpen,
-    ibxeSQLClosed,
-    ibxeDatasetOpen,
-    ibxeDatasetClosed,
-    ibxeUnknownSQLDataType,
-    ibxeInvalidColumnIndex,
-    ibxeInvalidParamColumnIndex,
-    ibxeInvalidDataConversion,
-    ibxeColumnIsNotNullable,
-    ibxeBlobCannotBeRead,
-    ibxeBlobCannotBeWritten,
-    ibxeEmptyQuery,
-    ibxeCannotOpenNonSQLSelect,
-    ibxeNoFieldAccess,
-    ibxeFieldReadOnly,
-    ibxeFieldNotFound,
-    ibxeNotEditing,
-    ibxeCannotInsert,
-    ibxeCannotPost,
-    ibxeCannotUpdate,
-    ibxeCannotDelete,
-    ibxeCannotRefresh,
-    ibxeBufferNotSet,
-    ibxeCircularReference,
-    ibxeSQLParseError,
-    ibxeUserAbort,
-    ibxeDataSetUniDirectional,
-    ibxeCannotCreateSharedResource,
-    ibxeWindowsAPIError,
-    ibxeColumnListsDontMatch,
-    ibxeColumnTypesDontMatch,
-    ibxeCantEndSharedTransaction,
-    ibxeFieldUnsupportedType,
-    ibxeCircularDataLink,
-    ibxeEmptySQLStatement,
-    ibxeIsASelectStatement,
-    ibxeRequiredParamNotSet,
-    ibxeNoStoredProcName,
-    ibxeIsAExecuteProcedure,
-    ibxeUpdateFailed,
-    ibxeNotCachedUpdates,
-    ibxeNotLiveRequest,
-    ibxeNoProvider,
-    ibxeNoRecordsAffected,
-    ibxeNoTableName,
-    ibxeCannotCreatePrimaryIndex,
-    ibxeCannotDropSystemIndex,
-    ibxeTableNameMismatch,
-    ibxeIndexFieldMissing,
-    ibxeInvalidCancellation,
-    ibxeInvalidEvent,
-    ibxeMaximumEvents,
-    ibxeNoEventsRegistered,
-    ibxeInvalidQueueing,
-    ibxeInvalidRegistration,
-    ibxeInvalidBatchMove,
-    ibxeSQLDialectInvalid,
-    ibxeSPBConstantNotSupported,
-    ibxeSPBConstantUnknown,
-    ibxeServiceActive,
-    ibxeServiceInActive,
-    ibxeServerNameMissing,
-    ibxeQueryParamsError,
-    ibxeStartParamsError,
-    ibxeOutputParsingError,
-    ibxeUseSpecificProcedures,
-    ibxeSQLMonitorAlreadyPresent,
-    ibxeCantPrintValue,
-    ibxeEOFReached,
-    ibxeEOFInComment,
-    ibxeEOFInString,
-    ibxeParamNameExpected,
-    ibxeSuccess,
-    ibxeDelphiException,
-    ibxeNoOptionsSet,
-    ibxeNoDestinationDirectory,
-    ibxeNosourceDirectory,
-    ibxeNoUninstallFile,
-    ibxeOptionNeedsClient,
-    ibxeOptionNeedsServer,
-    ibxeInvalidOption,
-    ibxeInvalidOnErrorResult,
-    ibxeInvalidOnStatusResult,
-    ibxeDPBConstantUnknownEx,
-    ibxeTPBConstantUnknownEx,
-    ibxeSV5APIError,
-    ibxeThreadFailed,
-    ibxeFieldSizeError
-    );
-
-  TStatusVector              = array[0..19] of ISC_STATUS;
-  PStatusVector              = ^TStatusVector;
-
-
-const
-  IBPalette1 = 'Firebird'; {do not localize}
-  IBPalette2 = 'Firebird Admin'; {do not localize}
-
-  IBLocalBufferLength = 512;
-  IBBigLocalBufferLength = IBLocalBufferLength * 2;
-  IBHugeLocalBufferLength = IBBigLocalBufferLength * 20;
-
-  IBErrorMessages: array[TIBClientError] of string = (
-    SUnknownError,
-    SInterBaseMissing,
-    SInterBaseInstallMissing,
-    SIB60feature,
-    SNotSupported,
-    SNotPermitted,
-    SFileAccessError,
-    SConnectionTimeout,
-    SCannotSetDatabase,
-    SCannotSetTransaction,
-    SOperationCancelled,
-    SDPBConstantNotSupported,
-    SDPBConstantUnknown,
-    STPBConstantNotSupported,
-    STPBConstantUnknown,
-    SDatabaseClosed,
-    SDatabaseOpen,
-    SDatabaseNameMissing,
-    SNotInTransaction,
-    SInTransaction,
-    STimeoutNegative,
-    SNoDatabasesInTransaction,
-    SUpdateWrongDB,
-    SUpdateWrongTR,
-    SDatabaseNotAssigned,
-    STransactionNotAssigned,
-    SXSQLDAIndexOutOfRange,
-    SXSQLDANameDoesNotExist,
-    SEOF,
-    SBOF,
-    SInvalidStatementHandle,
-    SSQLOpen,
-    SSQLClosed,
-    SDatasetOpen,
-    SDatasetClosed,
-    SUnknownSQLDataType,
-    SInvalidColumnIndex,
-    SInvalidParamColumnIndex,
-    SInvalidDataConversion,
-    SColumnIsNotNullable,
-    SBlobCannotBeRead,
-    SBlobCannotBeWritten,
-    SEmptyQuery,
-    SCannotOpenNonSQLSelect,
-    SNoFieldAccess,
-    SFieldReadOnly,
-    SFieldNotFound,
-    SNotEditing,
-    SCannotInsert,
-    SCannotPost,
-    SCannotUpdate,
-    SCannotDelete,
-    SCannotRefresh,
-    SBufferNotSet,
-    SCircularReference,
-    SSQLParseError,
-    SUserAbort,
-    SDataSetUniDirectional,
-    SCannotCreateSharedResource,
-    SWindowsAPIError,
-    SColumnListsDontMatch,
-    SColumnTypesDontMatch,
-    SCantEndSharedTransaction,
-    SFieldUnsupportedType,
-    SCircularDataLink,
-    SEmptySQLStatement,
-    SIsASelectStatement,
-    SRequiredParamNotSet,
-    SNoStoredProcName,
-    SIsAExecuteProcedure,
-    SUpdateFailed,
-    SNotCachedUpdates,
-    SNotLiveRequest,
-    SNoProvider,
-    SNoRecordsAffected,
-    SNoTableName,
-    SCannotCreatePrimaryIndex,
-    SCannotDropSystemIndex,
-    STableNameMismatch,
-    SIndexFieldMissing,
-    SInvalidCancellation,
-    SInvalidEvent,
-    SMaximumEvents,
-    SNoEventsRegistered,
-    SInvalidQueueing,
-    SInvalidRegistration,
-    SInvalidBatchMove,
-    SSQLDialectInvalid,
-    SSPBConstantNotSupported,
-    SSPBConstantUnknown,
-    SServiceActive,
-    SServiceInActive,
-    SServerNameMissing,
-    SQueryParamsError,
-    SStartParamsError,
-    SOutputParsingError,
-    SUseSpecificProcedures,
-    SSQLMonitorAlreadyPresent,
-    SCantPrintValue,
-    SEOFReached,
-    SEOFInComment,
-    SEOFInString,
-    SParamNameExpected,
-    SSuccess,
-    SDelphiException,
-    SNoOptionsSet,
-    SNoDestinationDirectory,
-    SNosourceDirectory,
-    SNoUninstallFile,
-    SOptionNeedsClient,
-    SOptionNeedsServer,
-    SInvalidOption,
-    SInvalidOnErrorResult,
-    SInvalidOnStatusResult,
-    SDPBConstantUnknownEx,
-    STPBConstantUnknownEx,
-    SSV5APIError,
-    SThreadFailed,
-    SFieldSizeError
-  );
-
-var
-  IBCS: TRTLCriticalSection;
-
-procedure IBAlloc(var P; OldSize, NewSize: Integer);
-
-procedure IBError(ErrMess: TIBClientError; const Args: array of const);
-procedure IBDataBaseError;
-
-function StatusVector: PISC_STATUS;
-function StatusVectorArray: PStatusVector;
-function CheckStatusVector(ErrorCodes: array of ISC_STATUS): Boolean;
-function StatusVectorAsText: string;
-
-procedure SetIBDataBaseErrorMessages(Value: TIBDataBaseErrorMessages);
-function GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
-
-implementation
-
-uses
-  IBIntf;
-
-var
-  IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
-threadvar
-  FStatusVector : TStatusVector;
-
-procedure IBAlloc(var P; OldSize, NewSize: Integer);
-var
-  i: Integer;
-begin
-  ReallocMem(Pointer(P), NewSize);
-  for i := OldSize to NewSize - 1 do PChar(P)[i] := #0;
-end;
-
-procedure IBError(ErrMess: TIBClientError; const Args: array of const);
-begin
-  raise EIBClientError.Create(Ord(ErrMess),
-                              Format(IBErrorMessages[ErrMess], Args));
-end;
-
-procedure IBDataBaseError;
-var
-  sqlcode: Long;
-  IBErrorCode: Long;
-  local_buffer: array[0..IBHugeLocalBufferLength - 1] of char;
-  usr_msg: string;
-  status_vector: PISC_STATUS;
-  IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
-begin
-  usr_msg := '';
-
-  { Get a local reference to the status vector.
-    Get a local copy of the IBDataBaseErrorMessages options.
-    Get the SQL error code }
-  status_vector := StatusVector;
-  IBErrorCode := StatusVectorArray[1];
-  IBDataBaseErrorMessages := GetIBDataBaseErrorMessages;
-  sqlcode := isc_sqlcode(status_vector);
-
-  if (ShowSQLCode in IBDataBaseErrorMessages) then
-    usr_msg := usr_msg + 'SQLCODE: ' + IntToStr(sqlcode); {do not localize}
-  Exclude(IBDataBaseErrorMessages, ShowSQLMessage);
-  if (ShowSQLMessage in IBDataBaseErrorMessages) then
-  begin
-    isc_sql_interprete(sqlcode, local_buffer, IBLocalBufferLength);
-    if (ShowSQLCode in IBDataBaseErrorMessages) then
-      usr_msg := usr_msg + CRLF;
-    usr_msg := usr_msg + strpas(local_buffer);
-  end;
-
-  if (ShowIBMessage in IBDataBaseErrorMessages) then
-  begin
-    if (ShowSQLCode in IBDataBaseErrorMessages) or
-       (ShowSQLMessage in IBDataBaseErrorMessages) then
-      usr_msg := usr_msg + CRLF;
-    while (isc_interprete(local_buffer, @status_vector) > 0) do
-    begin
-      if (usr_msg <> '') and (usr_msg[Length(usr_msg)] <> LF) then
-        usr_msg := usr_msg + CRLF;
-      usr_msg := usr_msg + strpas(local_buffer);
-    end;
-  end;
-  if (usr_msg <> '') and (usr_msg[Length(usr_msg)] = '.') then
-    Delete(usr_msg, Length(usr_msg), 1);
-  raise EIBInterBaseError.Create(sqlcode, IBErrorCode, usr_msg);
-end;
-
-{ Return the status vector for the current thread }
-function StatusVector: PISC_STATUS;
-begin
-  result := @FStatusVector;
-end;
-
-function StatusVectorArray: PStatusVector;
-begin
-  result := @FStatusVector;
-end;
-
-function CheckStatusVector(ErrorCodes: array of ISC_STATUS): Boolean;
-var
-  p: PISC_STATUS;
-  i: Integer;
-  procedure NextP(i: Integer);
-  begin
-    p := PISC_STATUS(PChar(p) + (i * SizeOf(ISC_STATUS)));
-  end;
-begin
-  p := @FStatusVector;
-  result := False;
-  while (p^ <> 0) and (not result) do
-    case p^ of
-      3: NextP(3);
-      1, 4:
-      begin
-        NextP(1);
-        i := 0;
-        while (i <= High(ErrorCodes)) and (not result) do
-        begin
-          result := p^ = ErrorCodes[i];
-          Inc(i);
-        end;
-        NextP(1);
-      end;
-      else
-        NextP(2);
-    end;
-end;
-
-function StatusVectorAsText: string;
-var
-  p: PISC_STATUS;
-  function NextP(i: Integer): PISC_STATUS;
-  begin
-    p := PISC_STATUS(PChar(p) + (i * SizeOf(ISC_STATUS)));
-    result := p;
-  end;
-begin
-  p := @FStatusVector;
-  result := '';
-  while (p^ <> 0) do
-    if (p^ = 3) then
-    begin
-      result := result + Format('%d %d %d', [p^, NextP(1)^, NextP(1)^]) + CRLF;
-      NextP(1);
-    end
-    else begin
-      result := result + Format('%d %d', [p^, NextP(1)^]) + CRLF;
-      NextP(1);
-    end;
-end;
-
-
-{ EIBError }
-constructor EIBError.Create(ASQLCode: Long; Msg: string);
-begin
-  inherited Create(Msg);
-  FSQLCode := ASQLCode;
-end;
-
-constructor EIBError.Create(ASQLCode: Long; AIBErrorCode: Long; Msg: string);
-begin
-  inherited Create(Msg);
-  FSQLCode :=  ASQLCode;
-  FIBErrorCode := AIBErrorCode;
-end;
-
-procedure SetIBDataBaseErrorMessages(Value: TIBDataBaseErrorMessages);
-begin
-  EnterCriticalSection(IBCS);
-  try
-    IBDataBaseErrorMessages := Value;
-  finally
-    LeaveCriticalSection(IBCS);
-  end;
-end;
-
-function GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
-begin
-  EnterCriticalSection(IBCS);
-  try
-    result := IBDataBaseErrorMessages;
-  finally
-    LeaveCriticalSection(IBCS);
-  end;
-end;
-
-initialization
-//  IsMultiThread := True;
-  InitCriticalSection(IBCS);
-  IBDataBaseErrorMessages := [ShowSQLMessage, ShowIBMessage];
-
-finalization
-  DoneCriticalSection(IBCS);
-
-end.
+{************************************************************************}
+{                                                                        }
+{       Borland Delphi Visual Component Library                          }
+{       InterBase Express core components                                }
+{                                                                        }
+{       Copyright (c) 1998-2000 Inprise Corporation                      }
+{                                                                        }
+{    InterBase Express is based in part on the product                   }
+{    Free IB Components, written by Gregory H. Deatz for                 }
+{    Hoagland, Longo, Moran, Dunst & Doukas Company.                     }
+{    Free IB Components is used under license.                           }
+{                                                                        }
+{    The contents of this file are subject to the InterBase              }
+{    Public License Version 1.0 (the "License"); you may not             }
+{    use this file except in compliance with the License. You            }
+{    may obtain a copy of the License at http://www.Inprise.com/IPL.html }
+{    Software distributed under the License is distributed on            }
+{    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
+{    express or implied. See the License for the specific language       }
+{    governing rights and limitations under the License.                 }
+{    The Original Code was created by InterBase Software Corporation     }
+{       and its successors.                                              }
+{    Portions created by Inprise Corporation are Copyright (C) Inprise   }
+{       Corporation. All Rights Reserved.                                }
+{    Contributor(s): Jeff Overcash                                       }
+{                                                                        }
+{    IBX For Lazarus (Firebird Express)                                  }
+{    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
+{    Portions created by MWA Software are copyright McCallum Whyman      }
+{    Associates Ltd 2011                                                 }
+{                                                                        }
+{************************************************************************}
+
+unit IB;
+
+{$Mode Delphi}
+
+interface
+
+uses
+{$IFDEF WINDOWS }
+  Windows,
+{$ELSE}
+  unix,
+{$ENDIF}
+  SysUtils, Classes, IBExternals, IBUtils, DB, IBXConst;
+
+type
+  TTraceFlag = (tfQPrepare, tfQExecute, tfQFetch, tfError, tfStmt, tfConnect,
+     tfTransact, tfBlob, tfService, tfMisc);
+  TTraceFlags = set of TTraceFlag;
+
+  EIBError                  = class(EDatabaseError)
+  private
+    FSQLCode: Long;
+    FIBErrorCode: Long;
+  public
+    constructor Create(ASQLCode: Long; Msg: string); overload;
+    constructor Create(ASQLCode: Long; AIBErrorCode: Long; Msg: string); overload;
+    property SQLCode: Long read FSQLCode;
+    property IBErrorCode: Long read FIBErrorCode;
+  end;
+
+  EIBInterBaseError         = class(EIBError);
+  EIBClientError            = class(EIBError);
+
+  TIBDataBaseErrorMessage    = (ShowSQLCode,
+                                ShowIBMessage,
+                                ShowSQLMessage);
+  TIBDataBaseErrorMessages   = set of TIBDataBaseErrorMessage;
+  TIBClientError            = (
+    ibxeUnknownError,
+    ibxeInterBaseMissing,
+    ibxeInterBaseInstallMissing,
+    ibxeIB60feature,
+    ibxeNotSupported,
+    ibxeNotPermitted,
+    ibxeFileAccessError,
+    ibxeConnectionTimeout,
+    ibxeCannotSetDatabase,
+    ibxeCannotSetTransaction,
+    ibxeOperationCancelled,
+    ibxeDPBConstantNotSupported,
+    ibxeDPBConstantUnknown,
+    ibxeTPBConstantNotSupported,
+    ibxeTPBConstantUnknown,
+    ibxeDatabaseClosed,
+    ibxeDatabaseOpen,
+    ibxeDatabaseNameMissing,
+    ibxeNotInTransaction,
+    ibxeInTransaction,
+    ibxeTimeoutNegative,
+    ibxeNoDatabasesInTransaction,
+    ibxeUpdateWrongDB,
+    ibxeUpdateWrongTR,
+    ibxeDatabaseNotAssigned,
+    ibxeTransactionNotAssigned,
+    ibxeXSQLDAIndexOutOfRange,
+    ibxeXSQLDANameDoesNotExist,
+    ibxeEOF,
+    ibxeBOF,
+    ibxeInvalidStatementHandle,
+    ibxeSQLOpen,
+    ibxeSQLClosed,
+    ibxeDatasetOpen,
+    ibxeDatasetClosed,
+    ibxeUnknownSQLDataType,
+    ibxeInvalidColumnIndex,
+    ibxeInvalidParamColumnIndex,
+    ibxeInvalidDataConversion,
+    ibxeColumnIsNotNullable,
+    ibxeBlobCannotBeRead,
+    ibxeBlobCannotBeWritten,
+    ibxeEmptyQuery,
+    ibxeCannotOpenNonSQLSelect,
+    ibxeNoFieldAccess,
+    ibxeFieldReadOnly,
+    ibxeFieldNotFound,
+    ibxeNotEditing,
+    ibxeCannotInsert,
+    ibxeCannotPost,
+    ibxeCannotUpdate,
+    ibxeCannotDelete,
+    ibxeCannotRefresh,
+    ibxeBufferNotSet,
+    ibxeCircularReference,
+    ibxeSQLParseError,
+    ibxeUserAbort,
+    ibxeDataSetUniDirectional,
+    ibxeCannotCreateSharedResource,
+    ibxeWindowsAPIError,
+    ibxeColumnListsDontMatch,
+    ibxeColumnTypesDontMatch,
+    ibxeCantEndSharedTransaction,
+    ibxeFieldUnsupportedType,
+    ibxeCircularDataLink,
+    ibxeEmptySQLStatement,
+    ibxeIsASelectStatement,
+    ibxeRequiredParamNotSet,
+    ibxeNoStoredProcName,
+    ibxeIsAExecuteProcedure,
+    ibxeUpdateFailed,
+    ibxeNotCachedUpdates,
+    ibxeNotLiveRequest,
+    ibxeNoProvider,
+    ibxeNoRecordsAffected,
+    ibxeNoTableName,
+    ibxeCannotCreatePrimaryIndex,
+    ibxeCannotDropSystemIndex,
+    ibxeTableNameMismatch,
+    ibxeIndexFieldMissing,
+    ibxeInvalidCancellation,
+    ibxeInvalidEvent,
+    ibxeMaximumEvents,
+    ibxeNoEventsRegistered,
+    ibxeInvalidQueueing,
+    ibxeInvalidRegistration,
+    ibxeInvalidBatchMove,
+    ibxeSQLDialectInvalid,
+    ibxeSPBConstantNotSupported,
+    ibxeSPBConstantUnknown,
+    ibxeServiceActive,
+    ibxeServiceInActive,
+    ibxeServerNameMissing,
+    ibxeQueryParamsError,
+    ibxeStartParamsError,
+    ibxeOutputParsingError,
+    ibxeUseSpecificProcedures,
+    ibxeSQLMonitorAlreadyPresent,
+    ibxeCantPrintValue,
+    ibxeEOFReached,
+    ibxeEOFInComment,
+    ibxeEOFInString,
+    ibxeParamNameExpected,
+    ibxeSuccess,
+    ibxeDelphiException,
+    ibxeNoOptionsSet,
+    ibxeNoDestinationDirectory,
+    ibxeNosourceDirectory,
+    ibxeNoUninstallFile,
+    ibxeOptionNeedsClient,
+    ibxeOptionNeedsServer,
+    ibxeInvalidOption,
+    ibxeInvalidOnErrorResult,
+    ibxeInvalidOnStatusResult,
+    ibxeDPBConstantUnknownEx,
+    ibxeTPBConstantUnknownEx,
+    ibxeSV5APIError,
+    ibxeThreadFailed,
+    ibxeFieldSizeError
+    );
+
+  TStatusVector              = array[0..19] of ISC_STATUS;
+  PStatusVector              = ^TStatusVector;
+
+
+const
+  IBPalette1 = 'Firebird'; {do not localize}
+  IBPalette2 = 'Firebird Admin'; {do not localize}
+
+  IBLocalBufferLength = 512;
+  IBBigLocalBufferLength = IBLocalBufferLength * 2;
+  IBHugeLocalBufferLength = IBBigLocalBufferLength * 20;
+
+  IBErrorMessages: array[TIBClientError] of string = (
+    SUnknownError,
+    SInterBaseMissing,
+    SInterBaseInstallMissing,
+    SIB60feature,
+    SNotSupported,
+    SNotPermitted,
+    SFileAccessError,
+    SConnectionTimeout,
+    SCannotSetDatabase,
+    SCannotSetTransaction,
+    SOperationCancelled,
+    SDPBConstantNotSupported,
+    SDPBConstantUnknown,
+    STPBConstantNotSupported,
+    STPBConstantUnknown,
+    SDatabaseClosed,
+    SDatabaseOpen,
+    SDatabaseNameMissing,
+    SNotInTransaction,
+    SInTransaction,
+    STimeoutNegative,
+    SNoDatabasesInTransaction,
+    SUpdateWrongDB,
+    SUpdateWrongTR,
+    SDatabaseNotAssigned,
+    STransactionNotAssigned,
+    SXSQLDAIndexOutOfRange,
+    SXSQLDANameDoesNotExist,
+    SEOF,
+    SBOF,
+    SInvalidStatementHandle,
+    SSQLOpen,
+    SSQLClosed,
+    SDatasetOpen,
+    SDatasetClosed,
+    SUnknownSQLDataType,
+    SInvalidColumnIndex,
+    SInvalidParamColumnIndex,
+    SInvalidDataConversion,
+    SColumnIsNotNullable,
+    SBlobCannotBeRead,
+    SBlobCannotBeWritten,
+    SEmptyQuery,
+    SCannotOpenNonSQLSelect,
+    SNoFieldAccess,
+    SFieldReadOnly,
+    SFieldNotFound,
+    SNotEditing,
+    SCannotInsert,
+    SCannotPost,
+    SCannotUpdate,
+    SCannotDelete,
+    SCannotRefresh,
+    SBufferNotSet,
+    SCircularReference,
+    SSQLParseError,
+    SUserAbort,
+    SDataSetUniDirectional,
+    SCannotCreateSharedResource,
+    SWindowsAPIError,
+    SColumnListsDontMatch,
+    SColumnTypesDontMatch,
+    SCantEndSharedTransaction,
+    SFieldUnsupportedType,
+    SCircularDataLink,
+    SEmptySQLStatement,
+    SIsASelectStatement,
+    SRequiredParamNotSet,
+    SNoStoredProcName,
+    SIsAExecuteProcedure,
+    SUpdateFailed,
+    SNotCachedUpdates,
+    SNotLiveRequest,
+    SNoProvider,
+    SNoRecordsAffected,
+    SNoTableName,
+    SCannotCreatePrimaryIndex,
+    SCannotDropSystemIndex,
+    STableNameMismatch,
+    SIndexFieldMissing,
+    SInvalidCancellation,
+    SInvalidEvent,
+    SMaximumEvents,
+    SNoEventsRegistered,
+    SInvalidQueueing,
+    SInvalidRegistration,
+    SInvalidBatchMove,
+    SSQLDialectInvalid,
+    SSPBConstantNotSupported,
+    SSPBConstantUnknown,
+    SServiceActive,
+    SServiceInActive,
+    SServerNameMissing,
+    SQueryParamsError,
+    SStartParamsError,
+    SOutputParsingError,
+    SUseSpecificProcedures,
+    SSQLMonitorAlreadyPresent,
+    SCantPrintValue,
+    SEOFReached,
+    SEOFInComment,
+    SEOFInString,
+    SParamNameExpected,
+    SSuccess,
+    SDelphiException,
+    SNoOptionsSet,
+    SNoDestinationDirectory,
+    SNosourceDirectory,
+    SNoUninstallFile,
+    SOptionNeedsClient,
+    SOptionNeedsServer,
+    SInvalidOption,
+    SInvalidOnErrorResult,
+    SInvalidOnStatusResult,
+    SDPBConstantUnknownEx,
+    STPBConstantUnknownEx,
+    SSV5APIError,
+    SThreadFailed,
+    SFieldSizeError
+  );
+
+var
+  IBCS: TRTLCriticalSection;
+
+procedure IBAlloc(var P; OldSize, NewSize: Integer);
+
+procedure IBError(ErrMess: TIBClientError; const Args: array of const);
+procedure IBDataBaseError;
+
+function StatusVector: PISC_STATUS;
+function StatusVectorArray: PStatusVector;
+function CheckStatusVector(ErrorCodes: array of ISC_STATUS): Boolean;
+function StatusVectorAsText: string;
+
+procedure SetIBDataBaseErrorMessages(Value: TIBDataBaseErrorMessages);
+function GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
+
+implementation
+
+uses
+  IBIntf;
+
+var
+  IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
+threadvar
+  FStatusVector : TStatusVector;
+
+procedure IBAlloc(var P; OldSize, NewSize: Integer);
+var
+  i: Integer;
+begin
+  ReallocMem(Pointer(P), NewSize);
+  for i := OldSize to NewSize - 1 do PChar(P)[i] := #0;
+end;
+
+procedure IBError(ErrMess: TIBClientError; const Args: array of const);
+begin
+  raise EIBClientError.Create(Ord(ErrMess),
+                              Format(IBErrorMessages[ErrMess], Args));
+end;
+
+procedure IBDataBaseError;
+var
+  sqlcode: Long;
+  IBErrorCode: Long;
+  local_buffer: array[0..IBHugeLocalBufferLength - 1] of char;
+  usr_msg: string;
+  status_vector: PISC_STATUS;
+  IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
+begin
+  usr_msg := '';
+
+  { Get a local reference to the status vector.
+    Get a local copy of the IBDataBaseErrorMessages options.
+    Get the SQL error code }
+  status_vector := StatusVector;
+  IBErrorCode := StatusVectorArray[1];
+  IBDataBaseErrorMessages := GetIBDataBaseErrorMessages;
+  sqlcode := isc_sqlcode(status_vector);
+
+  if (ShowSQLCode in IBDataBaseErrorMessages) then
+    usr_msg := usr_msg + 'SQLCODE: ' + IntToStr(sqlcode); {do not localize}
+  Exclude(IBDataBaseErrorMessages, ShowSQLMessage);
+  if (ShowSQLMessage in IBDataBaseErrorMessages) then
+  begin
+    isc_sql_interprete(sqlcode, local_buffer, IBLocalBufferLength);
+    if (ShowSQLCode in IBDataBaseErrorMessages) then
+      usr_msg := usr_msg + CRLF;
+    usr_msg := usr_msg + strpas(local_buffer);
+  end;
+
+  if (ShowIBMessage in IBDataBaseErrorMessages) then
+  begin
+    if (ShowSQLCode in IBDataBaseErrorMessages) or
+       (ShowSQLMessage in IBDataBaseErrorMessages) then
+      usr_msg := usr_msg + CRLF;
+    while (isc_interprete(local_buffer, @status_vector) > 0) do
+    begin
+      if (usr_msg <> '') and (usr_msg[Length(usr_msg)] <> LF) then
+        usr_msg := usr_msg + CRLF;
+      usr_msg := usr_msg + strpas(local_buffer);
+    end;
+  end;
+  if (usr_msg <> '') and (usr_msg[Length(usr_msg)] = '.') then
+    Delete(usr_msg, Length(usr_msg), 1);
+  raise EIBInterBaseError.Create(sqlcode, IBErrorCode, usr_msg);
+end;
+
+{ Return the status vector for the current thread }
+function StatusVector: PISC_STATUS;
+begin
+  result := @FStatusVector;
+end;
+
+function StatusVectorArray: PStatusVector;
+begin
+  result := @FStatusVector;
+end;
+
+function CheckStatusVector(ErrorCodes: array of ISC_STATUS): Boolean;
+var
+  p: PISC_STATUS;
+  i: Integer;
+  procedure NextP(i: Integer);
+  begin
+    p := PISC_STATUS(PChar(p) + (i * SizeOf(ISC_STATUS)));
+  end;
+begin
+  p := @FStatusVector;
+  result := False;
+  while (p^ <> 0) and (not result) do
+    case p^ of
+      3: NextP(3);
+      1, 4:
+      begin
+        NextP(1);
+        i := 0;
+        while (i <= High(ErrorCodes)) and (not result) do
+        begin
+          result := p^ = ErrorCodes[i];
+          Inc(i);
+        end;
+        NextP(1);
+      end;
+      else
+        NextP(2);
+    end;
+end;
+
+function StatusVectorAsText: string;
+var
+  p: PISC_STATUS;
+  function NextP(i: Integer): PISC_STATUS;
+  begin
+    p := PISC_STATUS(PChar(p) + (i * SizeOf(ISC_STATUS)));
+    result := p;
+  end;
+begin
+  p := @FStatusVector;
+  result := '';
+  while (p^ <> 0) do
+    if (p^ = 3) then
+    begin
+      result := result + Format('%d %d %d', [p^, NextP(1)^, NextP(1)^]) + CRLF;
+      NextP(1);
+    end
+    else begin
+      result := result + Format('%d %d', [p^, NextP(1)^]) + CRLF;
+      NextP(1);
+    end;
+end;
+
+
+{ EIBError }
+constructor EIBError.Create(ASQLCode: Long; Msg: string);
+begin
+  inherited Create(Msg);
+  FSQLCode := ASQLCode;
+end;
+
+constructor EIBError.Create(ASQLCode: Long; AIBErrorCode: Long; Msg: string);
+begin
+  inherited Create(Msg);
+  FSQLCode :=  ASQLCode;
+  FIBErrorCode := AIBErrorCode;
+end;
+
+procedure SetIBDataBaseErrorMessages(Value: TIBDataBaseErrorMessages);
+begin
+  EnterCriticalSection(IBCS);
+  try
+    IBDataBaseErrorMessages := Value;
+  finally
+    LeaveCriticalSection(IBCS);
+  end;
+end;
+
+function GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
+begin
+  EnterCriticalSection(IBCS);
+  try
+    result := IBDataBaseErrorMessages;
+  finally
+    LeaveCriticalSection(IBCS);
+  end;
+end;
+
+initialization
+//  IsMultiThread := True;
+  InitCriticalSection(IBCS);
+  IBDataBaseErrorMessages := [ShowSQLMessage, ShowIBMessage];
+
+finalization
+  DoneCriticalSection(IBCS);
+
+end.