mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-20 13:49:40 +02:00
+ Initial implementation in FCL
This commit is contained in:
parent
b856a450bd
commit
80a5033038
2
fcl/db/interbase/BUGS.known
Normal file
2
fcl/db/interbase/BUGS.known
Normal file
@ -0,0 +1,2 @@
|
|||||||
|
* TDateTime field interpretation
|
||||||
|
* Some problems with TIBDataset.Close (fields)
|
1218
fcl/db/interbase/Makefile
Normal file
1218
fcl/db/interbase/Makefile
Normal file
File diff suppressed because it is too large
Load Diff
22
fcl/db/interbase/Makefile.fpc
Normal file
22
fcl/db/interbase/Makefile.fpc
Normal file
@ -0,0 +1,22 @@
|
|||||||
|
#
|
||||||
|
# Makefile.fpc for interbase dataset
|
||||||
|
#
|
||||||
|
|
||||||
|
[targets]
|
||||||
|
units=interbase
|
||||||
|
programs=testib
|
||||||
|
|
||||||
|
[defaults]
|
||||||
|
defaultcpu=i386
|
||||||
|
|
||||||
|
[require]
|
||||||
|
options=-S2
|
||||||
|
packages=fcl ibase
|
||||||
|
|
||||||
|
[dirs]
|
||||||
|
fpcdir=../..
|
||||||
|
targetdir=.
|
||||||
|
unitdir=..
|
||||||
|
|
||||||
|
[libs]
|
||||||
|
libgcc=1
|
23
fcl/db/interbase/README
Normal file
23
fcl/db/interbase/README
Normal file
@ -0,0 +1,23 @@
|
|||||||
|
This is first working release of TDatabase and TDataset
|
||||||
|
implementation for Interbase SQL server.
|
||||||
|
|
||||||
|
Compiling the units:
|
||||||
|
|
||||||
|
Run 'make; make examples' command, if something goes wrong, look if you have
|
||||||
|
|
||||||
|
1) unit ibase60 in compiler path
|
||||||
|
2) gds.so.0 library in /usr/lib
|
||||||
|
|
||||||
|
Command 'sh mkdb' creates testing database in current directory.
|
||||||
|
|
||||||
|
Unit interbase.pp was made and tested on Linux, on ib60 server,
|
||||||
|
I don't know if it's working on other OS platforms or other
|
||||||
|
versions of IB server.
|
||||||
|
|
||||||
|
Unit in these days provides objective connectivity to IB server,
|
||||||
|
basic SQL statement support. It's still buggy, so volunteers
|
||||||
|
and contributors are welcome. It supports SQL dialect 1 only
|
||||||
|
(You cannot use date & time datatypes in tables).
|
||||||
|
|
||||||
|
Pavel Stingl
|
||||||
|
stingp1.eti@mail.cez.cz
|
848
fcl/db/interbase/interbase.pp
Normal file
848
fcl/db/interbase/interbase.pp
Normal file
@ -0,0 +1,848 @@
|
|||||||
|
{
|
||||||
|
$Id$
|
||||||
|
Copyright (c) 2000 by Pavel Stingl
|
||||||
|
|
||||||
|
|
||||||
|
Interbase database & dataset
|
||||||
|
|
||||||
|
Roughly based on work of FPC development team,
|
||||||
|
especially Michael Van Canneyt
|
||||||
|
|
||||||
|
See the file COPYING.FPC, included in this distribution,
|
||||||
|
for details about the copyright.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||||
|
|
||||||
|
**********************************************************************}
|
||||||
|
|
||||||
|
unit interbase;
|
||||||
|
|
||||||
|
{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses SysUtils, Classes, ibase60, Db;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
PInteger = ^integer;
|
||||||
|
|
||||||
|
TIBDatabase = class (TDatabase)
|
||||||
|
private
|
||||||
|
FIBDatabaseHandle : pointer;
|
||||||
|
FIBTransactionHandle : pointer;
|
||||||
|
FPassword : string;
|
||||||
|
FStatus : array [0..19] of ISC_STATUS;
|
||||||
|
FUserName : string;
|
||||||
|
|
||||||
|
procedure CheckError(ProcName : string);
|
||||||
|
protected
|
||||||
|
procedure DoInternalConnect; override;
|
||||||
|
procedure DoInternalDisconnect; override;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner : TComponent); override;
|
||||||
|
|
||||||
|
procedure CommitTransaction; virtual;
|
||||||
|
procedure RollbackTransaction; virtual;
|
||||||
|
procedure StartTransaction; override;
|
||||||
|
procedure EndTransaction; override;
|
||||||
|
|
||||||
|
property DatabaseHandle: pointer read FIBDatabaseHandle;
|
||||||
|
property TransactionHandle: pointer read FIBTransactionHandle;
|
||||||
|
published
|
||||||
|
property Password: string read FPassword write FPassword;
|
||||||
|
property UserName: string read FUserName write FUserName;
|
||||||
|
|
||||||
|
property Connected;
|
||||||
|
property DatabaseName;
|
||||||
|
property KeepConnection;
|
||||||
|
property LoginPrompt;
|
||||||
|
property Params;
|
||||||
|
property OnLogin;
|
||||||
|
end;
|
||||||
|
|
||||||
|
PIBBookmark = ^TIBBookmark;
|
||||||
|
TIBBookmark = record
|
||||||
|
BookmarkData: Integer;
|
||||||
|
BookmarkFlag: TBookmarkFlag;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// TStatementType indicates if SQL statement returns
|
||||||
|
// result set.
|
||||||
|
TStatementType = (stResult, stNoResult, stDDL);
|
||||||
|
|
||||||
|
TIBDataset = class (TDataset)
|
||||||
|
private
|
||||||
|
FBufferSize : longint;
|
||||||
|
FCurrentRecord : longint;
|
||||||
|
FCurrStmtType : TStatementType;
|
||||||
|
FDatabase : TIBDatabase;
|
||||||
|
FFlag : array [0..1024] of shortint;
|
||||||
|
FIsEOF : boolean;
|
||||||
|
FLoadingFieldDefs : boolean;
|
||||||
|
FSQLPrepared : boolean;
|
||||||
|
FRecordSize : word;
|
||||||
|
FRecordCount : integer;
|
||||||
|
FSQL : TStrings;
|
||||||
|
FSQLDA : PXSQLDA;
|
||||||
|
FSQLDAAllocated : longint;
|
||||||
|
FStatementHandle : pointer;
|
||||||
|
FStatus : array [0..19] of ISC_STATUS;
|
||||||
|
|
||||||
|
FDBHandle : pointer;
|
||||||
|
FTRHandle : pointer;
|
||||||
|
|
||||||
|
procedure CheckError(ProcName : string);
|
||||||
|
procedure DoAssignBuffers;
|
||||||
|
procedure DoExecSQL;
|
||||||
|
procedure DoFetch;
|
||||||
|
procedure DoFreeBuffers;
|
||||||
|
procedure DoParseSQL;
|
||||||
|
procedure DoSQLDAAlloc(Count : longint);
|
||||||
|
procedure DoStmtAlloc;
|
||||||
|
procedure DoStmtDealloc;
|
||||||
|
|
||||||
|
procedure SetBufExtended(Field : TField; CurrBuff,Buffer : pointer);
|
||||||
|
procedure SetBufInteger(Field : TField; CurrBuff,Buffer : pointer);
|
||||||
|
procedure SetBufDateTime(Field : TField; CurrBuff,Buffer : pointer; AType : integer);
|
||||||
|
procedure SetBufString(Field : TField; CurrBuff,Buffer : pointer);
|
||||||
|
|
||||||
|
function GetStmtType: TStatementType;
|
||||||
|
|
||||||
|
function LoadBufferFromData(Buffer : PChar): TGetResult;
|
||||||
|
procedure SetDatabase(Value : TIBDatabase);
|
||||||
|
procedure SetSizes;
|
||||||
|
procedure TranslateFieldType(AType, AScale: longint;
|
||||||
|
var XType: TFieldType; var XScale: word);
|
||||||
|
protected
|
||||||
|
function AllocRecordBuffer: PChar; override;
|
||||||
|
procedure FreeRecordBuffer(var Buffer: PChar); override;
|
||||||
|
procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
|
||||||
|
function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
|
||||||
|
function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
|
||||||
|
function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
|
||||||
|
function GetRecordSize: Word; override;
|
||||||
|
function GetRecordCount: integer; override;
|
||||||
|
procedure InternalAddRecord(Buffer: Pointer; AAppend: Boolean); override;
|
||||||
|
procedure InternalClose; override;
|
||||||
|
procedure InternalDelete; override;
|
||||||
|
procedure InternalFirst; override;
|
||||||
|
procedure InternalGotoBookmark(ABookmark: Pointer); override;
|
||||||
|
procedure InternalHandleException; override;
|
||||||
|
procedure InternalInitFieldDefs; override;
|
||||||
|
procedure InternalInitRecord(Buffer: PChar); override;
|
||||||
|
procedure InternalLast; override;
|
||||||
|
procedure InternalOpen; override;
|
||||||
|
procedure InternalPost; override;
|
||||||
|
procedure InternalSetToRecord(Buffer: PChar); override;
|
||||||
|
function IsCursorOpen: Boolean; override;
|
||||||
|
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
|
||||||
|
procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
|
||||||
|
procedure SetFieldData(Field: TField; Buffer: Pointer); override;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner : TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
published
|
||||||
|
property SQL : TStrings read FSQL write FSQL;
|
||||||
|
property Database : TIBDatabase read FDatabase write SetDatabase;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
TTm = packed record
|
||||||
|
tm_sec : longint;
|
||||||
|
tm_min : longint;
|
||||||
|
tm_hour : longint;
|
||||||
|
tm_mday : longint;
|
||||||
|
tm_mon : longint;
|
||||||
|
tm_year : longint;
|
||||||
|
tm_wday : longint;
|
||||||
|
tm_yday : longint;
|
||||||
|
tm_isdst : longint;
|
||||||
|
__tm_gmtoff : longint;
|
||||||
|
__tm_zone : Pchar;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
///////////////////////////////////////////////////////////////////////
|
||||||
|
// TIBDatabase implementation
|
||||||
|
//
|
||||||
|
|
||||||
|
// PRIVATE PART of TIBDatabase
|
||||||
|
|
||||||
|
{---------------------------------------------------------------------}
|
||||||
|
{ CheckError }
|
||||||
|
{ This procedure checks IB status vector and, if found some error }
|
||||||
|
{ condition, raises exception with IB error text }
|
||||||
|
{---------------------------------------------------------------------}
|
||||||
|
|
||||||
|
procedure TIBDatabase.CheckError(ProcName:string);
|
||||||
|
var
|
||||||
|
buf : array [0..1024] of char;
|
||||||
|
P : pointer;
|
||||||
|
x : integer;
|
||||||
|
begin
|
||||||
|
if ((FStatus[0] = 1) and (FStatus[1] <> 0)) then
|
||||||
|
begin
|
||||||
|
p := @FStatus;
|
||||||
|
isc_interprete(Buf, @p);
|
||||||
|
raise Exception.Create(ProcName + ': ' + StrPas(buf));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
// PROTECTED PART of TIBDatabase
|
||||||
|
|
||||||
|
procedure TIBDatabase.DoInternalConnect;
|
||||||
|
var
|
||||||
|
DPB : string;
|
||||||
|
begin
|
||||||
|
if Connected then
|
||||||
|
Close;
|
||||||
|
DPB := chr(isc_dpb_version1);
|
||||||
|
if (FUserName <> '') then
|
||||||
|
begin
|
||||||
|
DPB := DPB + chr(isc_dpb_user_name) + chr(Length(FUserName)) + FUserName;
|
||||||
|
if (FPassword <> '') then
|
||||||
|
DPB := DPB + chr(isc_dpb_password) + chr(Length(FPassword)) + FPassword;
|
||||||
|
end;
|
||||||
|
if (DatabaseName = '') then
|
||||||
|
raise Exception.Create('TIBDatabase.Open: Database connect string not filled in!');
|
||||||
|
FIBDatabaseHandle := nil;
|
||||||
|
if isc_attach_database(@FStatus, Length(DatabaseName), @DatabaseName[1], @FIBDatabaseHandle,
|
||||||
|
Length(DPB), @DPB[1]) <> 0 then
|
||||||
|
CheckError('TIBDatabase.Open');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDatabase.DoInternalDisconnect;
|
||||||
|
begin
|
||||||
|
if not Connected then
|
||||||
|
begin
|
||||||
|
FIBDatabaseHandle := nil;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
isc_detach_database(@FStatus[0], @FIBDatabaseHandle);
|
||||||
|
CheckError('TIBDatabase.Close');
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
// PUBLIC PART of TIBDatabase
|
||||||
|
|
||||||
|
constructor TIBDatabase.Create(AOwner : TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
FIBDatabaseHandle := nil;
|
||||||
|
FIBTransactionHandle := nil;
|
||||||
|
FUserName := '';
|
||||||
|
FPassword := '';
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDatabase.CommitTransaction;
|
||||||
|
begin
|
||||||
|
if FIBTransactionHandle <> nil then
|
||||||
|
if isc_commit_retaining(@FStatus, @FIBTransactionHandle) <> 0 then
|
||||||
|
CheckError('TIBDatabase.CommitTransaction');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDatabase.RollbackTransaction;
|
||||||
|
begin
|
||||||
|
if FIBTransactionHandle <> nil then
|
||||||
|
if isc_rollback_retaining(@FStatus, FIBTransactionHandle) <> 0 then
|
||||||
|
CheckError('TIBDatabase.RollbackTransaction');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDatabase.StartTransaction;
|
||||||
|
begin
|
||||||
|
if FIBTransactionHandle = nil then
|
||||||
|
begin
|
||||||
|
if isc_start_transaction(@FStatus, @FIBTransactionHandle, 1, [@FIBDatabaseHandle, 0, nil]) <> 0 then
|
||||||
|
CheckError('TIBDatabase.StartTransaction');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDatabase.EndTransaction;
|
||||||
|
begin
|
||||||
|
if FIBTransactionHandle <> nil then
|
||||||
|
begin
|
||||||
|
if isc_commit_transaction(@FStatus, @FIBTransactionHandle) <> 0 then
|
||||||
|
CheckError('TIBDatabase.EndTransaction');
|
||||||
|
FIBTransactionHandle := nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
///////////////////////////////////////////////////////////////////////
|
||||||
|
// TIBDataset implementation
|
||||||
|
//
|
||||||
|
|
||||||
|
// PRIVATE PART
|
||||||
|
|
||||||
|
procedure TIBDataset.CheckError(ProcName : string);
|
||||||
|
var
|
||||||
|
buf : array [0..1024] of char;
|
||||||
|
P : pointer;
|
||||||
|
Msg : string;
|
||||||
|
x : integer;
|
||||||
|
begin
|
||||||
|
if ((FStatus[0] = 1) and (FStatus[1] <> 0)) then
|
||||||
|
begin
|
||||||
|
p := @FStatus;
|
||||||
|
while isc_interprete(Buf, @p) > 0 do
|
||||||
|
Msg := Msg + #10' -' + StrPas(Buf);
|
||||||
|
raise Exception.Create(ProcName + ': ' + Msg);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.DoAssignBuffers;
|
||||||
|
var
|
||||||
|
Buf : PChar;
|
||||||
|
x : longint;
|
||||||
|
begin
|
||||||
|
for x := 0 to FSQLDA^.SQLD - 1 do
|
||||||
|
begin
|
||||||
|
Buf := AllocMem(FSQLDA^.SQLVar[x].SQLLen);
|
||||||
|
FSQLDA^.SQLVar[x].SQLData := Buf;
|
||||||
|
FSQLDA^.SQLVar[x].SQLInd := @FFlag[x];
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.DoExecSQL;
|
||||||
|
begin
|
||||||
|
if isc_dsql_execute(@FStatus, @FTrHandle, @FStatementHandle, 1, nil) <> 0 then
|
||||||
|
CheckError('TIBDataset.DoExecSQL');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.DoFetch;
|
||||||
|
var
|
||||||
|
Res : longint;
|
||||||
|
begin
|
||||||
|
if FCurrStmtType <> stResult then Exit;
|
||||||
|
Res := isc_dsql_fetch(@FStatus, @FStatementHandle, 1, FSQLDA);
|
||||||
|
if (Res <> 100) then
|
||||||
|
CheckError('TIBDataset.DoFetch');
|
||||||
|
FIsEOF := (Res = 100);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.DoFreeBuffers;
|
||||||
|
var
|
||||||
|
x : longint;
|
||||||
|
begin
|
||||||
|
for x := 0 to FSQLDA^.SQLD - 1 do
|
||||||
|
if (FSQLDA^.SQLVar[x].SQLData <> nil) then
|
||||||
|
FreeMem(FSQLDA^.SQLVar[x].SQLData);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.DoParseSQL;
|
||||||
|
var
|
||||||
|
Buf : string;
|
||||||
|
x : longint;
|
||||||
|
begin
|
||||||
|
if FSQL.Count < 1 then
|
||||||
|
raise Exception.Create('TIBDataset.DoParseSQL: Empty SQL statement');
|
||||||
|
|
||||||
|
Buf := '';
|
||||||
|
for x := 0 to FSQL.Count - 1 do
|
||||||
|
Buf := Buf + FSQL[x] + ' ';
|
||||||
|
|
||||||
|
if isc_dsql_prepare(@FStatus, @FTrHandle, @FStatementHandle, 0, @Buf[1], 1, nil) <> 0 then CheckError('TIBDataset.DoParseSQL - Prepare');
|
||||||
|
|
||||||
|
if isc_dsql_describe(@FStatus, @FStatementHandle, 1, FSQLDA) <> 0 then
|
||||||
|
CheckError('TIBDataset.DoParseSQL - Describe');
|
||||||
|
|
||||||
|
if FSQLDA^.SQLN < FSQLDA^.SQLD then
|
||||||
|
begin
|
||||||
|
x := FSQLDA^.SQLD;
|
||||||
|
DoSQLDAAlloc(x);
|
||||||
|
if isc_dsql_describe(@FStatus, @FStatementHandle, 1, FSQLDA) <> 0 then
|
||||||
|
CheckError('TIBDataset.DoParseSQL - Describe');
|
||||||
|
end;
|
||||||
|
|
||||||
|
FCurrStmtType := GetStmtType;
|
||||||
|
FSQLPrepared := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.DoSQLDAAlloc(Count : longint);
|
||||||
|
begin
|
||||||
|
if FSQLDAAllocated > 0 then
|
||||||
|
FreeMem(FSQLDA, XSQLDA_Length * FSQLDAAllocated);
|
||||||
|
GetMem(FSQLDA, XSQLDA_Length * Count);
|
||||||
|
FSQLDAAllocated := Count;
|
||||||
|
FSQLDA^.Version := SQLDA_VERSION1;
|
||||||
|
FSQLDA^.SQLN := Count;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.DoStmtAlloc;
|
||||||
|
begin
|
||||||
|
if not FDatabase.Connected then
|
||||||
|
FDatabase.Open;
|
||||||
|
if FDatabase.TransactionHandle = nil then
|
||||||
|
FDatabase.StartTransaction;
|
||||||
|
FDBHandle := FDatabase.DatabaseHandle;
|
||||||
|
FTRHandle := FDatabase.TransactionHandle;
|
||||||
|
|
||||||
|
if isc_dsql_allocate_statement(@FStatus, @FDBHandle, @FStatementHandle) <> 0 then
|
||||||
|
CheckError('TIBDataset.DoStmtAlloc');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.DoStmtDealloc;
|
||||||
|
begin
|
||||||
|
if isc_dsql_free_statement(@FStatus, @FStatementHandle, DSQL_Drop) <> 0 then
|
||||||
|
CheckError('TIBDataset.DoStmtDealloc');
|
||||||
|
FStatementHandle := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TIBDataset.GetStmtType: TStatementType;
|
||||||
|
var
|
||||||
|
ResBuf : array [0..7] of char;
|
||||||
|
x : integer;
|
||||||
|
SType : integer;
|
||||||
|
begin
|
||||||
|
x := isc_info_sql_stmt_type;
|
||||||
|
isc_dsql_sql_info(@FStatus, @FStatementHandle, SizeOf(x),
|
||||||
|
@x, SizeOf(ResBuf), @ResBuf);
|
||||||
|
if Ord(ResBuf[0]) = isc_info_sql_stmt_type then
|
||||||
|
begin
|
||||||
|
x := isc_vax_integer(@ResBuf[1], 2);
|
||||||
|
SType := isc_vax_integer(@ResBuf[3], x);
|
||||||
|
end;
|
||||||
|
case SType of
|
||||||
|
isc_info_sql_stmt_select:
|
||||||
|
Result := stResult;
|
||||||
|
isc_info_sql_stmt_insert, isc_info_sql_stmt_update,
|
||||||
|
isc_info_sql_stmt_delete:
|
||||||
|
Result := stNoResult;
|
||||||
|
else Result := stDDL;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TIBDataset.LoadBufferFromData(Buffer : PChar): TGetResult;
|
||||||
|
var
|
||||||
|
x : integer;
|
||||||
|
p : word;
|
||||||
|
T : TISC_TIMESTAMP;
|
||||||
|
begin
|
||||||
|
DoFetch;
|
||||||
|
if FIsEOF then
|
||||||
|
Result := grEOF
|
||||||
|
else begin
|
||||||
|
for x := 0 to FSQLDA^.SQLD - 1 do
|
||||||
|
begin
|
||||||
|
if (FSQLDA^.SQLVar[x].SQLType = SQL_VARYING) or
|
||||||
|
(FSQLDA^.SQLVar[x].SQLType = SQL_VARYING + 1) then
|
||||||
|
begin
|
||||||
|
Move(FSQLDA^.SQLVar[x].SQLData^, P, 2);
|
||||||
|
Move((FSQLDA^.SQLVar[x].SQLData + 2)^, Buffer^, P);
|
||||||
|
PChar(Buffer+P)^ := #0;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Move(FSQLDA^.SQLVar[x].SQLData^, Buffer^, FSQLDA^.SQLVar[x].SQLLen);
|
||||||
|
Inc(Buffer,FSQLDA^.SQLVar[x].SQLLen);
|
||||||
|
end;
|
||||||
|
Result := grOK;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.SetDatabase(Value : TIBDatabase);
|
||||||
|
begin
|
||||||
|
CheckInactive;
|
||||||
|
If Value<>FDatabase then
|
||||||
|
begin
|
||||||
|
if Value<>Nil Then
|
||||||
|
FDatabase:=Value;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.SetSizes;
|
||||||
|
var
|
||||||
|
x : integer;
|
||||||
|
begin
|
||||||
|
FRecordSize := 0;
|
||||||
|
FBufferSize := 0;
|
||||||
|
for x := 0 to FSQLDA^.SQLD - 1 do
|
||||||
|
begin
|
||||||
|
Inc(FRecordSize, FSQLDA^.SQLVar[x].SQLLen);
|
||||||
|
end;
|
||||||
|
FBufferSize := FRecordSize + SizeOf(TIBBookmark);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.TranslateFieldType(AType, AScale: longint;
|
||||||
|
var XType: TFieldType; var XScale: word);
|
||||||
|
begin
|
||||||
|
case AType of
|
||||||
|
SQL_TEXT, SQL_VARYING, SQL_TEXT+1, SQL_VARYING+1:
|
||||||
|
begin
|
||||||
|
XType := ftString;
|
||||||
|
XScale := AScale;
|
||||||
|
end;
|
||||||
|
SQL_DOUBLE, SQL_DOUBLE+1:
|
||||||
|
begin
|
||||||
|
XType := ftFloat;
|
||||||
|
XScale := AScale;
|
||||||
|
end;
|
||||||
|
SQL_LONG, SQL_LONG+1, SQL_SHORT, SQL_SHORT+1:
|
||||||
|
begin
|
||||||
|
XType := ftInteger;
|
||||||
|
XScale := AScale;
|
||||||
|
end;
|
||||||
|
{ SQL_DATE, SQL_DATE+1, SQL_TIME, SQL_TIME+1,}
|
||||||
|
SQL_TYPE_TIME:
|
||||||
|
begin
|
||||||
|
XType := ftTime;
|
||||||
|
XScale := AScale;
|
||||||
|
end;
|
||||||
|
SQL_TYPE_DATE:
|
||||||
|
begin
|
||||||
|
XType := ftDate;
|
||||||
|
XScale := AScale;
|
||||||
|
end;
|
||||||
|
SQL_FLOAT,SQL_FLOAT+1:
|
||||||
|
begin
|
||||||
|
XType := ftFloat;
|
||||||
|
XScale := AScale;
|
||||||
|
end;
|
||||||
|
SQL_TIMESTAMP, SQL_TIMESTAMP+1:
|
||||||
|
begin
|
||||||
|
XType := ftDateTime;
|
||||||
|
XScale := AScale;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
// PROTECTED PART
|
||||||
|
|
||||||
|
function TIBDataset.AllocRecordBuffer: PChar;
|
||||||
|
begin
|
||||||
|
Result := AllocMem(FBufferSize);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.FreeRecordBuffer(var Buffer: PChar);
|
||||||
|
begin
|
||||||
|
FreeMem(Buffer);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.GetBookmarkData(Buffer: PChar; Data: Pointer);
|
||||||
|
begin
|
||||||
|
PInteger(Data)^ := PIBBookmark(Buffer + FRecordSize)^.BookmarkData;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TIBDataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
|
||||||
|
begin
|
||||||
|
Result := PIBBookmark(Buffer + FRecordSize)^.BookmarkFlag;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.SetBufExtended(Field : TField; CurrBuff,Buffer : pointer);
|
||||||
|
var
|
||||||
|
E : extended;
|
||||||
|
D : double;
|
||||||
|
S : single;
|
||||||
|
begin
|
||||||
|
case Field.Size of
|
||||||
|
4 :
|
||||||
|
begin
|
||||||
|
Move(CurrBuff^,S,4);
|
||||||
|
E := S;
|
||||||
|
end;
|
||||||
|
8 :
|
||||||
|
begin
|
||||||
|
Move(CurrBuff^,D,8);
|
||||||
|
E := D;
|
||||||
|
end;
|
||||||
|
10 : Move(CurrBuff^,E,10);
|
||||||
|
end;
|
||||||
|
Move(E, Buffer^, 10);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.SetBufInteger(Field : TField; CurrBuff,Buffer : pointer);
|
||||||
|
var
|
||||||
|
I : integer;
|
||||||
|
begin
|
||||||
|
I := 0;
|
||||||
|
Move(I, Buffer^, SizeOf(Integer));
|
||||||
|
Move(CurrBuff^, Buffer^, Field.Size);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.SetBufDateTime(Field : TField; CurrBuff,Buffer : pointer; AType : integer);
|
||||||
|
var
|
||||||
|
D : TDateTime;
|
||||||
|
S : TSystemTime;
|
||||||
|
TM : TTm;
|
||||||
|
TT : TIsc_timestamp;
|
||||||
|
begin
|
||||||
|
case AType of
|
||||||
|
SQL_TYPE_DATE:
|
||||||
|
isc_decode_sql_date(PISC_DATE(CurrBuff), @TM);
|
||||||
|
SQL_TYPE_TIME:
|
||||||
|
isc_decode_sql_time(PISC_TIME(CurrBuff), @TM);
|
||||||
|
SQL_TIMESTAMP, SQL_TIMESTAMP+1:
|
||||||
|
isc_decode_timestamp(PISC_TIMESTAMP(CurrBuff), @TM);
|
||||||
|
end;
|
||||||
|
S.Year := TM.tm_year + 1900;
|
||||||
|
S.Month := TM.tm_mon + 1;
|
||||||
|
S.Day := TM.tm_mday;
|
||||||
|
S.Hour := TM.tm_hour;
|
||||||
|
S.Minute := TM.tm_min;
|
||||||
|
S.Second := TM.tm_sec;
|
||||||
|
S.Millisecond := 0;
|
||||||
|
D := SystemTimeToDateTime(S);
|
||||||
|
{$warning !!! D is okay, but Field.AsDateTime returns wrong value !!! }
|
||||||
|
// WriteLn(DateTimeToStr(D));
|
||||||
|
Move(D, Buffer^, SizeOf(D));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.SetBufString(Field : TField; CurrBuff,Buffer : pointer);
|
||||||
|
begin
|
||||||
|
Move(CurrBuff^, Buffer^, Field.Size);
|
||||||
|
PChar(Buffer + Field.Size)^ := #0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TIBDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
|
||||||
|
var
|
||||||
|
x : longint;
|
||||||
|
CurrBuff : PChar;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
CurrBuff := ActiveBuffer;
|
||||||
|
for x := 0 to FSQLDA^.SQLD - 1 do
|
||||||
|
begin
|
||||||
|
if (Field.FieldName = FSQLDA^.SQLVar[x].SQLName) then
|
||||||
|
begin
|
||||||
|
|
||||||
|
case Field.DataType of
|
||||||
|
ftFloat:
|
||||||
|
SetBufExtended(Field, CurrBuff, Buffer);
|
||||||
|
ftString:
|
||||||
|
SetBufString(Field, CurrBuff, Buffer);
|
||||||
|
ftDate,ftTime,ftDateTime:
|
||||||
|
SetBufDateTime(Field, CurrBuff, Buffer, FSQLDA^.SQLVar[x].SQLType);
|
||||||
|
ftInteger:
|
||||||
|
SetBufInteger(Field, CurrBuff, Buffer);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := True;
|
||||||
|
|
||||||
|
break;
|
||||||
|
end
|
||||||
|
else Inc(CurrBuff, FSQLDA^.SQLVar[x].SQLLen);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TIBDataset.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
|
||||||
|
begin
|
||||||
|
if FCurrStmtType <> stResult then Exit;
|
||||||
|
if FIsEOF then
|
||||||
|
Result := grEOF
|
||||||
|
else begin
|
||||||
|
Result := grOk;
|
||||||
|
case GetMode of
|
||||||
|
gmPrior:
|
||||||
|
if FCurrentRecord <= 0 then
|
||||||
|
begin
|
||||||
|
Result := grBOF;
|
||||||
|
FCurrentRecord := -1;
|
||||||
|
end
|
||||||
|
else Dec(FCurrentRecord);
|
||||||
|
gmCurrent:
|
||||||
|
if (FCurrentRecord < 0) or (FCurrentRecord >= RecordCount) then
|
||||||
|
Result := grError;
|
||||||
|
gmNext:
|
||||||
|
if FCurrentRecord >= (RecordCount - 1) then
|
||||||
|
begin
|
||||||
|
Result := LoadBufferFromData(Buffer);
|
||||||
|
if Result = grOk then
|
||||||
|
begin
|
||||||
|
Inc(FCurrentRecord);
|
||||||
|
Inc(FRecordCount);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else Inc(FCurrentRecord);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if Result = grOK then
|
||||||
|
begin
|
||||||
|
with PIBBookmark(Buffer + FRecordSize)^ do
|
||||||
|
begin
|
||||||
|
BookmarkData := FCurrentRecord;
|
||||||
|
BookmarkFlag := bfCurrent;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else if (Result = grError) {and (DoCheck)} then
|
||||||
|
DatabaseError('No record');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TIBDataset.GetRecordCount: integer;
|
||||||
|
begin
|
||||||
|
Result := FRecordCount;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TIBDataset.GetRecordSize: Word;
|
||||||
|
begin
|
||||||
|
Result := FRecordSize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.InternalAddRecord(Buffer: Pointer; AAppend: Boolean);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.InternalClose;
|
||||||
|
begin
|
||||||
|
DoFreeBuffers;
|
||||||
|
DoStmtDealloc;
|
||||||
|
if DefaultFields then
|
||||||
|
DestroyFields;
|
||||||
|
FIsEOF := False;
|
||||||
|
FCurrentRecord := -1;
|
||||||
|
FBufferSize := 0;
|
||||||
|
FRecordSize := 0;
|
||||||
|
FRecordCount := 0;
|
||||||
|
// DoSQLDAAlloc(50);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.InternalDelete;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.InternalFirst;
|
||||||
|
begin
|
||||||
|
FCurrentRecord := -1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.InternalGotoBookmark(ABookmark: Pointer);
|
||||||
|
begin
|
||||||
|
FCurrentRecord := PInteger(ABookmark)^;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.InternalHandleException;
|
||||||
|
begin
|
||||||
|
// not implemented
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.InternalInitFieldDefs;
|
||||||
|
var
|
||||||
|
x : longint;
|
||||||
|
TransFt : TFieldType;
|
||||||
|
TransSz : word;
|
||||||
|
begin
|
||||||
|
if FLoadingFieldDefs then
|
||||||
|
begin
|
||||||
|
WriteLn('Loading FieldDefs...');
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
FLoadingFieldDefs := True;
|
||||||
|
|
||||||
|
try
|
||||||
|
try
|
||||||
|
FieldDefs.Clear;
|
||||||
|
for x := 0 to FSQLDA^.SQLD - 1 do
|
||||||
|
begin
|
||||||
|
TranslateFieldType(FSQLDA^.SQLVar[x].SQLType, FSQLDA^.SQLVar[x].SQLLen,
|
||||||
|
TransFt, TransSz);
|
||||||
|
TFieldDef.Create(FieldDefs,
|
||||||
|
FSQLDA^.SQLVar[x].SQLName,
|
||||||
|
TransFt, TransSz, False, (x+1));
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
FLoadingFieldDefs := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.InternalInitRecord(Buffer: PChar);
|
||||||
|
begin
|
||||||
|
FillChar(Buffer^, FBufferSize, #0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.InternalLast;
|
||||||
|
begin
|
||||||
|
FCurrentRecord := RecordCount;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.InternalOpen;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
DoStmtAlloc;
|
||||||
|
DoParseSQL;
|
||||||
|
if FCurrStmtType = stResult then
|
||||||
|
begin
|
||||||
|
DoAssignBuffers;
|
||||||
|
DoExecSQL;
|
||||||
|
InternalInitFieldDefs;
|
||||||
|
if DefaultFields then
|
||||||
|
CreateFields;
|
||||||
|
SetSizes;
|
||||||
|
BindFields(True);
|
||||||
|
end
|
||||||
|
else DoExecSQL;
|
||||||
|
except
|
||||||
|
raise;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.InternalPost;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.InternalSetToRecord(Buffer: PChar);
|
||||||
|
begin
|
||||||
|
FCurrentRecord := PIBBookmark(Buffer + FRecordSize)^.BookmarkData;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TIBDataset.IsCursorOpen: Boolean;
|
||||||
|
begin
|
||||||
|
Result := FStatementHandle <> nil; //??
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
|
||||||
|
begin
|
||||||
|
PIBBookmark(Buffer + FRecordSize)^.BookmarkFlag := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
|
||||||
|
begin
|
||||||
|
PIBBookmark(Buffer + FRecordSize)^.BookmarkData := PInteger(Data)^;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIBDataset.SetFieldData(Field: TField; Buffer: Pointer);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
// PUBLIC PART
|
||||||
|
|
||||||
|
constructor TIBDataset.Create(AOwner : TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
FSQL := TStringList.Create;
|
||||||
|
FIsEOF := False;
|
||||||
|
FCurrentRecord := -1;
|
||||||
|
FBufferSize := 0;
|
||||||
|
FRecordSize := 0;
|
||||||
|
FRecordCount := 0;
|
||||||
|
DoSQLDAAlloc(50);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TIBDataset.Destroy;
|
||||||
|
begin
|
||||||
|
FSQL.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
FreeMem(FSQLDA, XSQLDA_Length * FSQLDAAllocated);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
{
|
||||||
|
$Log$
|
||||||
|
Revision 1.1 2000-06-04 08:15:42 michael
|
||||||
|
+ Initial implementation in FCL
|
||||||
|
|
||||||
|
Revision 1.1.1.1 2000/06/02 06:56:37 stingp1
|
||||||
|
Initial release
|
||||||
|
|
||||||
|
}
|
48
fcl/db/interbase/mkdb
Normal file
48
fcl/db/interbase/mkdb
Normal file
@ -0,0 +1,48 @@
|
|||||||
|
#!/bin/sh
|
||||||
|
#
|
||||||
|
# Script to create a table 'FPdev' and to fill it with data.
|
||||||
|
# The script accepts an optional argument :
|
||||||
|
# A database to connect to. (default 'testdb')
|
||||||
|
#
|
||||||
|
# Collect the database
|
||||||
|
DATABASE=testdb.gdb
|
||||||
|
# Choose one of the following:
|
||||||
|
# ISQL=isql
|
||||||
|
ISQL=/usr/interbase/bin/isql
|
||||||
|
#
|
||||||
|
# Don't edit after this.
|
||||||
|
#
|
||||||
|
echo -n "Creating and filling table FPdev in database $DATABASE..."
|
||||||
|
# >/dev/null 2>&1
|
||||||
|
${ISQL} << EOF
|
||||||
|
CREATE DATABASE "$DATABASE";
|
||||||
|
create table FPdev (
|
||||||
|
id INT NOT NULL,
|
||||||
|
UserName varchar(50),
|
||||||
|
InstEmail CHAR(50),
|
||||||
|
PRIMARY KEY (id));
|
||||||
|
insert into FPdev values ('1','Michael Van Canneyt','Michael@tfdec1.fys.kuleuven.ac.be');
|
||||||
|
insert into FPdev values ('2','Florian Klaempfl','ba2395@fen.baynet.de');
|
||||||
|
insert into FPdev values ('3','Carl-Eric Codere','codc01@gel.usherb.ca');
|
||||||
|
insert into FPdev values ('4','Daniel Mantione','d.s.p.mantione@twi.tudelft.nl');
|
||||||
|
insert into FPdev values ('5','Pierre Muller','muller@europe.u-strasbg.fr');
|
||||||
|
insert into FPdev values ('6','Jonas Maebe','jmaebe@mail.dma.be');
|
||||||
|
insert into FPdev values ('7','Peter Vreman','pfv@worldonline.nl');
|
||||||
|
insert into FPdev values ('8','Gerry Dubois','gerry@webworks.ml.org');
|
||||||
|
create table test (
|
||||||
|
timestamp_fld timestamp,
|
||||||
|
smallint_fld smallint,
|
||||||
|
integer_fld integer,
|
||||||
|
float_fld float,
|
||||||
|
double_fld double precision,
|
||||||
|
char_fld char(10),
|
||||||
|
varchar_fld varchar(50));
|
||||||
|
insert into test values ('12.1.2000 00:30',10,70000,12.5,20.5,'testchar','testvarchar');
|
||||||
|
commit;
|
||||||
|
EOF
|
||||||
|
if [ ! $? = 0 ]; then
|
||||||
|
echo "Failed."
|
||||||
|
else
|
||||||
|
echo "Done."
|
||||||
|
fi
|
||||||
|
# Ready
|
75
fcl/db/interbase/testib.pp
Normal file
75
fcl/db/interbase/testib.pp
Normal file
@ -0,0 +1,75 @@
|
|||||||
|
// $Id$
|
||||||
|
|
||||||
|
// Test program for interbase.pp unit
|
||||||
|
|
||||||
|
program testib;
|
||||||
|
|
||||||
|
uses Interbase,SysUtils,db;
|
||||||
|
|
||||||
|
{$linklib dl}
|
||||||
|
{$linklib crypt}
|
||||||
|
|
||||||
|
const
|
||||||
|
dbpath = 'obelix.wisa.be:/home/interbase/helpdesk.gdb';
|
||||||
|
|
||||||
|
var
|
||||||
|
DBS : TIBDatabase;
|
||||||
|
DS : TIBDataset;
|
||||||
|
x : integer;
|
||||||
|
S : TSystemTime;
|
||||||
|
|
||||||
|
begin
|
||||||
|
DBS := TIBDatabase.Create(nil);
|
||||||
|
DS := TIBDataset.Create(nil);
|
||||||
|
DS.Database := DBS;
|
||||||
|
DBS.DatabaseName := dbpath;
|
||||||
|
DBS.UserName := 'SYSDBA';
|
||||||
|
DBS.Password := 'masterkey';
|
||||||
|
DBS.Connected:=True;
|
||||||
|
DS.SQL.Add('select * from scholen');
|
||||||
|
DS.Open;
|
||||||
|
while not DS.EOF do
|
||||||
|
begin
|
||||||
|
for x := 0 to DS.FieldCount - 2 do
|
||||||
|
Write(DS.Fields[x].AsString,',');
|
||||||
|
WriteLn(DS.Fields[DS.FieldCount-1].AsString);
|
||||||
|
DS.Next;
|
||||||
|
end;
|
||||||
|
DS.Close;
|
||||||
|
DS.SQL.Clear;
|
||||||
|
DS.Free;
|
||||||
|
{
|
||||||
|
WriteLn;
|
||||||
|
WriteLn('Trying to perform test of datatypes interpretation...');
|
||||||
|
WriteLn('Some problems with TDateTimeField, see source');
|
||||||
|
DS := TIBDataset.Create(nil);
|
||||||
|
DS.Database := DBS;
|
||||||
|
DS.SQL.Add('select * from test');
|
||||||
|
DS.Open;
|
||||||
|
while not DS.EOF do
|
||||||
|
begin
|
||||||
|
{ Warning - TDateTimeField.AsDateTime returns wrong values,
|
||||||
|
but conversions in TIBDataset are OK! }
|
||||||
|
for x := 0 to DS.FieldCount - 1 do
|
||||||
|
if (DS.Fields[x].DataType = ftDateTime) then
|
||||||
|
WriteLn(DS.Fields[x].FieldName, ' : "',
|
||||||
|
FormatDateTime('DD.MM.YYYY HH:MM:SS',DS.Fields[x].AsDateTime),'"')
|
||||||
|
else WriteLn(DS.Fields[x].FieldName, ' : "',DS.Fields[x].AsString,'"');
|
||||||
|
DS.Next;
|
||||||
|
end;
|
||||||
|
DS.Free;
|
||||||
|
}
|
||||||
|
DBS.EndTransaction;
|
||||||
|
DBS.Close;
|
||||||
|
DBS.Free;
|
||||||
|
end.
|
||||||
|
|
||||||
|
{
|
||||||
|
$Log$
|
||||||
|
Revision 1.1 2000-06-04 08:15:43 michael
|
||||||
|
+ Initial implementation in FCL
|
||||||
|
|
||||||
|
Revision 1.1.1.1 2000/06/02 06:56:37 stingp1
|
||||||
|
Initial release
|
||||||
|
|
||||||
|
}
|
Loading…
Reference in New Issue
Block a user