mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-05 18:28:51 +01:00
1466 lines
38 KiB
ObjectPascal
1466 lines
38 KiB
ObjectPascal
unit fpodbc;
|
|
|
|
{$mode objfpc}
|
|
{$h+}
|
|
|
|
interface
|
|
|
|
uses odbcsql,SysUtils,Classes;
|
|
|
|
Type
|
|
TDSNTypes = (dtUser,dtSystem,dtBoth);
|
|
TODBCParamType = (ptUnknown,ptInput,ptInputOutput,ptResult,ptOutput,ptRetVal);
|
|
TODBCParamTypes = Set of TODBCParamType;
|
|
|
|
TODBCObject = Class(TComponent)
|
|
Private
|
|
FHandle : SQLHandle;
|
|
FHandleType : SQLSmallint;
|
|
Function GetHandle : SQLHandle;
|
|
function GetHandleAllocated: Boolean;
|
|
function GetExtendedErrorInfo: String;
|
|
Protected
|
|
Function CreateHandle : SQLHandle; Virtual;
|
|
Function ParentHandle : SQLHandle; Virtual;
|
|
Procedure FreeHandle;
|
|
Function CheckODBC(Res : Integer;Msg : String) : Integer;
|
|
Public
|
|
Destructor Destroy; override;
|
|
Property Handle : SQLHandle Read GetHandle;
|
|
Property HandleAllocated : Boolean Read GetHandleAllocated;
|
|
end;
|
|
|
|
TODBCEnvironment = Class(TODBCObject)
|
|
Private
|
|
FODBCBehaviour : Integer;
|
|
procedure SetODBCbehaviour(const Value: Integer);
|
|
function GetNullTerminate: Boolean;
|
|
procedure SetNullTerminate(const Value: Boolean);
|
|
protected
|
|
function CreateHandle: SQLHandle; override;
|
|
Procedure SetIntAttribute(Const Attr,Value : Integer);
|
|
Procedure SetStringAttribute(Const Attr: Integer; Value : String);
|
|
Function GetIntAttribute(Const Attr : Integer) : Integer;
|
|
Function GetStringAttribute(Const Attr : Integer) : String;
|
|
Public
|
|
Constructor Create(Aowner : TComponent);override;
|
|
Function GetDriverNames(List : Tstrings) : Integer;
|
|
Function GetDataSourceNames(List : Tstrings; Types : TDSNTypes;Descriptions : Boolean) : Integer;
|
|
function GetDriverOptions(Driver: String; Options: TStrings): Integer;
|
|
Property ODBCBehaviour : Integer Read FODBCBehaviour Write SetODBCbehaviour;
|
|
Property NullTerminateStrings : Boolean Read GetNullTerminate Write SetNullTerminate;
|
|
end;
|
|
|
|
TConnectionBrowseEvent = Procedure (Sender : TObject;InParams,OutParams : Tstrings) of Object;
|
|
|
|
TODBCConnection = Class(TODBCObject)
|
|
Private
|
|
FActive : Boolean;
|
|
FDriverParams : TStrings;
|
|
FDSN,
|
|
FDriverName,
|
|
FUserName,
|
|
FPassword : String;
|
|
FEnvironMent : TODBCEnvironment;
|
|
FOnBrowseConnection : TConnectionBrowseEvent;
|
|
FWindowHandle : integer;
|
|
FDriverCOmpletion: SQLUSmallInt;
|
|
function GetDriverName: String;
|
|
function GetDriverParams: TStrings;
|
|
procedure SetActive(const Value: Boolean);
|
|
procedure SetDriverName(const Value: String);
|
|
procedure SetDriverParams(const Value: TStrings);
|
|
procedure SetDSN(const Value: String);
|
|
function GetEnvironment: TODBCEnvironMent;
|
|
procedure SetEnvironment(const Value: TODBCEnvironMent);
|
|
Protected
|
|
procedure ConnectToDriver;
|
|
procedure ConnectToDSN;
|
|
Procedure ConnectBrowsing;
|
|
Function ParentHandle : SQLHandle; override;
|
|
Procedure CheckActive;
|
|
Procedure CheckInActive;
|
|
Public
|
|
Constructor Create(Aowner : TComponent);override;
|
|
Destructor Destroy; override;
|
|
Procedure Connect;
|
|
Procedure Disconnect;
|
|
Procedure GetTableNames(S : TStrings; SystemTables : Boolean);
|
|
Procedure GetFieldNames(TableName : String; S : TStrings);
|
|
Procedure GetPrimaryKeyFields(TableName : String; S : TStrings);
|
|
procedure GetProcedureNames(S : TStrings);
|
|
procedure GetProcedureParams(ProcName : String;ParamTypes : TODBCParamTypes; S : TStrings);
|
|
Property DSN : String Read FDSN Write SetDSN;
|
|
Property DriverName : String Read GetDriverName Write SetDriverName;
|
|
Property DriverCompletion : SQLUSmallInt Read FDriverCOmpletion Write FDriverCompletion;
|
|
Property DriverParams : TStrings Read GetDriverParams Write SetDriverParams;
|
|
Property Active : Boolean Read FActive Write SetActive;
|
|
Property Environment : TODBCEnvironMent Read GetEnvironment Write SetEnvironment;
|
|
Property UserName : String Read FUserName Write FUserName;
|
|
Property Password : string Read FPassword Write FPassword;
|
|
Property OnBrowseConnection : TConnectionBrowseEvent Read FonBrowseConnection Write FOnBrowseConnection;
|
|
Property WindowHandle : integer Read FWindowHandle Write FWindowHandle;
|
|
end;
|
|
|
|
TODBCStatement = Class;
|
|
|
|
TODBCFieldList = Class(TCollection)
|
|
Private
|
|
FStatement : TODBCStatement;
|
|
Public
|
|
Constructor Create(Statement : TODBCStatement);
|
|
end;
|
|
|
|
{
|
|
TODBCStatement allocates 1 big data buffer. For each bound field
|
|
two things are allocated in the buffer:
|
|
- Size of fetched data as filled in by fetch.
|
|
- data. (may be zero for blobs etc)
|
|
The FBuffOffset contains the offset in the buffer of the size field.
|
|
Data immediatly follows the size.
|
|
}
|
|
|
|
TODBCField = Class(TCollectionItem)
|
|
Private
|
|
FDecimalDigits,
|
|
FPosition : SQLSmallInt;
|
|
FName : String;
|
|
FSize : SQLUInteger; // Declared size, as returned by DescribeCol
|
|
FNullable : Boolean;
|
|
FDataType : SQLSmallInt; // Declared type, as returned by DescribeCol
|
|
FBuffOffSet : SQLInteger; // Offset in data buffer.
|
|
FBuffer : Pointer; // Pointer to data.
|
|
FBufSize : SQLInteger; // Allocated buffer size.
|
|
FBufType : SQLSmallInt; // Allocated buffer type
|
|
function GetAsString: String;
|
|
function GetData : PChar;
|
|
Function GetIsNull : Boolean;
|
|
Function GetAsInteger : Integer;
|
|
Function GetAsBoolean : Boolean;
|
|
Function GetAsDouble : Double;
|
|
Function GetAsDateTime : TDateTime;
|
|
Public
|
|
Property Position : SQLSmallint Read FPosition;
|
|
Property Name : String read FName;
|
|
Property DataType : SQLSmallInt read FDatatype;
|
|
Property Size : SQLUinteger read FSize;
|
|
property DecimalDigits : SQLSmallInt read FDecimalDigits;
|
|
Property Nullable : Boolean Read FNullable;
|
|
Property Data : Pchar Read GetData;
|
|
Property BufType : SQLSmallInt Read FBufType;
|
|
Property BufSize : SQLInteger Read FBufSize;
|
|
Property IsNull : Boolean Read GetIsNull;
|
|
Property AsString : String Read GetAsString;
|
|
Property AsInteger : Integer Read GetAsInteger;
|
|
Property AsBoolean : Boolean Read GetAsBoolean;
|
|
Property AsDouble : Double Read GetAsDouble;
|
|
Property AsDateTime : TDateTime Read GetAsDateTime;
|
|
end;
|
|
|
|
TODBCStatement = Class(TODBCObject)
|
|
Private
|
|
FBOF,FEOF : Boolean;
|
|
FConnection: TODBCConnection;
|
|
FFields : TODBCFieldList;
|
|
FBuffer : Pointer;
|
|
Protected
|
|
Function ParentHandle : SQLHandle; override;
|
|
procedure SetConnection(const Value: TODBCConnection);
|
|
procedure AllocBuffers;
|
|
Public
|
|
Constructor Create(Aowner : TComponent);override;
|
|
Destructor Destroy; override;
|
|
Procedure BindFields(RestrictList : TStrings);virtual;
|
|
Procedure ClearFields;virtual;
|
|
Function Fetch : Boolean;
|
|
Property Connection : TODBCConnection Read FConnection Write SetConnection;
|
|
Property BOF : Boolean read FBOF;
|
|
Property EOF : Boolean read FEOF;
|
|
Property Fields : TODBCFieldList Read FFields;
|
|
end;
|
|
|
|
TODBCTableList = Class(TODBCStatement)
|
|
Public
|
|
Procedure GetTableNames(S : TStrings; SystemTables : Boolean);
|
|
end;
|
|
|
|
TODBCFieldNamesList = Class(TODBCStatement)
|
|
Public
|
|
Procedure GetFieldNames(TableName : String;S : TStrings);
|
|
end;
|
|
|
|
TODBCPrimaryKeyFieldsList = Class(TODBCStatement)
|
|
Public
|
|
Procedure GetPrimaryKeyFields(TableName : String;S : TStrings);
|
|
end;
|
|
|
|
TODBCProcedureList = Class(TODBCStatement)
|
|
Public
|
|
Procedure GetProcedureList(S : TStrings);
|
|
end;
|
|
|
|
TODBCProcedureParams = Class(TODBCStatement)
|
|
Procedure GetProcedureParams(ProcName: String; ParamTypes: TODBCParamTypes; S: TStrings);
|
|
end;
|
|
|
|
TStatementState = (ssInactive,ssPrepared,ssBound,ssOpen);
|
|
|
|
TODBCSQLStatement = Class(TODBCStatement)
|
|
Private
|
|
FSQL : TStrings;
|
|
FState : TStatementState;
|
|
function GetActive: Boolean;
|
|
procedure SetActive(const Value: Boolean);
|
|
Protected
|
|
procedure FreeStatement(Option: SQLUSMALLINT);
|
|
procedure ExecuteDirect;
|
|
procedure ExecutePrepared;
|
|
Procedure SetSQL(const Value: TStrings);
|
|
Public
|
|
Constructor Create(Aowner : TComponent);override;
|
|
Destructor Destroy; override;
|
|
procedure Prepare;
|
|
procedure Unprepare;
|
|
Procedure BindFields(RestrictList : TStrings);override;
|
|
procedure ExecSQL;
|
|
Procedure Open;
|
|
Procedure Close;
|
|
procedure GetFieldList(List: TStrings);
|
|
Property Active : Boolean Read GetActive Write SetActive;
|
|
Property SQL : TStrings Read FSQL Write SetSQL;
|
|
end;
|
|
|
|
EODBCError = Class(Exception);
|
|
|
|
Const
|
|
ODBCParamTypeNames : Array [TODBCParamType] of string
|
|
= ('Unknown','Input','Input/Output','Result','Output','RetVal');
|
|
|
|
Function DefaultEnvironment : TODBCEnvironment;
|
|
|
|
implementation
|
|
|
|
{ TODBCObject }
|
|
|
|
resourcestring
|
|
SErrUnexpected = 'Unexpected ODBC error:';
|
|
SErrEnvironmentHandle = 'Cannot allocate environment handle:';
|
|
SErrInvalidBehaviour = 'Invalid value for ODBC behaviour: %d';
|
|
SErrNotConnected = 'Operation invalid when not connected.';
|
|
SErrConnected = 'Operation invalid when connected.';
|
|
SNeedDSNOrDriver = 'Cannot connect with empty DSN and driver names.';
|
|
SErrGettingDataSources = 'Error getting datasources:';
|
|
SErrGettingDriverNames = 'Error getting driver names:';
|
|
SErrGettingDriverOptions = 'Error getting driver options:';
|
|
SErrSettingEnvAttribute = 'Error setting environment attribute:';
|
|
SErrGettingEnvAttribute = 'Error Getting environment attribute:';
|
|
SErrBrowseConnecting = 'Error connecting to datasource via browse:';
|
|
SErrDSNConnect = 'Error connecting to DSN:';
|
|
SErrDriverConnect = 'Error connecting to driver:';
|
|
SErrDisconnecting = 'Error disconnecting:';
|
|
SErrNoConnectionForStatement = 'Missing connection for statement.';
|
|
SErrNoSQLStatement = 'Missing SQL statement.';
|
|
SErrPreparing = 'Error preparing statement:';
|
|
SErrGettingTableNames = 'Error getting table names:';
|
|
SErrFetchingData = 'Error fetching data:';
|
|
SErrFieldNames = 'Error getting field names:';
|
|
SErrPrimaryKeys = 'Error getting primary key names:';
|
|
SErrProcedureNames = 'Error getting procedure names:';
|
|
SErrExecuting = 'Error while executing statement:';
|
|
SErrExecutingPrepared = 'Error while executing prepared statement:';
|
|
SErrNotPrepared = 'Statement is not prepared';
|
|
SErrNotInactive = 'Statement is already prepared or executed.';
|
|
SErrStatementActive = 'A statement is still active';
|
|
SErrColumnCount = 'Error retrieving cilumn count:';
|
|
SErrColDescription = 'Error retrieving column description';
|
|
SErrInvalidConversion = 'invalid type conversion';
|
|
SErrBindCol = 'Error binding column';
|
|
Const
|
|
ODBCSuccess = [SQL_SUCCESS,SQL_SUCCESS_WITH_INFO];
|
|
|
|
Procedure ODBCError (Msg : String);
|
|
|
|
begin
|
|
Raise EODBCError.Create(Msg);
|
|
end;
|
|
|
|
Procedure ODBCErrorFmt (Fmt : String;Args : Array of const);
|
|
|
|
begin
|
|
Raise EODBCError.CreateFmt(Fmt,Args);
|
|
end;
|
|
|
|
Function CheckODBC(Res : Integer;Msg : String) : Integer;
|
|
|
|
begin
|
|
Result:=Res;
|
|
if not Res in [SQL_SUCCESS,SQL_SUCCESS_WITH_INFO] then
|
|
begin
|
|
If MSG='' then
|
|
MSG:=SErrUnexpected;
|
|
ODBCErrorFmt(msg,[res]);
|
|
end;
|
|
end;
|
|
|
|
function TODBCObject.CheckODBC(Res: Integer; Msg: String): Integer;
|
|
|
|
Var S : String;
|
|
|
|
begin
|
|
Result:=Res;
|
|
if not Res in [SQL_SUCCESS,SQL_SUCCESS_WITH_INFO] then
|
|
begin
|
|
If MSG='' then
|
|
MSG:=SErrUnexpected;
|
|
S:=GetExtendedErrorInfo;
|
|
If S<>'' then
|
|
Msg:=Msg+LineEnding+S;
|
|
ODBCError(msg);
|
|
end;
|
|
end;
|
|
|
|
function TODBCObject.GetExtendedErrorInfo : String;
|
|
|
|
Var
|
|
Res : SQLreturn;
|
|
I,MsgLen : SQLSmallInt;
|
|
SQLState : Array[0..6] of Char;
|
|
NativeError : SQLInteger;
|
|
MSg : Array[0..SQL_MAX_MESSAGE_LENGTH] of Char;
|
|
SState,SMsg : String;
|
|
|
|
begin
|
|
I:=0;
|
|
Result:='';
|
|
Repeat
|
|
Inc(i);
|
|
Res:=SQLGetDiagRec(FhandleType, FHandle, i, SqlState, NativeError,
|
|
Msg, sizeof(Msg), MsgLen);
|
|
If Res<>SQL_NO_DATA then
|
|
begin
|
|
SState:=SQLState;
|
|
SMsg:=Msg;
|
|
If Length(Result)>0 then
|
|
Result:=Result+LineEnding;
|
|
Result:=Result+Format('[%s] : %s (%d)',[SState,SMsg,NativeError]);
|
|
end;
|
|
Until (Res=SQL_NO_DATA);
|
|
end;
|
|
|
|
|
|
|
|
|
|
function TODBCObject.CreateHandle: SQLHandle;
|
|
begin
|
|
{$ifdef debug}
|
|
Writeln(Classname,': Creating handle of type ',FHAndleType,' and parent ',ParentHandle);
|
|
{$endif}
|
|
CheckODBC(SQLAllocHandle(FHandleType,ParentHandle,FHandle),SErrEnvironmentHandle);
|
|
Result:=FHandle;
|
|
end;
|
|
|
|
|
|
destructor TODBCObject.Destroy;
|
|
begin
|
|
If FHandle<>0 then
|
|
FreeHandle;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TODBCObject.FreeHandle;
|
|
begin
|
|
If FHandle<>0 then
|
|
begin
|
|
SQLFreeHandle(FHandleType,FHandle);
|
|
FHandle:=0;
|
|
end;
|
|
end;
|
|
|
|
function TODBCObject.GetHandle: SQLHandle;
|
|
begin
|
|
If FHandle=0 then
|
|
CreateHandle;
|
|
Result:=FHandle;
|
|
end;
|
|
|
|
function TODBCObject.GetHandleAllocated: Boolean;
|
|
begin
|
|
Result:=(FHandle<>0)
|
|
end;
|
|
|
|
function TODBCObject.ParentHandle: SQLHandle;
|
|
begin
|
|
Result:=SQL_NULL_HANDLE;
|
|
end;
|
|
|
|
{ TODBCEnvironment }
|
|
|
|
constructor TODBCEnvironment.Create(Aowner: TComponent);
|
|
begin
|
|
FHandleType:=SQL_HANDLE_ENV;
|
|
inherited;
|
|
end;
|
|
|
|
function TODBCEnvironment.CreateHandle: SQLHandle;
|
|
begin
|
|
Result:=Inherited CreateHandle;
|
|
ODBCbehaviour:=SQL_OV_ODBC3;
|
|
end;
|
|
|
|
function TODBCEnvironment.GetDataSourceNames(List: Tstrings;
|
|
Types: TDSNTypes;Descriptions : Boolean): Integer;
|
|
|
|
var
|
|
DSNName,
|
|
DSNDesc: array[0..SQL_MAX_OPTION_STRING_LENGTH] of Char;
|
|
lenn,lend : SQLSmallInt;
|
|
Dir : SQLSmallInt;
|
|
Sn,SD : String;
|
|
|
|
begin
|
|
Case Types of
|
|
dtSystem : Dir:=SQL_FETCH_FIRST_SYSTEM;
|
|
dtUser : Dir:=SQL_FETCH_FIRST_USER;
|
|
dtBoth : Dir:=SQL_FETCH_FIRST;
|
|
end;
|
|
List.Clear;
|
|
CheckODBC(SQLDatasources(Handle, Dir,
|
|
DSNName,SQL_MAX_OPTION_STRING_LENGTH, @lenn,
|
|
DSNDesc,SQL_MAX_OPTION_STRING_LENGTH, @lend),SErrGettingDataSources);
|
|
Repeat
|
|
If Not Descriptions then
|
|
List.Add(DSNName)
|
|
else
|
|
begin
|
|
SN:=DSNName;
|
|
SD:=DSNDesc;
|
|
List.Add(SN+'='+SD);
|
|
end;
|
|
Until Not (SQLDataSources(Handle, SQL_FETCH_NEXT,
|
|
DSNName, SQL_MAX_OPTION_STRING_LENGTH, @lenn,
|
|
DSNDesc,SQL_MAX_OPTION_STRING_LENGTH, @lend) in ODBCSuccess);
|
|
Result:=List.Count;
|
|
end;
|
|
|
|
function TODBCEnvironment.GetDriverNames(List : Tstrings): Integer;
|
|
|
|
Var
|
|
DriverName: array[0..SQL_MAX_OPTION_STRING_LENGTH] of Char;
|
|
len : SQLSmallInt;
|
|
|
|
begin
|
|
List.Clear;
|
|
CheckODBC(SQLDrivers(Handle, SQL_FETCH_FIRST, DriverName,
|
|
SQL_MAX_OPTION_STRING_LENGTH, @len, Nil,0,Nil),SErrGettingDriverNames);
|
|
Repeat
|
|
List.Add(DriverName);
|
|
Until Not (SQLDrivers(Handle, SQL_FETCH_NEXT, DriverName,
|
|
SQL_MAX_OPTION_STRING_LENGTH, @len, Nil,0,Nil) in ODBCSuccess);
|
|
Result:=List.Count;
|
|
end;
|
|
|
|
function TODBCEnvironment.GetDriverOptions(Driver : String;Options: Tstrings): Integer;
|
|
|
|
Var
|
|
DriverName,
|
|
DriverOptions: array[0..SQL_MAX_OPTION_STRING_LENGTH] of Char;
|
|
lenn,leno : SQLSmallInt;
|
|
Found : Boolean;
|
|
P : PChar;
|
|
S : string;
|
|
|
|
begin
|
|
CheckODBC(SQLDrivers(Handle, SQL_FETCH_FIRST, DriverName,
|
|
SQL_MAX_OPTION_STRING_LENGTH, @lenn, DriverOptions,
|
|
SQL_MAX_OPTION_STRING_LENGTH,@Leno),SErrGettingDriverOptions);
|
|
Result:=0;
|
|
Options.Clear;
|
|
Repeat
|
|
Found:=CompareText(Driver,DriverName)=0;
|
|
If Found then
|
|
begin
|
|
P:=@DriverOptions[0];
|
|
While P[0]<>#0 do
|
|
begin
|
|
S:=StrPas(P);
|
|
options.Add(S);
|
|
Inc(P,Length(S)+1);
|
|
end;
|
|
end;
|
|
Until Not (SQLDrivers(Handle, SQL_FETCH_NEXT, DriverName,
|
|
SQL_MAX_OPTION_STRING_LENGTH, @lenn, DriverOptions,
|
|
SQL_MAX_OPTION_STRING_LENGTH,@Leno) in ODBCSuccess) or Found;
|
|
Result:=Options.Count;
|
|
end;
|
|
|
|
function TODBCEnvironment.GetIntAttribute(const Attr: Integer): Integer;
|
|
begin
|
|
CheckODBC(SQLSetEnvAttr(Handle,Attr,SQLPointer(@result),0),SErrSettingEnvAttribute);
|
|
end;
|
|
|
|
function TODBCEnvironment.GetNullTerminate: Boolean;
|
|
begin
|
|
Result:=(GetIntAttribute(SQL_ATTR_OUTPUT_NTS)=SQL_TRUE);
|
|
end;
|
|
|
|
function TODBCEnvironment.GetStringAttribute(const Attr: Integer): String;
|
|
|
|
Var
|
|
OldLen,Len: Integer;
|
|
|
|
begin
|
|
OldLen:=0;
|
|
Repeat
|
|
Inc(OldLen,255);
|
|
SetLength(Result,OldLen);
|
|
CheckODBC(SQLGetEnvAttr(Handle,Attr,SQLPointer(@result),OldLen,@Len),SErrGettingEnvAttribute);
|
|
until (Len<=OldLen);
|
|
SetLength(Result,Len);
|
|
end;
|
|
|
|
procedure TODBCEnvironment.SetIntAttribute(const Attr, Value: Integer);
|
|
begin
|
|
CheckODBC(SQLSetEnvAttr(Handle,Attr,SQLPointer(Value),0),SErrSettingEnvAttribute);
|
|
end;
|
|
|
|
procedure TODBCEnvironment.SetNullTerminate(const Value: Boolean);
|
|
begin
|
|
If Value then
|
|
SetIntAttribute(SQL_ATTR_OUTPUT_NTS,SQL_TRUE)
|
|
else
|
|
SetIntAttribute(SQL_ATTR_OUTPUT_NTS,SQL_FALSE);
|
|
end;
|
|
|
|
procedure TODBCEnvironment.SetODBCbehaviour(const Value: Integer);
|
|
begin
|
|
If (Value<>FODBCBehaviour) then
|
|
begin
|
|
If Not (Value in [SQL_OV_ODBC3,SQL_OV_ODBC2]) Then
|
|
ODBCErrorFmt(SErrInvalidBehaviour,[Value]);
|
|
SetIntAttribute(SQL_ATTR_ODBC_VERSION,Value);
|
|
FODBCBehaviour := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TODBCEnvironment.SetStringAttribute(const Attr: Integer;
|
|
Value: String);
|
|
begin
|
|
CheckODBC(SQLSetEnvAttr(Handle,Attr,SQLPointer(Value),Length(Value)),SErrSettingEnvAttribute);
|
|
end;
|
|
|
|
{ TODBCConnection }
|
|
|
|
procedure TODBCConnection.CheckActive;
|
|
begin
|
|
If Not FActive then
|
|
ODBCError(SErrNotConnected);
|
|
end;
|
|
|
|
procedure TODBCConnection.CheckInActive;
|
|
begin
|
|
If FActive then
|
|
ODBCError(SErrConnected);
|
|
end;
|
|
|
|
procedure TODBCConnection.Connect;
|
|
begin
|
|
If Not FActive then
|
|
begin
|
|
If Assigned (FonBrowseConnection) then
|
|
ConnectBrowsing
|
|
else If (FDSN<>'') then
|
|
ConnectToDSN
|
|
else if FDriverName<>'' then
|
|
ConnectToDriver
|
|
else
|
|
ODBCError(SNeedDSNOrDriver);
|
|
FActive:=True;
|
|
end;
|
|
end;
|
|
|
|
Function ListToBuf(List : Tstrings; Buf : PChar; Sep : Char; MaxLen : Integer) : Boolean;
|
|
|
|
Var
|
|
P : PChar;
|
|
S : String;
|
|
I,Len : Integer;
|
|
|
|
begin
|
|
P:=Buf;
|
|
I:=0;
|
|
Result:=True;
|
|
While Result and (I<List.Count) do
|
|
begin
|
|
S:=List[i];
|
|
If I<List.Count-1 then
|
|
S:=S+Sep;
|
|
Len:=Length(S);
|
|
Result:=(Longint(P-Buf)+Len)<=MaxLen;
|
|
If Result then
|
|
begin
|
|
Move(S[1],P^,Len);
|
|
Inc(P,Len);
|
|
end;
|
|
Inc(i);
|
|
end;
|
|
P[0]:=#0;
|
|
end;
|
|
|
|
Function BufToList(Buf : PChar;MaxLen : Integer;List : Tstrings;Sep : Char) : Integer;
|
|
|
|
Var
|
|
S : String;
|
|
P : PChar;
|
|
Totlen,Len : Integer;
|
|
|
|
begin
|
|
List.Clear;
|
|
Result:=0;
|
|
P:=Buf;
|
|
TotLen:=0;
|
|
While (P[0]<>#0) or (totlen<Maxlen) do
|
|
begin
|
|
Len:=0;
|
|
While Not (P[len] in [Sep,#0]) do
|
|
Inc(len);
|
|
SetLength(S,Len);
|
|
List.Add(S);
|
|
Move(P[0],S[1],Len);
|
|
Inc(P,Len);
|
|
If P[0]<>#0 then
|
|
Inc(P,1);
|
|
inc(Totlen,Len+1);
|
|
end;
|
|
Result:=List.Count;
|
|
end;
|
|
|
|
|
|
Procedure TODBCConnection.ConnectBrowsing;
|
|
|
|
Var
|
|
Inlist,OutList : TStringList;
|
|
InStr,
|
|
OutStr: Array[0..SQL_MAX_OPTION_STRING_LENGTH] of Char;
|
|
i,Res : Integer;
|
|
olen : SQLSmallint;
|
|
|
|
begin
|
|
InList:=TStringList.Create;
|
|
OutList:=TstringList.Create;
|
|
try
|
|
If FDSN<>'' then
|
|
InList.Add('DSN='+FDSN)
|
|
else If FDriverName<>'' then
|
|
begin
|
|
Inlist.Add('DRIVER='+FDriverName);
|
|
For I:=0 to DriverParams.Count-1 do
|
|
Inlist.Add(DriverParams[i]);
|
|
end;
|
|
Repeat
|
|
ListToBuf(Inlist,Instr,';',SQL_MAX_OPTION_STRING_LENGTH);
|
|
Res:=SQLBrowseConnect(Handle,Instr,SQL_NTS,Outstr,SQL_MAX_OPTION_STRING_LENGTH,Olen);
|
|
If RES=SQL_NEED_DATA then
|
|
begin
|
|
OutList.Clear;
|
|
BufToList(OutStr,Olen,OutList,';');
|
|
FOnBrowseConnection(Self,InList,OutList);
|
|
end
|
|
Until (Res<>SQL_NEED_DATA);
|
|
CheckODBC(Res,SErrBrowseConnecting);
|
|
Finally
|
|
Outlist.free;
|
|
InList.Free;
|
|
end;
|
|
end;
|
|
|
|
Procedure TODBCConnection.ConnectToDSN;
|
|
begin
|
|
CheckODBC(SQLConnect(Handle,PSQLChar(FDSN),SQL_NTS,
|
|
PSQLChar(FUserName),SQL_NTS,
|
|
PSQLChar(FPassword),SQL_NTS),SErrDSNConnect);
|
|
end;
|
|
|
|
|
|
Procedure TODBCConnection.ConnectToDriver;
|
|
|
|
Var
|
|
Instr,
|
|
OutStr : Array[0..SQL_MAX_OPTION_STRING_LENGTH] of Char;
|
|
OLen : SQLSmallint;
|
|
InList : TStringList;
|
|
|
|
begin
|
|
InList:=TStringList.Create;
|
|
Try
|
|
Inlist.Assign(DriverParams);
|
|
Inlist.Insert(0,'DRIVER={'+DRIVERNAME+'}');
|
|
ListToBuf(Inlist,InStr,';',SQL_MAX_OPTION_STRING_LENGTH);
|
|
Finally
|
|
Inlist.Free;
|
|
end;
|
|
CheckODBC(SQLDriverConnect(Handle,FWindowHandle,
|
|
Instr,SQL_NTS,
|
|
OutStr,SQL_MAX_OPTION_STRING_LENGTH,
|
|
Olen,FDriverCompletion),SErrDriverConnect);
|
|
end;
|
|
|
|
constructor TODBCConnection.Create(Aowner: TComponent);
|
|
begin
|
|
inherited;
|
|
FHandleType:=SQL_HANDLE_DBC;
|
|
FDriverParams:=TStringList.Create;
|
|
FDriverCompletion:=SQL_DRIVER_NOPROMPT;
|
|
end;
|
|
|
|
destructor TODBCConnection.Destroy;
|
|
begin
|
|
Disconnect;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TODBCConnection.Disconnect;
|
|
begin
|
|
If FActive then
|
|
begin
|
|
CheckODBC(SQLDisconnect(Handle),SErrDisconnecting);
|
|
Factive:=False;
|
|
end;
|
|
end;
|
|
|
|
function TODBCConnection.GetDriverName: String;
|
|
begin
|
|
Result:=FDriverName;
|
|
end;
|
|
|
|
function TODBCConnection.GetDriverParams: TStrings;
|
|
begin
|
|
Result:=FDriverParams;
|
|
end;
|
|
|
|
function TODBCConnection.GetEnvironment: TODBCEnvironMent;
|
|
begin
|
|
If FEnvironment=Nil then
|
|
result:=DefaultEnvironment
|
|
else
|
|
Result:=FEnvironment;
|
|
end;
|
|
|
|
procedure TODBCConnection.SetActive(const Value: Boolean);
|
|
begin
|
|
If Value then
|
|
Connect
|
|
else
|
|
Disconnect;
|
|
end;
|
|
|
|
procedure TODBCConnection.SetDriverName(const Value: String);
|
|
begin
|
|
CheckInactive;
|
|
FDSN:='';
|
|
If CompareText(FDriverName,Value)<>0 then
|
|
begin
|
|
FDriverName:=Value;
|
|
FDriverParams.Clear;
|
|
end;
|
|
end;
|
|
|
|
procedure TODBCConnection.SetDriverParams(const Value: TStrings);
|
|
begin
|
|
CheckInactive;
|
|
FDriverParams.Assign(Value);
|
|
end;
|
|
|
|
procedure TODBCConnection.SetDSN(const Value: String);
|
|
begin
|
|
CheckInactive;
|
|
FDSN := Value;
|
|
end;
|
|
|
|
procedure TODBCConnection.SetEnvironment(const Value: TODBCEnvironMent);
|
|
begin
|
|
CheckInactive;
|
|
If (Value<>Environment) then // !! may be defaultenvironment...
|
|
begin
|
|
If HandleAllocated then
|
|
FreeHandle;
|
|
FEnvironment:=Value
|
|
end;
|
|
end;
|
|
|
|
|
|
function TODBCConnection.ParentHandle: SQLHandle;
|
|
begin
|
|
Result:=Environment.Handle
|
|
end;
|
|
|
|
Const
|
|
DefEnv : Pointer = Nil;
|
|
|
|
Function DefaultEnvironment : TODBCEnvironment;
|
|
|
|
begin
|
|
If DefEnv=Nil then
|
|
DefEnv:=TODBCEnvironment.Create(Nil);
|
|
Result:=TODBCEnvironment(DefEnv);
|
|
end;
|
|
|
|
procedure TODBCConnection.GetTableNames(S: TStrings;
|
|
SystemTables: Boolean);
|
|
begin
|
|
With TODBCTableList.Create(Self) do
|
|
try
|
|
GetTableNames(S,SystemTables);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TODBCConnection.GetFieldNames(TableName: String; S: TStrings);
|
|
begin
|
|
With TODBCFieldNamesList.Create(Self) do
|
|
try
|
|
GetFieldNames(TableName,S);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TODBCConnection.GetPrimaryKeyFields(TableName: String;
|
|
S: TStrings);
|
|
begin
|
|
With TODBCPrimaryKeyFieldsList.Create(Self) do
|
|
try
|
|
GetPrimaryKeyFields(TableName,S);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TODBCConnection.GetProcedureNames(S: TStrings);
|
|
begin
|
|
With TODBCProcedureList.Create(Self) do
|
|
try
|
|
GetProcedureList(S);
|
|
Finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TODBCConnection.GetProcedureParams(ProcName: String;
|
|
ParamTypes: TODBCParamTypes; S: TStrings);
|
|
begin
|
|
With TODBCProcedureParams.Create(Self) do
|
|
Try
|
|
GetProcedureParams(ProcName,Paramtypes,S);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
{ TODBCStatement }
|
|
|
|
Type
|
|
TODBCFieldBufRec = Record
|
|
T{ype} : SQlSmallint;
|
|
B{ufsize} : SQLInteger;
|
|
{Buftyp}e : SQLSmallint;
|
|
end;
|
|
|
|
Const
|
|
BufDescrCount = 26;
|
|
BufDescr : Array[1..BufDescrCount] of TODBCFieldBufRec =
|
|
{ Type Bufsize Buftype }
|
|
(
|
|
(T:SQL_CHAR ;b:-1 ;e: SQL_CHAR),
|
|
(T:SQL_NUMERIC ;b:sizeof(SQLDouble) ;e: SQL_DOUBLE),
|
|
(T:SQL_DECIMAL ;b:sizeof(SQLDouble) ;e: SQL_DOUBLE),
|
|
(T:SQL_INTEGER ;b:sizeof(SQLInteger) ;e: SQL_INTEGER),
|
|
(T:SQL_SMALLINT ;b:sizeof(SQLSmallInt) ;e: SQL_SMALLINT),
|
|
(T:SQL_FLOAT ;b:sizeof(SQLDOUBLE) ;e: SQL_DOUBLE),
|
|
(T:SQL_REAL ;b:sizeof(SQLDOUBLE) ;e: SQL_DOUBLE),
|
|
(T:SQL_DOUBLE ;b:Sizeof(SQLDOUBLE) ;e: SQL_DOUBLE),
|
|
(T:SQL_DATE ;b:Sizeof(SQL_DATE_STRUCT) ;e: SQL_DATE),
|
|
(T:SQL_TIME ;b:sizeof(SQL_TIME_STRUCT) ;e: SQL_TIME),
|
|
(T:SQL_TIMESTAMP ;b:sizeof(SQL_TIMESTAMP_STRUCT) ;e: SQL_TIMESTAMP),
|
|
(T:SQL_VARCHAR ;b:-1 ;e: SQL_CHAR),
|
|
(T:SQL_UNKNOWN_TYPE ;b:0 ;e: SQL_UNKNOWN_TYPE),
|
|
(T:SQL_LONGVARCHAR ;b:-1 ;e: SQL_CHAR),
|
|
(T:SQL_BINARY ;b:-2 ;e: SQL_BINARY),
|
|
(T:SQL_VARBINARY ;b:-2 ;e: SQL_BINARY),
|
|
(T:SQL_LONGVARBINARY ;b:-2 ;e: SQL_BINARY),
|
|
(T:SQL_BIGINT ;b:sizeOf(SQLDOUBLE) ;e: SQL_DOUBLE),
|
|
(T:SQL_TINYINT ;b:Sizeof(SQLSMALLINT) ;e: SQL_SMALLINT),
|
|
(T:SQL_BIT ;b:sizeof(SQL_CHAR) ;e: SQL_BIT),
|
|
(T:SQL_WCHAR ;b:-1 ;e: SQL_CHAR),
|
|
(T:SQL_WVARCHAR ;b:-1 ;e: SQL_CHAR),
|
|
(T:SQL_WLONGVARCHAR ;b:-1 ;e: SQL_CHAR),
|
|
(T:SQL_TYPE_DATE ;b:sizeof(SQL_DATE_STRUCT) ;e: SQL_TYPE_DATE),
|
|
(T:SQL_TYPE_TIME ;b:sizeof(SQL_TIME_STRUCT) ;e: SQL_TYPE_TIME),
|
|
(T:SQL_TYPE_TIMESTAMP;b:sizeof(SQL_TIMESTAMP_STRUCT) ;e: SQL_TYPE_TIMESTAMP)
|
|
);
|
|
{ // template
|
|
(T: ;b: ;e: ),
|
|
}
|
|
|
|
Function GetColSizeBufType (Coltype: SQLSmallint;
|
|
Var BufSize : SQLInteger;
|
|
Var BufType : SQLSmallInt) : Boolean;
|
|
Var
|
|
I : Integer;
|
|
|
|
begin
|
|
I:=0;
|
|
BufSize:=0;
|
|
BufType:=0;
|
|
While (I<=BufDescrCount) and (BufDescr[i].t<>Coltype) do
|
|
Inc(i);
|
|
Result:=(i<=BufDescrCount);
|
|
If Result then
|
|
begin
|
|
BufSize:=BufDescr[i].b;
|
|
BufType:=BufDescr[i].e;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TODBCStatement.BindFields(RestrictList : TStrings);
|
|
|
|
Var
|
|
Count: SQLSmallInt;
|
|
CName : Array[0..SQL_NAME_LEN] of Char;
|
|
CSize : SQLUINTEGER;
|
|
CDataType,CDecimals,CNullable,CNameLen: SQLSmallInt;
|
|
I : integer;
|
|
|
|
begin
|
|
CheckODBC(SQLNumResultCols(Handle,Count),SErrColumnCount);
|
|
For I:=1 to Count do
|
|
begin
|
|
CheckODBC(SQLDescribeCol(Handle,i,CName,SQL_NAME_LEN,CNameLen,
|
|
CdataType,CSize, CDecimals,CNullable)
|
|
,SErrColDescription);
|
|
If Not Assigned(RestrictList) or (RestrictList.IndexOf(Cname)<>-1) then
|
|
With FFields.Add as TODBCField do
|
|
begin
|
|
FPosition:=I;
|
|
FName:=Cname;
|
|
FDataType:=CDataType;
|
|
FSize:=CSize;
|
|
FDecimalDigits:=CDecimals;
|
|
FNullable:=(CNullable=SQL_TRUE);
|
|
GetColsizeBufType(FDataType,FBufSize,FBufType);
|
|
If FBufSize=-1 then
|
|
FBufSize:=FSize;
|
|
end;
|
|
end;
|
|
AllocBuffers;
|
|
For I:=0 to Count-1 do
|
|
With FFields.Items[i] as TODBCField do
|
|
CheckODBC(SQLBindCol(Handle,FPosition,FBufType,GetData,FBufSize,FBuffer+FBuffOffset)
|
|
,SErrBindCol);
|
|
|
|
end;
|
|
|
|
procedure TODBCStatement.ClearFields;
|
|
begin
|
|
FFields.Clear;
|
|
end;
|
|
|
|
constructor TODBCStatement.Create(Aowner: TComponent);
|
|
begin
|
|
FHandleType:=SQL_HANDLE_STMT;
|
|
inherited;
|
|
If AOwner is TODBCConnection then
|
|
Connection:=TODBCConnection(Aowner);
|
|
FFields:=TODBCFieldList.Create(Self);
|
|
end;
|
|
|
|
function TODBCStatement.ParentHandle: SQLHandle;
|
|
begin
|
|
If (Connection=Nil) then
|
|
ODBCError(SErrNoConnectionForStatement);
|
|
Result:=Connection.Handle;
|
|
end;
|
|
|
|
procedure TODBCStatement.SetConnection(const Value: TODBCConnection);
|
|
begin
|
|
If Value<>FConnection then
|
|
begin
|
|
If HandleAllocated then
|
|
FreeHandle;
|
|
FConnection := Value;
|
|
end;
|
|
end;
|
|
|
|
Function TODBCStatement.fetch : Boolean;
|
|
|
|
Var
|
|
res : SQLReturn;
|
|
|
|
begin
|
|
Res:=SQLFetch(Handle);
|
|
Result:=(Res=SQL_SUCCESS);
|
|
If Not Result and (Res<>SQL_NO_DATA) then
|
|
CheckODBC(Res,SErrFetchingData);
|
|
FBof:=False;
|
|
If (Res=SQL_NO_DATA) then
|
|
FEOF:=True;
|
|
end;
|
|
|
|
destructor TODBCStatement.Destroy;
|
|
begin
|
|
FFields.Free;
|
|
inherited;
|
|
end;
|
|
|
|
{ TODBCSQLStatement }
|
|
|
|
procedure TODBCSQLStatement.GetFieldList(List : TStrings);
|
|
|
|
Var
|
|
Count: SQLSmallInt;
|
|
CName : Array[0..SQL_NAME_LEN] of Char;
|
|
CSize : SQLUINTEGER;
|
|
CDataType,CDecimals,CNullable,CNameLen: SQLSmallInt;
|
|
I : integer;
|
|
|
|
begin
|
|
if Not (FState in [ssPrepared,ssBound,ssOpen]) then
|
|
ODBCError(SErrNotPrepared);
|
|
List.Clear;
|
|
CheckODBC(SQLNumResultCols(Handle,Count),SErrColumnCount);
|
|
For I:=1 to Count do
|
|
begin
|
|
CheckODBC(SQLDescribeCol(Handle,i,CName,SQL_NAME_LEN,CNameLen,
|
|
CdataType,CSize, CDecimals,CNullable)
|
|
,SErrColDescription);
|
|
List.Add(CName);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TODBCSQLStatement.Unprepare;
|
|
|
|
begin
|
|
Case FState of
|
|
ssBound,ssOpen :
|
|
begin
|
|
ClearFields;
|
|
FreeStatement(SQL_CLOSE);
|
|
end;
|
|
ssPrepared : begin
|
|
FreeStatement(SQL_CLOSE);
|
|
end;
|
|
end;
|
|
FState:=ssInactive;
|
|
end;
|
|
|
|
procedure TODBCSQLStatement.FreeStatement(Option : SQLUSMALLINT);
|
|
|
|
begin
|
|
SQLFreeStmt(Handle,SQL_CLOSE);
|
|
end;
|
|
|
|
procedure TODBCSQLStatement.Close;
|
|
begin
|
|
if FState<>ssInactive then
|
|
begin
|
|
Unprepare;
|
|
FreeStatement(SQL_CLOSE);
|
|
FState:=ssInactive;
|
|
end;
|
|
end;
|
|
|
|
constructor TODBCSQLStatement.Create(Aowner: TComponent);
|
|
begin
|
|
inherited;
|
|
FSQL:=TStringList.Create;
|
|
end;
|
|
|
|
destructor TODBCSQLStatement.Destroy;
|
|
begin
|
|
if FState=ssOpen then
|
|
Close
|
|
else If FState<>ssInactive then
|
|
Unprepare;
|
|
FSQL.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TODBCSQLStatement.ExecSQL;
|
|
begin
|
|
Case FState of
|
|
ssPrepared,ssBound : ExecutePrepared;
|
|
ssInactive : ExecuteDirect;
|
|
else
|
|
Raise Exception.Create(SErrStatementActive)
|
|
end;
|
|
end;
|
|
|
|
procedure TODBCSQLStatement.ExecuteDirect;
|
|
|
|
Var
|
|
S : String;
|
|
|
|
begin
|
|
if FState<>ssInactive then
|
|
ODBCError(SErrStatementActive);
|
|
S:=SQL.Text;
|
|
CheckODBC(SQLExecDirect(Handle,PChar(S),SQL_NTS),SErrExecuting);
|
|
end;
|
|
|
|
procedure TODBCSQLStatement.ExecutePrepared;
|
|
begin
|
|
if Not (FState in [ssPrepared,ssBound]) then
|
|
ODBCError(SErrNotPrepared);
|
|
CheckODBC(SQLExecute(Handle),SErrExecutingPrepared);
|
|
end;
|
|
|
|
function TODBCSQLStatement.GetActive: Boolean;
|
|
begin
|
|
Result:=(FState=ssOpen);
|
|
end;
|
|
|
|
procedure TODBCSQLStatement.Open;
|
|
begin
|
|
if (FState<>ssOpen) then
|
|
begin
|
|
Writeln('Preparing');
|
|
If FState=ssInactive then
|
|
Prepare;
|
|
Writeln('Bind fields');
|
|
if FState=ssPrepared then
|
|
BindFields(Nil);
|
|
Writeln('Executing');
|
|
ExecSQL;
|
|
Writeln('Fetching');
|
|
If FState=ssBound then
|
|
Fetch;
|
|
FState:=ssOpen;
|
|
FBOF:=True;
|
|
end;
|
|
end;
|
|
|
|
procedure TODBCSQLStatement.Prepare;
|
|
|
|
Var
|
|
S : String;
|
|
|
|
begin
|
|
If FState<>ssInactive then
|
|
ODBCError(SErrNotInactive);
|
|
If (FSQL.Count=0) then
|
|
ODBCError(SErrNoSQLStatement);
|
|
S:=FSQL.Text;
|
|
CheckODBC(SQLPrepare(Handle,PChar(S),SQL_NTS),SErrPreparing);
|
|
FState:=ssPrepared;
|
|
end;
|
|
|
|
procedure TODBCSQLStatement.SetActive(const Value: Boolean);
|
|
begin
|
|
If Value then
|
|
Open
|
|
else
|
|
Close;
|
|
end;
|
|
|
|
procedure TODBCSQLStatement.SetSQL(const Value: TStrings);
|
|
|
|
begin
|
|
FSQL.Assign(Value);
|
|
end;
|
|
|
|
|
|
procedure TODBCSQLStatement.BindFields(RestrictList: TStrings);
|
|
begin
|
|
inherited;
|
|
FState:=ssBound;
|
|
end;
|
|
|
|
|
|
procedure TODBCStatement.AllocBuffers;
|
|
|
|
Var
|
|
I,TotalSize,AddSize : Integer;
|
|
|
|
begin
|
|
TotalSize:=0;
|
|
For i:=0 to FFields.Count-1 do
|
|
With (FFields.Items[i] as TODBCField) do
|
|
begin
|
|
AddSize:=FBufSize;
|
|
If FBufSize=-2 then // Blob.
|
|
AddSize:=0
|
|
else if FBufSize=-1 then
|
|
AddSize:=FSize+1; // some Char variant.
|
|
// Store offset temporarily in FData
|
|
FBuffOffset:=TotalSize;
|
|
Inc(TotalSize,AddSize+SizeOf(SQLinteger));
|
|
end;
|
|
FBuffer:=GetMem(TotalSize);
|
|
TotalSize:=0;
|
|
For i:=0 to FFields.Count-1 do
|
|
With (FFields.Items[i] as TODBCField) do
|
|
FBuffer:=Self.FBuffer;
|
|
end;
|
|
|
|
{ TODBCTableList }
|
|
|
|
procedure TODBCTableList.GetTableNames(S: TStrings; SystemTables : Boolean);
|
|
|
|
var
|
|
TName,
|
|
TType: array[0..SQL_NAME_LEN+1] of char;
|
|
NL,TL: SQLINTEGER;
|
|
Res: SQLRETURN;
|
|
|
|
begin
|
|
S.Clear;
|
|
Res:=CheckODBC(SQLTables(handle, nil,0,nil,0,nil,0,nil,0),SErrGettingTableNames);
|
|
if Res=SQL_SUCCESS then
|
|
begin
|
|
// Must bind by colno, because names changed between ODBC 2.0 and 3.0 !!
|
|
SQLBindCol(handle,3,SQL_CHAR,@TName,SQL_NAME_LEN,@NL);
|
|
SQLBindCol(handle,4,SQL_CHAR,@TType,SQL_NAME_LEN,@TL);
|
|
While Fetch do
|
|
if SystemTables or (CompareText(TType,'SYSTEM TABLE')<>0) then
|
|
S.Add(TName);
|
|
end;
|
|
end;
|
|
|
|
{ TODBCFieldNamesList }
|
|
|
|
procedure TODBCFieldNamesList.GetFieldNames(TableName: String;
|
|
S: TStrings);
|
|
|
|
var
|
|
FName : array[0..SQL_NAME_LEN+1] of char;
|
|
NF : SQLINTEGER;
|
|
Res: SQLRETURN;
|
|
|
|
begin
|
|
S.Clear;
|
|
Res:=CheckODBC(SQLColumns(handle, nil, 0, nil, 0, pchar(TableName), SQL_NTS, nil, 0),SErrFieldNames);
|
|
if Res=SQL_SUCCESS then
|
|
begin
|
|
SQLBindCol(handle, 4, SQL_CHAR, @FNAme, SQL_NAME_LEN, @NF);
|
|
While Fetch do
|
|
S.Add(FName);
|
|
end;
|
|
end;
|
|
|
|
{ TODBCPrimaryKeyFieldsList }
|
|
|
|
procedure TODBCPrimaryKeyFieldsList.GetPrimaryKeyFields(TableName: String;
|
|
S: TStrings);
|
|
var
|
|
FName : array[0..SQL_NAME_LEN+1] of char;
|
|
NF : SQLINTEGER;
|
|
Res: SQLRETURN;
|
|
|
|
begin
|
|
S.Clear;
|
|
Res:=CheckODBC(SQLPrimaryKeys(handle, nil, 0, nil, 0, pchar(TableName), SQL_NTS),SErrPrimaryKeys);
|
|
if Res=SQL_SUCCESS then
|
|
begin
|
|
SQLBindCol(handle, 4, SQL_CHAR, @FNAme, SQL_NAME_LEN, @NF);
|
|
While Fetch do
|
|
S.Add(FName);
|
|
end;
|
|
|
|
end;
|
|
|
|
{ TODBCProcedureList }
|
|
|
|
procedure TODBCProcedureList.GetProcedureList(S: TStrings);
|
|
|
|
var
|
|
PName : array[0..SQL_NAME_LEN+1] of char;
|
|
NP : SQLINTEGER;
|
|
Res: SQLRETURN;
|
|
|
|
begin
|
|
S.Clear;
|
|
Res:=CheckODBC(SQLProcedures(handle, nil, 0, nil, 0, Nil, 0),SErrProcedureNames);
|
|
if Res=SQL_SUCCESS then
|
|
begin
|
|
SQLBindCol(handle, 3, SQL_CHAR, @PNAme, SQL_NAME_LEN, @NP);
|
|
While Fetch do
|
|
S.Add(PName);
|
|
end;
|
|
|
|
end;
|
|
|
|
{ TODBCProcedureParams }
|
|
|
|
procedure TODBCProcedureParams.GetProcedureParams(ProcName: String;
|
|
ParamTypes: TODBCParamTypes; S: TStrings);
|
|
|
|
var
|
|
PName : array[0..SQL_NAME_LEN+1] of char;
|
|
NP,NT : SQLINTEGER;
|
|
Ptype : SQLSmallInt;
|
|
Res: SQLRETURN;
|
|
|
|
begin
|
|
S.Clear;
|
|
Res:=CheckODBC(SQLProcedureColumns(handle, nil, 0, nil, 0, PChar(ProcName),SQL_NTS,Nil, 0),SErrProcedureNames);
|
|
if Res=SQL_SUCCESS then
|
|
begin
|
|
SQLBindCol(handle, 4, SQL_CHAR, @PName, SQL_NAME_LEN, @NP);
|
|
SQLBindCol(handle, 5, SQL_SMALLINT, @PType, SizeOf(SQLSmallInt), @NT);
|
|
While Fetch do
|
|
begin
|
|
If TODBCParamType(PType) in ParamTypes then
|
|
S.Add(PName);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TODBCFieldList }
|
|
|
|
constructor TODBCFieldList.Create(Statement: TODBCStatement);
|
|
begin
|
|
FStatement:=Statement;
|
|
Inherited Create(TODBCField);
|
|
end;
|
|
|
|
{ TODBCField }
|
|
|
|
function TODBCField.GetAsString: String;
|
|
begin
|
|
If IsNull then
|
|
Result:=''
|
|
else
|
|
Case FBufType of
|
|
SQL_Smallint : Result:=IntToStr(PSQLSmallInt(Data)^);
|
|
SQL_Integer : Result:=IntToStr(PSQLINTEGER(Data)^);
|
|
SQL_BIT : Result:=IntToStr(PByte(Data)^);
|
|
SQL_CHAR : Result:=StrPas(Data);
|
|
SQL_DOUBLE : Result:=FloatToStr(GetAsDouble);
|
|
SQL_DATE : result:=DateToStr(AsDateTime);
|
|
SQL_TIME : Result:=TimeToStr(AsDateTime);
|
|
SQL_TIMESTAMP : result:=datetimeToStr(AsDateTime);
|
|
SQL_TYPE_DATE : result:=dateToStr(AsDateTime);
|
|
SQL_TYPE_TIMESTAMP : result:=datetimeToStr(AsDateTime);
|
|
SQL_TYPE_TIME : Result:=TimeToStr(AsDateTime);
|
|
else
|
|
ODBCError(SErrInvalidConversion)
|
|
end;
|
|
end;
|
|
|
|
function TODBCField.GetData : Pchar;
|
|
|
|
begin
|
|
Result:=FBuffer+FBuffOffset+SizeOf(SQLinteger);
|
|
end;
|
|
|
|
function TODBCField.GetIsNull : boolean;
|
|
|
|
begin
|
|
Result:=PSQLinteger(FBuffer+FBuffOffset)^=SQL_NULL_DATA;
|
|
end;
|
|
|
|
Function TODBCField.GetAsInteger : Integer;
|
|
|
|
begin
|
|
If IsNull then
|
|
Result:=0
|
|
else
|
|
Case FBufType of
|
|
SQL_Smallint : Result:=PSQLSmallInt(Data)^;
|
|
SQL_Integer : Result:=PSQLINTEGER(Data)^;
|
|
SQL_BIT : Result:=PByte(Data)^;
|
|
SQL_CHAR : Result:=StrToInt(GetAsString);
|
|
SQL_DOUBLE : Result:=Round(GetAsDouble);
|
|
SQL_DATE,
|
|
SQL_TIME,
|
|
SQL_TIMESTAMP,
|
|
SQL_TYPE_DATE,
|
|
SQL_TYPE_TIMESTAMP,
|
|
SQL_TYPE_TIME : Result:=Round(AsDateTime);
|
|
else
|
|
ODBCError(SErrInvalidConversion)
|
|
end;
|
|
end;
|
|
|
|
Function TODBCField.GetAsBoolean : Boolean;
|
|
|
|
begin
|
|
If IsNull then
|
|
Result:=False
|
|
else
|
|
Case FBufType of
|
|
SQL_Smallint : Result:=PSQLSmallInt(Data)^=0;
|
|
SQL_Integer : Result:=PSQLINTEGER(Data)^=0;
|
|
SQL_BIT : Result:=PBYTE(Data)^=0;
|
|
SQL_CHAR : Result:=(StrToInt(GetAsString)=0);
|
|
SQL_DOUBLE : Result:=Round(GetAsDouble)=0;
|
|
SQL_DATE,
|
|
SQL_TIME,
|
|
SQL_TIMESTAMP,
|
|
SQL_TYPE_DATE,
|
|
SQL_TYPE_TIMESTAMP,
|
|
SQL_TYPE_TIME : Result:=Round(AsDateTime)=0;
|
|
else
|
|
ODBCError(SErrInvalidConversion)
|
|
end;
|
|
end;
|
|
|
|
Function TODBCField.GetAsDouble : Double;
|
|
|
|
begin
|
|
If IsNull then
|
|
Result:=0
|
|
else
|
|
Case FBufType of
|
|
SQL_Smallint : Result:=PSQLSmallInt(Data)^;
|
|
SQL_Integer : Result:=PSQLINTEGER(Data)^;
|
|
SQL_BIT : Result:=PBYTE(Data)^;
|
|
SQL_CHAR : Result:=StrToFloat(GetAsString);
|
|
SQL_DOUBLE : Result:=PSQLDOUBLE(GetData)^;
|
|
SQL_DATE,
|
|
SQL_TIME,
|
|
SQL_TIMESTAMP,
|
|
SQL_TYPE_DATE,
|
|
SQL_TYPE_TIMESTAMP,
|
|
SQL_TYPE_TIME : Result:=AsDateTime;
|
|
else
|
|
ODBCError(SErrInvalidConversion)
|
|
end;
|
|
end;
|
|
|
|
{
|
|
function DateStructToDateTime( b:PSQL_DATE_STRUCT):TDateTime;
|
|
function DateTimeToDateStruct( b:TDateTime):SQL_DATE_STRUCT;
|
|
procedure DateTime2TimeStampStruct( var Value:SQL_TIMESTAMP_STRUCT; b:TDateTime);
|
|
}
|
|
Function TODBCField.GetAsDateTime : TDateTime;
|
|
|
|
begin
|
|
If IsNull then
|
|
Result:=0
|
|
else
|
|
Case FBufType of
|
|
SQL_Smallint : Result:=PSQLSmallInt(Data)^;
|
|
SQL_Integer : Result:=PSQLINTEGER(Data)^;
|
|
SQL_BIT : Result:=PBYTE(Data)^;
|
|
SQL_CHAR : Result:=StrToInt(GetAsString);
|
|
SQL_DOUBLE : Result:=PSQLDOUBLE(GetData)^;
|
|
SQL_DATE : Result:=DateStructToDateTime(PSQL_DATE_STRUCT(Data));
|
|
SQL_TIME : Result:=TimeStructToDateTime(PSQL_TIME_STRUCT(Data));
|
|
SQL_TIMESTAMP : Result:=TimeStampStructToDateTime(PSQL_TIMESTAMP_STRUCT(Data));
|
|
SQL_TYPE_DATE : Result:=DateStructToDateTime(PSQL_DATE_STRUCT(Data));
|
|
SQL_TYPE_TIMESTAMP : Result:=TimeStampStructToDateTime(PSQL_TIMESTAMP_STRUCT(Data));
|
|
SQL_TYPE_TIME : Result:=TimeStructToDateTime(PSQL_TIME_STRUCT(Data));
|
|
else
|
|
ODBCError(SErrInvalidConversion)
|
|
end;
|
|
end;
|
|
|
|
Finalization
|
|
If Assigned(DefEnv) then
|
|
TODBCEnvironment(DefEnv).Free;
|
|
end.
|
|
|