paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-22 03:39:32 +01:00
Code Issues Packages Projects Releases Wiki Activity

* fixed for 64 bit targets

Browse Source 
git-svn-id: trunk@1622 -
This commit is contained in:
florian 2005-11-01 22:11:59 +00:00
parent 7bff61ce29
commit 81bf59a638
1 changed files with 33 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
fcl/db/sqldb/odbc/odbcconn.pas
View File

@ -17,7 +17,7 @@ interface
uses uses
Classes, SysUtils, sqldb, db, odbcsql; Classes, SysUtils, sqldb, db, odbcsql;
type type
// forward declarations // forward declarations
@ -35,13 +35,13 @@ type
constructor Create(Connection:TODBCConnection); constructor Create(Connection:TODBCConnection);
destructor Destroy; override; destructor Destroy; override;
end; end;
{ TODBCHandle } // this name is a bit confusing, but follows the standards for naming classes in sqldb { TODBCHandle } // this name is a bit confusing, but follows the standards for naming classes in sqldb
TODBCHandle = class(TSQLHandle) TODBCHandle = class(TSQLHandle)
protected protected
end; end;
{ TODBCEnvironment } { TODBCEnvironment }
TODBCEnvironment = class TODBCEnvironment = class
@ -61,7 +61,7 @@ type
FEnvironment:TODBCEnvironment; FEnvironment:TODBCEnvironment;
FDBCHandle:SQLHDBC; // ODBC Connection Handle FDBCHandle:SQLHDBC; // ODBC Connection Handle
FFileDSN: string; FFileDSN: string;
procedure SetParameters(ODBCCursor:TODBCCursor; AParams:TParams); procedure SetParameters(ODBCCursor:TODBCCursor; AParams:TParams);
procedure FreeParamBuffers(ODBCCursor:TODBCCursor); procedure FreeParamBuffers(ODBCCursor:TODBCCursor);
protected protected
@ -96,7 +96,7 @@ type
procedure UpdateIndexDefs(var IndexDefs:TIndexDefs; TableName:string); override; procedure UpdateIndexDefs(var IndexDefs:TIndexDefs; TableName:string); override;
// - Schema info // - Schema info
function GetSchemaInfoSQL(SchemaType:TSchemaType; SchemaObjectName, SchemaObjectPattern:string):string; override; function GetSchemaInfoSQL(SchemaType:TSchemaType; SchemaObjectName, SchemaObjectPattern:string):string; override;
// Internal utility functions // Internal utility functions
function CreateConnectionString:string; function CreateConnectionString:string;
public public
@ -119,7 +119,7 @@ type
property Params; // will be added to connection string property Params; // will be added to connection string
property OnLogin; property OnLogin;
end; end;
EODBCException = class(Exception) EODBCException = class(Exception)
// currently empty; perhaps we can add fields here later that describe the error instead of one simple message string // currently empty; perhaps we can add fields here later that describe the error instead of one simple message string
end; end;
@ -132,7 +132,7 @@ uses
const const
DefaultEnvironment:TODBCEnvironment = nil; DefaultEnvironment:TODBCEnvironment = nil;
ODBCLoadCount:integer = 0; // ODBC is loaded when > 0; modified by TODBCEnvironment.Create/Destroy ODBCLoadCount:integer = 0; // ODBC is loaded when > 0; modified by TODBCEnvironment.Create/Destroy
{ Generic ODBC helper functions } { Generic ODBC helper functions }
function ODBCSucces(const Res:SQLRETURN):boolean; function ODBCSucces(const Res:SQLRETURN):boolean;
@ -167,7 +167,7 @@ begin
CheckSQLGetDiagResult(Res); CheckSQLGetDiagResult(Res);
if ODBCSucces(LastReturnCode) then if ODBCSucces(LastReturnCode) then
Exit; // no error; all is ok Exit; // no error; all is ok
// build TotalMessage for exception to throw // build TotalMessage for exception to throw
TotalMessage:=Format('%s ODBC error details:',[ErrorMsg]); TotalMessage:=Format('%s ODBC error details:',[ErrorMsg]);
// retrieve status records // retrieve status records
@ -219,7 +219,7 @@ function TODBCConnection.CreateConnectionString: string;
else else
Result:=s; Result:=s;
end; end;
var var
i: Integer; i: Integer;
Param: string; Param: string;
@ -321,7 +321,9 @@ end;
function TODBCConnection.GetHandle: pointer; function TODBCConnection.GetHandle: pointer;
begin begin
// I'm not sure whether this is correct; perhaps we should return nil // I'm not sure whether this is correct; perhaps we should return nil
Result:=pointer(FDBCHandle); // note that FDBHandle is a LongInt, because ODBC handles are integers, not pointers // note that FDBHandle is a LongInt, because ODBC handles are integers, not pointers
// I wonder how this will work on 64 bit platforms then (FK)
Result:=pointer(PtrInt(FDBCHandle));
end; end;
procedure TODBCConnection.DoInternalConnect; procedure TODBCConnection.DoInternalConnect;
@ -333,7 +335,7 @@ var
ActualLength:SQLSMALLINT; ActualLength:SQLSMALLINT;
begin begin
inherited DoInternalConnect; inherited DoInternalConnect;
// make sure we have an environment // make sure we have an environment
if not Assigned(FEnvironment) then if not Assigned(FEnvironment) then
begin begin
@ -341,7 +343,7 @@ begin
DefaultEnvironment:=TODBCEnvironment.Create; DefaultEnvironment:=TODBCEnvironment.Create;
FEnvironment:=DefaultEnvironment; FEnvironment:=DefaultEnvironment;
end; end;
// allocate connection handle // allocate connection handle
SQLAllocHandle(SQL_HANDLE_DBC,Environment.FENVHandle,FDBCHandle); SQLAllocHandle(SQL_HANDLE_DBC,Environment.FENVHandle,FDBCHandle);
ODBCCheckResult(SQL_HANDLE_ENV,Environment.FENVHandle,'Could not allocate ODBC Connection handle.'); ODBCCheckResult(SQL_HANDLE_ENV,Environment.FENVHandle,'Could not allocate ODBC Connection handle.');
@ -367,11 +369,11 @@ end;
procedure TODBCConnection.DoInternalDisconnect; procedure TODBCConnection.DoInternalDisconnect;
begin begin
inherited DoInternalDisconnect; inherited DoInternalDisconnect;
// disconnect // disconnect
SQLDisconnect(FDBCHandle); SQLDisconnect(FDBCHandle);
ODBCCheckResult(SQL_HANDLE_DBC,FDBCHandle,'Could not disconnect.'); ODBCCheckResult(SQL_HANDLE_DBC,FDBCHandle,'Could not disconnect.');
// deallocate connection handle // deallocate connection handle
if SQLFreeHandle(SQL_HANDLE_DBC, FDBCHandle)=SQL_ERROR then if SQLFreeHandle(SQL_HANDLE_DBC, FDBCHandle)=SQL_ERROR then
ODBCCheckResult(SQL_HANDLE_DBC,FDBCHandle,'Could not free connection handle.'); ODBCCheckResult(SQL_HANDLE_DBC,FDBCHandle,'Could not free connection handle.');
@ -414,7 +416,7 @@ var
NewQueryIndex,BufIndex,CopyLen,i:integer; NewQueryIndex,BufIndex,CopyLen,i:integer;
begin begin
ODBCCursor:=cursor as TODBCCursor; ODBCCursor:=cursor as TODBCCursor;
// Parameter handling // Parameter handling
// Note: We can only pass ? parameters to ODBC, so we should convert named parameters like :MyID // Note: We can only pass ? parameters to ODBC, so we should convert named parameters like :MyID
// ODBCCursor.FParamIndex will map th i-th ? token in the (modified) query to an index for AParams // ODBCCursor.FParamIndex will map th i-th ? token in the (modified) query to an index for AParams
@ -484,7 +486,7 @@ begin
SetLength(ParamPart,NewLength); SetLength(ParamPart,NewLength);
SetLength(ODBCCursor.FParamIndex,NewLength); SetLength(ODBCCursor.FParamIndex,NewLength);
end; end;
if p^=':' then if p^=':' then
begin // find parameter name begin // find parameter name
Inc(p); Inc(p);
@ -499,7 +501,7 @@ begin
ParamNameStart:=p; ParamNameStart:=p;
ParamName:=''; ParamName:='';
end; end;
// find ParameterIndex // find ParameterIndex
if ParamName<>'' then if ParamName<>'' then
begin begin
@ -512,12 +514,12 @@ begin
ParameterIndex:=QuestionMarkParamCount; ParameterIndex:=QuestionMarkParamCount;
Inc(QuestionMarkParamCount); Inc(QuestionMarkParamCount);
end; end;
// store ParameterIndex in FParamIndex, ParamPart data // store ParameterIndex in FParamIndex, ParamPart data
ODBCCursor.FParamIndex[ParamCount-1]:=ParameterIndex; ODBCCursor.FParamIndex[ParamCount-1]:=ParameterIndex;
ParamPart[ParamCount-1].Start:=ParamNameStart-BufStart; ParamPart[ParamCount-1].Start:=ParamNameStart-BufStart;
ParamPart[ParamCount-1].Stop:=p-BufStart+1; ParamPart[ParamCount-1].Stop:=p-BufStart+1;
// update NewQueryLength // update NewQueryLength
Dec(NewQueryLength,p-ParamNameStart); Dec(NewQueryLength,p-ParamNameStart);
end; end;
@ -529,7 +531,7 @@ begin
SetLength(ParamPart,ParamCount); SetLength(ParamPart,ParamCount);
SetLength(ODBCCursor.FParamIndex,ParamCount); SetLength(ODBCCursor.FParamIndex,ParamCount);
if ParamCount>0 then if ParamCount>0 then
begin begin
// replace :ParamName by ? (using ParamPart array and NewQueryLength) // replace :ParamName by ? (using ParamPart array and NewQueryLength)
@ -550,11 +552,11 @@ begin
end end
else else
NewQuery:=buf; NewQuery:=buf;
// prepare statement // prepare statement
SQLPrepare(ODBCCursor.FSTMTHandle, PChar(NewQuery), Length(NewQuery)); SQLPrepare(ODBCCursor.FSTMTHandle, PChar(NewQuery), Length(NewQuery));
ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not prepare statement.'); ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not prepare statement.');
ODBCCursor.FQuery:=NewQuery; ODBCCursor.FQuery:=NewQuery;
end; end;
@ -599,14 +601,14 @@ var
Res:SQLRETURN; Res:SQLRETURN;
begin begin
ODBCCursor:=cursor as TODBCCursor; ODBCCursor:=cursor as TODBCCursor;
// set parameters // set parameters
SetParameters(ODBCCursor, AParams); SetParameters(ODBCCursor, AParams);
// execute the statement // execute the statement
Res:=SQLExecute(ODBCCursor.FSTMTHandle); Res:=SQLExecute(ODBCCursor.FSTMTHandle);
ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not execute statement.'); ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not execute statement.');
// free parameter buffers // free parameter buffers
FreeParamBuffers(ODBCCursor); FreeParamBuffers(ODBCCursor);
end; end;
@ -617,12 +619,12 @@ var
Res:SQLRETURN; Res:SQLRETURN;
begin begin
ODBCCursor:=cursor as TODBCCursor; ODBCCursor:=cursor as TODBCCursor;
// fetch new row // fetch new row
Res:=SQLFetch(ODBCCursor.FSTMTHandle); Res:=SQLFetch(ODBCCursor.FSTMTHandle);
if Res<>SQL_NO_DATA then if Res<>SQL_NO_DATA then
ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not fetch new row from result set'); ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not fetch new row from result set');
// result is true iff a new row was available // result is true iff a new row was available
Result:=Res<>SQL_NO_DATA; Result:=Res<>SQL_NO_DATA;
end; end;
@ -637,7 +639,7 @@ var
DateTime:TDateTime; DateTime:TDateTime;
begin begin
ODBCCursor:=cursor as TODBCCursor; ODBCCursor:=cursor as TODBCCursor;
// load the field using SQLGetData // load the field using SQLGetData
// Note: optionally we can implement the use of SQLBindCol later for even more speed // Note: optionally we can implement the use of SQLBindCol later for even more speed
// TODO: finish this // TODO: finish this
@ -716,7 +718,7 @@ var
FieldSize:word; FieldSize:word;
begin begin
ODBCCursor:=cursor as TODBCCursor; ODBCCursor:=cursor as TODBCCursor;
// get number of columns in result set // get number of columns in result set
SQLNumResultCols(ODBCCursor.FSTMTHandle, ColumnCount); SQLNumResultCols(ODBCCursor.FSTMTHandle, ColumnCount);
ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not determine number of columns in result set.'); ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not determine number of columns in result set.');
@ -752,7 +754,7 @@ begin
nil); // no numerical output nil); // no numerical output
ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, Format('Could not get column name for column %d.',[i])); ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, Format('Could not get column name for column %d.',[i]));
end; end;
// convert type // convert type
// NOTE: I made some guesses here after I found only limited information about TFieldType; please report any problems // NOTE: I made some guesses here after I found only limited information about TFieldType; please report any problems
case DataType of case DataType of
@ -826,7 +828,7 @@ begin
// allocate environment handle // allocate environment handle
if SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, FENVHandle)=SQL_Error then if SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, FENVHandle)=SQL_Error then
raise EODBCException.Create('Could not allocate ODBC Environment handle'); // we can't retrieve any more information, because we don't have a handle for the SQLGetDiag* functions raise EODBCException.Create('Could not allocate ODBC Environment handle'); // we can't retrieve any more information, because we don't have a handle for the SQLGetDiag* functions
// set odbc version // set odbc version
SQLSetEnvAttr(FENVHandle, SQL_ATTR_ODBC_VERSION, SQLPOINTER(SQL_OV_ODBC3), 0); SQLSetEnvAttr(FENVHandle, SQL_ATTR_ODBC_VERSION, SQLPOINTER(SQL_OV_ODBC3), 0);
ODBCCheckResult(SQL_HANDLE_ENV, FENVHandle,'Could not set ODBC version to 3.'); ODBCCheckResult(SQL_HANDLE_ENV, FENVHandle,'Could not set ODBC version to 3.');
@ -855,7 +857,7 @@ end;
destructor TODBCCursor.Destroy; destructor TODBCCursor.Destroy;
begin begin
inherited Destroy; inherited Destroy;
// deallocate statement handle // deallocate statement handle
if SQLFreeHandle(SQL_HANDLE_STMT, FSTMTHandle)=SQL_ERROR then if SQLFreeHandle(SQL_HANDLE_STMT, FSTMTHandle)=SQL_ERROR then
ODBCCheckResult(SQL_HANDLE_STMT, FSTMTHandle, 'Could not free ODBC Statement handle.'); ODBCCheckResult(SQL_HANDLE_STMT, FSTMTHandle, 'Could not free ODBC Statement handle.');