← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fcl/db/interbase/interbase.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fcl/db/interbase/interbase.pp
1
 
{   $Id: interbase.pp,v 1.12 2004/05/01 23:56:59 michael Exp $
2
 
 
3
 
    Copyright (c) 2000 by Pavel Stingl
4
 
 
5
 
 
6
 
    Interbase database & dataset
7
 
 
8
 
    See the file COPYING.FPC, included in this distribution,
9
 
    for details about the copyright.
10
 
 
11
 
    This program is distributed in the hope that it will be useful,
12
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
13
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
14
 
 
15
 
 **********************************************************************}
16
 
 
17
 
unit Interbase;
18
 
 
19
 
{$mode objfpc}
20
 
{$H+}
21
 
{$M+}   // ### remove this!!!
22
 
 
23
 
interface
24
 
 
25
 
uses SysUtils, Classes, IBase60, DB;
26
 
 
27
 
type
28
 
 
29
 
  PInteger = ^integer;
30
 
  PSmallInt= ^smallint;
31
 
 
32
 
  TIBDatabase = class;
33
 
  TIBTransaction = class;
34
 
  TIBQuery = class;
35
 
  TIBStoredProc = class;
36
 
 
37
 
  EInterBaseError = class(Exception);
38
 
 
39
 
{ TIBDatabase }
40
 
 
41
 
  TIBDatabase = class (TDatabase)
42
 
  private
43
 
    FIBDatabaseHandle    : pointer;
44
 
    FPassword            : string;
45
 
    FStatus              : array [0..19] of ISC_STATUS;
46
 
    FTransaction         : TIBTransaction;
47
 
    FUserName            : string;
48
 
    FCharSet             : string;
49
 
    FDialect             : integer;
50
 
    FRole                : String;
51
 
    
52
 
    procedure SetDBDialect;
53
 
    procedure SetTransaction(Value : TIBTransaction);
54
 
  protected
55
 
    function GetHandle : pointer; virtual;
56
 
      { This procedure makes connection to Interbase server internally.
57
 
        Is visible only by descendants, in application programming
58
 
        will be invisible. Connection you must establish by setting
59
 
        @link(Connected) property to true, or by call of Open method.
60
 
      }
61
 
    procedure DoInternalConnect; override;
62
 
      { This procedure disconnects object from IB server internally.
63
 
        Is visible only by descendants, in application programming
64
 
        will be invisible. Disconnection you must make by setting
65
 
        @link(Connected) property to false, or by call of Close method.
66
 
      }
67
 
    procedure DoInternalDisconnect; override;
68
 
  public
69
 
    procedure StartTransaction; override;
70
 
    procedure EndTransaction; override;
71
 
    destructor Destroy; override;
72
 
    property Handle: Pointer read GetHandle;
73
 
  published
74
 
    { On connect, TIBDatabase object retrieve SQL dialect of database file,
75
 
      and sets this property to responding value }
76
 
    property Dialect  : integer read FDialect write FDialect;
77
 
    { Before firing Open method you must set @link(Password),@link(DatabaseName),
78
 
      @link(UserName) properties in order of successfull connect to database }
79
 
    property Password : string read FPassword write FPassword;
80
 
    { This property holds default transaction for database. You must assign it by hand
81
 
      now, default assignment becomes handy, in next release, with transaction
82
 
      handling and evidence }
83
 
    property Transaction : TIBTransaction read FTransaction write SetTransaction;
84
 
    { Before firing Open method you must set @link(Password),@link(DatabaseName),
85
 
      @link(UserName) properties in order of successfull connect to database }
86
 
    property UserName : string read FUserName write FUserName;
87
 
    { The character set used in SQL statements }
88
 
    property CharSet : string read FCharSet write FCharSet;
89
 
 
90
 
    { Identifies, if connection to Interbase server is established, or not.
91
 
      Instead of calling Open, Close methods you can connect or disconnect
92
 
      by setting this property to true or false.
93
 
    }
94
 
    property Connected;
95
 
    { This property holds database connect string. On local server it will be
96
 
      absolute path to the db file, if you wanna connect over network, this
97
 
      path looks like this: <server_name>:<path_on_server>, where server_name
98
 
      is absolute IP address, or name of server in DNS or hosts file, path_on_server
99
 
      is absolute path to the file again }
100
 
    Property Role :  String read FRole write FRole;  
101
 
    property DatabaseName;
102
 
    property KeepConnection;
103
 
    property LoginPrompt;
104
 
    property Params;
105
 
    property OnLogin;
106
 
  end;
107
 
 
108
 
{ TIBTransaction }
109
 
 
110
 
  {
111
 
    Interbase has two modes for commit and rollback transactions,
112
 
    the difference is simple. If you execute Commit or Rollback,
113
 
    current transaction ends, and you must create new one.
114
 
    If you, on other side, need only commit or rollback data
115
 
    without transaction closing, execute with CommitRetaining or
116
 
    RollbackRetaining. Transaction handle, environment etc. will be
117
 
    as same as before action. Possible values are : caNone, caCommit, caCommitRetaining, caRollback,
118
 
    caRollbackRetaining
119
 
  }
120
 
 
121
 
  TCommitRollbackAction = (caNone, caCommit, caCommitRetaining, caRollback,
122
 
    caRollbackRetaining);
123
 
  TAccessMode = (amReadWrite, amReadOnly);
124
 
  TIsolationLevel = (ilConcurrent, ilConsistent, ilReadCommittedRecV,
125
 
    ilReadCommitted);
126
 
  TLockResolution = (lrWait, lrNoWait);
127
 
  TTableReservation = (trNone, trSharedLockRead, trSharedLockWrite,
128
 
    trProtectedLockRead, trProtectedLockWrite);
129
 
 
130
 
  TIBTransaction = class (TComponent)
131
 
  private
132
 
    FTransactionHandle   : pointer;               // Transaction handle
133
 
    FAction              : TCommitRollbackAction;
134
 
    FActive              : boolean;
135
 
    FTPB                 : string;                // Transaction parameter buffer
136
 
    FDatabase            : TIBDatabase;
137
 
    FAccessMode          : TAccessMode;
138
 
    FIsolationLevel      : TIsolationLevel;
139
 
    FLockResolution      : TLockResolution;
140
 
    FTableReservation    : TTableReservation;
141
 
    FStatus              : array [0..19] of ISC_STATUS;
142
 
 
143
 
    procedure SetActive(Value : boolean);
144
 
    procedure SetTPB;
145
 
  protected
146
 
    function GetHandle : pointer; virtual;
147
 
  public
148
 
    { Commits all actions, which was made in transaction, and closes transaction}
149
 
    procedure Commit; virtual;
150
 
    { Commits all actions, closes transaction, and creates new one }
151
 
    procedure CommitRetaining; virtual;
152
 
    { Rollbacks all actions made in transaction, and closes transaction }
153
 
    procedure Rollback; virtual;
154
 
    { Rollbacks all actions made in transaction, closes trans. and creates new one }
155
 
    procedure RollbackRetaining; virtual;
156
 
    { Creates new transaction. If transaction is active, closes it and make new one.
157
 
      Action taken while closing responds to @link(Action) property settings }
158
 
    procedure StartTransaction;
159
 
    constructor Create(AOwner : TComponent); override;
160
 
    destructor Destroy; override;
161
 
    property Handle: Pointer read GetHandle;
162
 
  published
163
 
    { Default action while closing transaction by setting
164
 
     @link(Active) property. For details see @link(TCommitRollbackAction)}
165
 
    property Action : TCommitRollbackAction read FAction write FAction;
166
 
    { Is set to true while transaction is active, false if not.
167
 
      If you set it manually to true, object executes
168
 
      @link(StartTransaction) method, if transaction is
169
 
      active, and you set Active to false, object executes
170
 
      one of @link(Commit), @link(CommitRetaining), @link(Rollback),
171
 
      @link(RollbackRetaining) methods, depending on @link(Action) property
172
 
      setting.
173
 
    }
174
 
    property Active : boolean read FActive write SetActive;
175
 
    { Transaction must be assigned to some database session, for which purpose
176
 
      you must use this property}
177
 
    property Database : TIBDatabase read FDatabase write FDatabase;
178
 
  end;
179
 
 
180
 
{ TIBQuery }
181
 
 
182
 
  PIBBookmark = ^TIBBookmark;
183
 
  TIBBookmark = record
184
 
    BookmarkData : integer;
185
 
    BookmarkFlag : TBookmarkFlag;
186
 
  end;
187
 
 
188
 
  TStatementType = (stNone, stSelect, stInsert, stUpdate, stDelete,
189
 
    stDDL, stGetSegment, stPutSegment, stExecProcedure,
190
 
    stStartTrans, stCommit, stRollback, stSelectForUpd);
191
 
 
192
 
  TIBQuery = class (TDBDataset)
193
 
  private
194
 
    FOpen                : Boolean;
195
 
    FTransaction         : TIBTransaction;
196
 
    FDatabase            : TIBDatabase;
197
 
    FStatus              : array [0..19] of ISC_STATUS;
198
 
    FFieldFlag           : array [0..1023] of shortint;
199
 
    FBufferSize          : integer;
200
 
    FSQLDA               : PXSQLDA;
201
 
    FSQLDAAllocated      : integer;
202
 
    FStatement           : pointer;
203
 
    FRecordCount         : integer;
204
 
    FRecordSize          : word;
205
 
    FCurrentRecord       : integer;
206
 
    FSQL                 : TStrings;
207
 
    FPrepared            : boolean;
208
 
    FIsEOF               : boolean;
209
 
    FStatementType       : TStatementType;
210
 
    FLoadingFieldDefs    : boolean;
211
 
 
212
 
    procedure SetDatabase(Value : TIBDatabase);
213
 
    procedure SetTransaction(Value : TIBTransaction);
214
 
    procedure AllocSQLDA(Count : integer);
215
 
    procedure AllocStatement;
216
 
    procedure FreeStatement;
217
 
    procedure PrepareStatement;
218
 
    procedure DescribeStatement;
219
 
    procedure SetUpSQLVars;
220
 
    procedure AllocFldBuffers;
221
 
    procedure FreeFldBuffers;
222
 
    procedure Fetch;
223
 
    function LoadBufferFromSQLDA(Buffer : PChar): TGetResult;
224
 
    procedure GetStatementType;
225
 
    procedure SetFieldSizes;
226
 
    procedure TranslateFldType(SQLType, SQLLen : integer; var LensSet : boolean;
227
 
      var TrType : TFieldType; var TrLen : word);
228
 
 
229
 
    procedure ExecuteImmediate;
230
 
    procedure ExecuteParams;
231
 
    procedure Execute;
232
 
 
233
 
    // conversion methods
234
 
    procedure GetDateTime(CurrBuff, Buffer : pointer; AType : integer);
235
 
    procedure GetFloat(CurrBuff, Buffer : pointer; Field : TField);
236
 
 
237
 
  protected
238
 
 
239
 
    // abstract & virual methods of TDataset
240
 
    function AllocRecordBuffer: PChar; override;
241
 
    procedure FreeRecordBuffer(var Buffer: PChar); override;
242
 
    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
243
 
    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
244
 
    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
245
 
    function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
246
 
    function GetRecordCount: integer; override;
247
 
    function GetRecordSize: Word; override;
248
 
    procedure InternalAddRecord(Buffer: Pointer; AAppend: Boolean); override;
249
 
    procedure InternalClose; override;
250
 
    procedure InternalDelete; override;
251
 
    procedure InternalFirst; override;
252
 
    procedure InternalGotoBookmark(ABookmark: Pointer); override;
253
 
    procedure InternalHandleException; override;
254
 
    procedure InternalInitFieldDefs; override;
255
 
    procedure InternalInitRecord(Buffer: PChar); override;
256
 
    procedure InternalLast; override;
257
 
    procedure InternalOpen; override;
258
 
    procedure InternalPost; override;
259
 
    procedure InternalSetToRecord(Buffer: PChar); override;
260
 
    function IsCursorOpen: Boolean; override;
261
 
    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
262
 
    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
263
 
    procedure SetFieldData(Field: TField; Buffer: Pointer); override;
264
 
  public
265
 
    { This method is used for executing sql statements, which
266
 
      doesn't return any rows. (insert,delete,update, and DDL commands) }
267
 
    procedure ExecSQL; virtual;
268
 
    constructor Create(AOwner : TComponent); override;
269
 
    destructor Destroy; override;
270
 
  published
271
 
    { Query must have transaction assigned. If transaction is not assigned, and database
272
 
      is, object looks, if database have default transaction, and assigns it }
273
 
    property Transaction : TIBTransaction read FTransaction write SetTransaction;
274
 
    { Use this property to determine, which database session can query use }
275
 
    property Database    : TIBDatabase read FDatabase write SetDatabase;
276
 
    { This property holds SQL command, which you want to execute }
277
 
    property SQL         : TStrings read FSQL write FSQL;
278
 
    // Publish TDataset properties.
279
 
    property Active;
280
 
    property AutoCalcFields;
281
 
    property BeforeOpen;
282
 
    property AfterOpen;
283
 
    property BeforeClose;
284
 
    property AfterClose;
285
 
    property BeforeInsert;
286
 
    property AfterInsert;
287
 
    property BeforeEdit;
288
 
    property AfterEdit;
289
 
    property BeforePost;
290
 
    property AfterPost;
291
 
    property BeforeCancel;
292
 
    property AfterCancel;
293
 
    property BeforeDelete;
294
 
    property AfterDelete;
295
 
    property BeforeScroll;
296
 
    property AfterScroll;
297
 
    property OnCalcFields;
298
 
    property OnDeleteError;
299
 
    property OnEditError;
300
 
    property OnFilterRecord;
301
 
    property OnNewRecord;
302
 
    property OnPostError;
303
 
  end;
304
 
 
305
 
{ TIBStoredProc - not implemented - yet :-/}
306
 
 
307
 
  TIBStoredProc = class (TDataset)
308
 
  private
309
 
  protected
310
 
  public
311
 
  published
312
 
  end;
313
 
 
314
 
implementation
315
 
 
316
 
type
317
 
 
318
 
  TTm = packed record
319
 
    tm_sec : longint;
320
 
    tm_min : longint;
321
 
    tm_hour : longint;
322
 
    tm_mday : longint;
323
 
    tm_mon : longint;
324
 
    tm_year : longint;
325
 
    tm_wday : longint;
326
 
    tm_yday : longint;
327
 
    tm_isdst : longint;
328
 
    __tm_gmtoff : longint;
329
 
    __tm_zone : Pchar;
330
 
  end;
331
 
 
332
 
procedure CheckError(ProcName : string; Status : array of ISC_STATUS);
333
 
var
334
 
  buf : array [0..1024] of char;
335
 
  p   : pointer;
336
 
  Msg : string;
337
 
begin
338
 
  if ((Status[0] = 1) and (Status[1] <> 0)) then
339
 
  begin
340
 
    p := @Status;
341
 
    while isc_interprete(Buf, @p) > 0 do
342
 
      Msg := Msg + #10' -' + StrPas(Buf);
343
 
    raise EInterBaseError.Create(ProcName + ': ' + Msg);
344
 
  end;
345
 
end;
346
 
 
347
 
{ TIBDatabase }
348
 
 
349
 
procedure TIBDatabase.SetDBDialect;
350
 
var
351
 
  x : integer;
352
 
  Len : integer;
353
 
  Buffer : string;
354
 
  ResBuf : array [0..39] of byte;
355
 
begin
356
 
  Buffer := Chr(isc_info_db_sql_dialect) + Chr(isc_info_end);
357
 
  if isc_database_info(@FStatus, @FIBDatabaseHandle, Length(Buffer),
358
 
    @Buffer[1], SizeOf(ResBuf), @ResBuf) <> 0 then
359
 
      CheckError('TIBDatabse.SetDBDialect', FStatus);
360
 
  x := 0;
361
 
  while x < 40 do
362
 
    case ResBuf[x] of
363
 
      isc_info_db_sql_dialect :
364
 
        begin
365
 
          Inc(x);
366
 
          Len := isc_vax_integer(@ResBuf[x], 2);
367
 
          Inc(x, 2);
368
 
          FDialect := isc_vax_integer(@ResBuf[x], Len);
369
 
          Inc(x, Len);
370
 
        end;
371
 
      isc_info_end : Break;
372
 
    end;
373
 
end;
374
 
 
375
 
procedure TIBDatabase.SetTransaction(Value : TIBTransaction);
376
 
begin
377
 
  if FTransaction = nil then
378
 
  begin
379
 
    FTransaction := Value;
380
 
    if Assigned(FTransaction) then
381
 
      FTransaction.Database := Self;
382
 
    exit;
383
 
  end;
384
 
 
385
 
  if (Value <> FTransaction) and (Value <> nil) then
386
 
    if (not FTransaction.Active) then
387
 
    begin
388
 
      FTransaction := Value;
389
 
      FTransaction.Database := Self;
390
 
    end
391
 
    else
392
 
      raise EInterBaseError.Create('Cannot assign transaction while old transaction active!');
393
 
end;
394
 
 
395
 
function TIBDatabase.GetHandle: pointer;
396
 
begin
397
 
  Result := FIBDatabaseHandle;
398
 
end;
399
 
 
400
 
procedure TIBDatabase.DoInternalConnect;
401
 
var
402
 
  DPB : string;
403
 
begin
404
 
  if Connected then
405
 
    Close;
406
 
  DPB := chr(isc_dpb_version1);
407
 
  if (FUserName <> '') then
408
 
  begin
409
 
    DPB := DPB + chr(isc_dpb_user_name) + chr(Length(FUserName)) + FUserName;
410
 
    if (FPassword <> '') then
411
 
      DPB := DPB + chr(isc_dpb_password) + chr(Length(FPassword)) + FPassword;
412
 
  end;
413
 
  if (FRole <> '') then
414
 
     DPB := DPB + chr(isc_dpb_sql_role_name) + chr(Length(FRole)) + FRole;
415
 
  if Length(CharSet) > 0 then
416
 
    DPB := DPB + Chr(isc_dpb_lc_ctype) + Chr(Length(CharSet)) + CharSet;
417
 
 
418
 
  if (DatabaseName = '') then
419
 
    raise EInterBaseError.Create('TIBDatabase.Open: Database connect string not filled in!');
420
 
  FIBDatabaseHandle := nil;
421
 
  if isc_attach_database(@FStatus, Length(DatabaseName), @DatabaseName[1], @FIBDatabaseHandle,
422
 
         Length(DPB), @DPB[1]) <> 0 then
423
 
    CheckError('TIBDatabase.Open', FStatus);
424
 
  SetDBDialect;
425
 
end;
426
 
 
427
 
procedure TIBDatabase.DoInternalDisconnect;
428
 
begin
429
 
  if not Connected then
430
 
  begin
431
 
    FIBDatabaseHandle := nil;
432
 
    Exit;
433
 
  end;
434
 
  isc_detach_database(@FStatus[0], @FIBDatabaseHandle);
435
 
  CheckError('TIBDatabase.Close', FStatus);
436
 
end;
437
 
 
438
 
procedure TIBDatabase.StartTransaction;
439
 
begin
440
 
  if FTransaction = nil then
441
 
    raise EDatabaseError.Create('TIBDatabase.StartTransaction: Transaction not set');
442
 
  FTransaction.Active := True;
443
 
end;
444
 
 
445
 
procedure TIBDatabase.EndTransaction;
446
 
begin
447
 
  if FTransaction = nil then
448
 
    raise EDatabaseError.Create('TIBDatabase.EndTransaction: Transaction not set');
449
 
  FTransaction.Active := False;
450
 
end;
451
 
 
452
 
destructor TIBDatabase.Destroy;
453
 
begin
454
 
  if FTransaction <> nil then
455
 
  begin
456
 
    FTransaction.Active := False;
457
 
    FTransaction.Database := nil;
458
 
  end;
459
 
  inherited Destroy;
460
 
end;
461
 
 
462
 
{ TIBTransaction }
463
 
 
464
 
procedure TIBTransaction.SetActive(Value : boolean);
465
 
begin
466
 
  if FActive and (not Value) then
467
 
    Rollback
468
 
  else if (not FActive) and Value then
469
 
    StartTransaction;
470
 
end;
471
 
 
472
 
procedure TIBTransaction.SetTPB;
473
 
begin
474
 
  FTPB := chr(isc_tpb_version3);
475
 
 
476
 
  case FAccessMode of
477
 
    amReadWrite : FTPB := FTPB + chr(isc_tpb_write);
478
 
    amReadOnly  : FTPB := FTPB + chr(isc_tpb_read);
479
 
  end;
480
 
 
481
 
  case FIsolationLevel of
482
 
    ilConsistent        : FTPB := FTPB + chr(isc_tpb_consistency);
483
 
    ilConcurrent        : FTPB := FTPB + chr(isc_tpb_concurrency);
484
 
    ilReadCommittedRecV : FTPB := FTPB + chr(isc_tpb_read_committed) +
485
 
      chr(isc_tpb_rec_version);
486
 
    ilReadCommitted     : FTPB := FTPB + chr(isc_tpb_read_committed) +
487
 
      chr(isc_tpb_no_rec_version);
488
 
  end;
489
 
 
490
 
  case FLockResolution of
491
 
    lrWait   : FTPB := FTPB + chr(isc_tpb_wait);
492
 
    lrNoWait : FTPB := FTPB + chr(isc_tpb_nowait);
493
 
  end;
494
 
 
495
 
  case FTableReservation of
496
 
    trSharedLockRead     : FTPB := FTPB + chr(isc_tpb_shared) +
497
 
      chr(isc_tpb_lock_read);
498
 
    trSharedLockWrite    : FTPB := FTPB + chr(isc_tpb_shared) +
499
 
      chr(isc_tpb_lock_write);
500
 
    trProtectedLockRead  : FTPB := FTPB + chr(isc_tpb_protected) +
501
 
      chr(isc_tpb_lock_read);
502
 
    trProtectedLockWrite : FTPB := FTPB + chr(isc_tpb_protected) +
503
 
      chr(isc_tpb_lock_write);
504
 
  end;
505
 
end;
506
 
 
507
 
function TIBTransaction.GetHandle: pointer;
508
 
begin
509
 
  Result := FTransactionHandle;
510
 
end;
511
 
 
512
 
procedure TIBTransaction.Commit;
513
 
begin
514
 
  if not FActive then Exit;
515
 
  if isc_commit_transaction(@FStatus, @FTransactionHandle) <> 0 then
516
 
    CheckError('TIBTransaction.Commit', FStatus)
517
 
  else FActive := False;
518
 
end;
519
 
 
520
 
procedure TIBTransaction.CommitRetaining;
521
 
begin
522
 
  if not FActive then Exit;
523
 
  if isc_commit_retaining(@FStatus, @FTransactionHandle) <> 0 then
524
 
    CheckError('TIBTransaction.CommitRetaining', FStatus);
525
 
end;
526
 
 
527
 
procedure TIBTransaction.Rollback;
528
 
begin
529
 
  if not FActive then Exit;
530
 
  if isc_rollback_transaction(@FStatus, @FTransactionHandle) <> 0 then
531
 
    CheckError('TIBTransaction.Rollback', FStatus)
532
 
  else FActive := False;
533
 
end;
534
 
 
535
 
procedure TIBTransaction.RollbackRetaining;
536
 
begin
537
 
  if not FActive then Exit;
538
 
  if isc_rollback_retaining(@FStatus, @FTransactionHandle) <> 0 then
539
 
    CheckError('TIBTransaction.RollbackRetaining', FStatus);
540
 
end;
541
 
 
542
 
procedure TIBTransaction.StartTransaction;
543
 
var
544
 
  DBHandle : pointer;
545
 
begin
546
 
  if Active then Active := False;
547
 
 
548
 
  if FDatabase = nil then
549
 
    raise EInterBaseError.Create('TIBTransaction.StartTransaction: Database not assigned!');
550
 
 
551
 
  if not Database.Connected then
552
 
    Database.Open;
553
 
 
554
 
  DBHandle := Database.GetHandle;
555
 
  SetTPB;
556
 
  FTransactionHandle := nil;
557
 
 
558
 
  if isc_start_transaction(@FStatus, @FTransactionHandle, 1,
559
 
     [@DBHandle, Length(FTPB), @FTPB[1]]) <> 0 then
560
 
    CheckError('TIBTransaction.StartTransaction',FStatus)
561
 
  else FActive := True;
562
 
end;
563
 
 
564
 
constructor TIBTransaction.Create(AOwner : TComponent);
565
 
begin
566
 
  inherited Create(AOwner);
567
 
  FIsolationLevel := ilReadCommitted;
568
 
end;
569
 
 
570
 
destructor TIBTransaction.Destroy;
571
 
begin
572
 
  // This will also do a Rollback, if the transaction is currently active
573
 
  Active := False;
574
 
 
575
 
  if Database <> nil then
576
 
    Database.Transaction := nil;
577
 
  inherited Destroy;
578
 
end;
579
 
 
580
 
{ TIBQuery }
581
 
 
582
 
procedure TIBQuery.SetTransaction(Value : TIBTransaction);
583
 
begin
584
 
  CheckInactive;
585
 
  if (FTransaction <> Value) then
586
 
    FTransaction := Value;
587
 
end;
588
 
 
589
 
procedure TIBQuery.SetDatabase(Value : TIBDatabase);
590
 
begin
591
 
  CheckInactive;
592
 
  if (FDatabase <> Value) then
593
 
  begin
594
 
    FDatabase := Value;
595
 
    if (FTransaction = nil) and (Assigned(FDatabase.Transaction)) then
596
 
      SetTransaction(FDatabase.Transaction);
597
 
  end;
598
 
end;
599
 
 
600
 
procedure TIBQuery.AllocSQLDA(Count : integer);
601
 
begin
602
 
  if FSQLDAAllocated > 0 then
603
 
    FreeMem(FSQLDA);
604
 
  GetMem(FSQLDA, XSQLDA_Length(Count));
605
 
  { Zero out the memory block to avoid problems with exceptions within the
606
 
    constructor of this class. }
607
 
  FillChar(FSQLDA^, XSQLDA_Length(Count), 0);
608
 
  FSQLDAAllocated := Count;
609
 
  FSQLDA^.Version := sqlda_version1;
610
 
  FSQLDA^.SQLN := Count;
611
 
end;
612
 
 
613
 
procedure TIBQuery.AllocStatement;
614
 
var
615
 
  dh : pointer;
616
 
begin
617
 
  if not FDatabase.Connected then
618
 
    FDatabase.Open;
619
 
  dh := FDatabase.GetHandle;
620
 
 
621
 
  if isc_dsql_allocate_statement(@FStatus, @dh, @FStatement) <> 0 then
622
 
    CheckError('TIBQuery.AllocStatement', FStatus);
623
 
end;
624
 
 
625
 
procedure TIBQuery.FreeStatement;
626
 
begin
627
 
  if isc_dsql_free_statement(@FStatus, @FStatement, DSQL_Drop) <> 0 then
628
 
    CheckError('TIBQuery.FreeStatement', FStatus);
629
 
  FStatement := nil;
630
 
end;
631
 
 
632
 
procedure TIBQuery.PrepareStatement;
633
 
var
634
 
  Buf : string;
635
 
  x   : integer;
636
 
  tr  : pointer;
637
 
begin
638
 
  tr := FTransaction.GetHandle;
639
 
 
640
 
  for x := 0 to FSQL.Count - 1 do
641
 
    Buf := Buf + FSQL[x] + ' ';
642
 
 
643
 
  if isc_dsql_prepare(@FStatus, @tr, @FStatement, 0, @Buf[1], Database.Dialect, nil) <> 0 then
644
 
    CheckError('TIBQuery.PrepareStatement', FStatus);
645
 
end;
646
 
 
647
 
procedure TIBQuery.DescribeStatement;
648
 
begin
649
 
  if isc_dsql_describe(@FStatus, @FStatement, 1, FSQLDA) <> 0 then
650
 
    CheckError('TIBQuery.DescribeStatement', FStatus);
651
 
  if FSQLDA^.SQLD > FSQLDA^.SQLN then
652
 
  begin
653
 
    AllocSQLDA(FSQLDA^.SQLD);
654
 
    if isc_dsql_describe(@FStatus, @FStatement, 1, FSQLDA) <> 0 then
655
 
      CheckError('TIBQuery.DescribeStatement', FStatus);
656
 
  end;
657
 
end;
658
 
 
659
 
procedure TIBQuery.SetUpSQLVars;
660
 
var
661
 
  x : integer;
662
 
begin
663
 
  for x := 0 to FSQLDA^.SQLN - 1 do
664
 
  begin
665
 
    case FSQLDA^.SQLVar[x].SQLType of
666
 
      sql_varying + 1:
667
 
        FSQLDA^.SQLVar[x].SQLType := sql_varying;
668
 
      sql_text + 1   :
669
 
        FSQLDA^.SQLVar[x].SQLType := sql_text;
670
 
      sql_short, sql_short + 1, sql_long + 1:
671
 
        FSQLDA^.SQLVar[x].SQLType := sql_long;
672
 
      sql_float + 1  :
673
 
        FSQLDA^.SQLVar[x].SQLType := sql_float;
674
 
      sql_double + 1 :
675
 
        FSQLDA^.SQLVar[x].SQLType := sql_double;
676
 
      sql_blob + 1   :
677
 
        FSQLDA^.SQLVar[x].SQLType := sql_blob;
678
 
      sql_type_time + 1   :
679
 
        FSQLDA^.SQLVar[x].SQLType := sql_type_time;
680
 
      sql_timestamp + 1:
681
 
        FSQLDA^.SQLVar[x].SQLType := sql_timestamp;
682
 
    end;
683
 
  end;
684
 
end;
685
 
 
686
 
procedure TIBQuery.AllocFldBuffers;
687
 
var
688
 
  x  : shortint;
689
 
begin
690
 
  {$R-}
691
 
  for x := 0 to FSQLDA^.SQLD - 1 do
692
 
  begin
693
 
    FSQLDA^.SQLVar[x].SQLData := AllocMem(FSQLDA^.SQLVar[x].SQLLen);
694
 
    FSQLDA^.SQLVar[x].SQLInd  := @FFieldFlag[x];
695
 
  end;
696
 
  {$R+}
697
 
end;
698
 
 
699
 
procedure TIBQuery.FreeFldBuffers;
700
 
var
701
 
  x  : integer;
702
 
begin
703
 
  {$R-}
704
 
  for x := 0 to FSQLDA^.SQLD - 1 do
705
 
  begin
706
 
    if FSQLDA^.SQLVar[x].SQLData <> nil then
707
 
    begin
708
 
      FreeMem(FSQLDA^.SQLVar[x].SQLData);
709
 
      FSQLDA^.SQLVar[x].SQLData := nil;
710
 
    end;
711
 
  end;
712
 
  {$R+}
713
 
end;
714
 
 
715
 
procedure TIBQuery.Fetch;
716
 
var
717
 
  retcode : integer;
718
 
begin
719
 
  if not (FStatementType in [stSelect]) then
720
 
    Exit;
721
 
 
722
 
  retcode := isc_dsql_fetch(@FStatus, @FStatement, 1, FSQLDA);
723
 
  if (retcode <> 0) and (retcode <> 100) then
724
 
    CheckError('TIBQuery.Fetch', FStatus);
725
 
 
726
 
  FIsEOF := (retcode = 100);
727
 
end;
728
 
 
729
 
function TIBQuery.LoadBufferFromSQLDA(Buffer : PChar): TGetResult;
730
 
var
731
 
  x          : integer;
732
 
  VarcharLen : word;
733
 
begin
734
 
 
735
 
  Fetch;
736
 
  if FIsEOF then
737
 
  begin
738
 
    Result := grEOF;
739
 
    Exit;
740
 
  end;
741
 
 
742
 
  {$R-}
743
 
  for x := 0 to FSQLDA^.SQLD - 1 do
744
 
  begin
745
 
    with FSQLDA^.SQLVar[x] do
746
 
    begin
747
 
      if ((SQLType and not 1) = SQL_VARYING) then
748
 
      begin
749
 
        Move(SQLData^, VarcharLen, 2);
750
 
        Move((SQLData + 2)^, Buffer^, VarcharLen);
751
 
        PChar(Buffer + VarcharLen)^ := #0;
752
 
      end
753
 
      else Move(SQLData^, Buffer^, SQLLen);
754
 
      Inc(Buffer, SQLLen);
755
 
    end;
756
 
  end;
757
 
  {$R+}
758
 
  Result := grOK;
759
 
 
760
 
end;
761
 
 
762
 
procedure TIBQuery.GetStatementType;
763
 
var
764
 
  x : integer;
765
 
  ResBuf : array [0..7] of char;
766
 
begin
767
 
  FStatementType := stNone;
768
 
  x := isc_info_sql_stmt_type;
769
 
  if isc_dsql_sql_info(@FStatus, @FStatement, SizeOf(X),
770
 
    @x, SizeOf(ResBuf), @ResBuf) <> 0 then
771
 
    CheckError('TIBQuery.GetStatementType', FStatus);
772
 
  if Ord(ResBuf[0]) = isc_info_sql_stmt_type then
773
 
  begin
774
 
    x := isc_vax_integer(@ResBuf[1], 2);
775
 
    FStatementType := TStatementType(isc_vax_integer(@ResBuf[3], x));
776
 
  end;
777
 
end;
778
 
 
779
 
procedure TIBQuery.SetFieldSizes;
780
 
var
781
 
  x : integer;
782
 
begin
783
 
  FRecordSize := 0;
784
 
  FBufferSize := 0;
785
 
  {$R-}
786
 
  for x := 0 to FSQLDA^.SQLD - 1 do
787
 
    Inc(FRecordSize, FSQLDA^.SQLVar[x].SQLLen);
788
 
  {$R+}
789
 
  FBufferSize := FRecordSize + SizeOf(TIBBookmark);
790
 
end;
791
 
 
792
 
procedure TIBQuery.TranslateFldType(SQLType, SQLLen : integer; var LensSet : boolean;
793
 
  var TrType : TFieldType; var TrLen : word);
794
 
begin
795
 
  LensSet := False;
796
 
 
797
 
  case (SQLType and not 1) of
798
 
    SQL_VARYING :
799
 
      begin
800
 
        LensSet := True;
801
 
        TrType := ftString;
802
 
        TrLen := SQLLen;
803
 
      end;
804
 
    SQL_TEXT :
805
 
      begin
806
 
        LensSet := True;
807
 
        TrType := ftString;
808
 
        TrLen := SQLLen;
809
 
      end;
810
 
    SQL_TYPE_DATE :
811
 
        TrType := ftDateTime;
812
 
    SQL_TYPE_TIME :
813
 
        TrType := ftDateTime;
814
 
    SQL_TIMESTAMP :
815
 
        TrType := ftDateTime;
816
 
    SQL_ARRAY :
817
 
      begin
818
 
      end;
819
 
    SQL_BLOB :
820
 
      begin
821
 
      end;
822
 
    SQL_SHORT :
823
 
      begin
824
 
        LensSet := True;
825
 
        TrLen := SQLLen;
826
 
        TrType := ftInteger;
827
 
      end;
828
 
    SQL_LONG :
829
 
      begin
830
 
        LensSet := True;
831
 
        TrLen := SQLLen;
832
 
        TrType := ftInteger;
833
 
      end;
834
 
    SQL_INT64 :
835
 
        {TrType := ftInt64};
836
 
    SQL_DOUBLE :
837
 
      begin
838
 
        LensSet := True;
839
 
        TrLen := SQLLen;
840
 
        TrType := ftFloat;
841
 
      end;
842
 
    SQL_FLOAT :
843
 
      begin
844
 
        LensSet := True;
845
 
        TrLen := SQLLen;
846
 
        TrType := ftFloat;
847
 
      end;
848
 
  end;
849
 
end;
850
 
 
851
 
procedure TIBQuery.ExecuteImmediate;
852
 
begin
853
 
end;
854
 
 
855
 
procedure TIBQuery.ExecuteParams;
856
 
begin
857
 
  //!! to be implemented
858
 
end;
859
 
 
860
 
procedure TIBQuery.Execute;
861
 
var
862
 
  tr : pointer;
863
 
begin
864
 
  tr := FTransaction.GetHandle;
865
 
  if isc_dsql_execute(@FStatus, @tr, @FStatement, 1, nil) <> 0 then
866
 
    CheckError('TIBQuery.Execute', FStatus);
867
 
end;
868
 
 
869
 
procedure TIBQuery.GetDateTime(CurrBuff, Buffer : pointer; AType : integer);
870
 
var
871
 
  CTime : TTm;          // C struct time
872
 
  STime : TSystemTime;  // System time
873
 
  PTime : TDateTime;    // Pascal time
874
 
begin
875
 
  case (AType and not 1) of
876
 
    SQL_TYPE_DATE :
877
 
      isc_decode_sql_date(PISC_DATE(CurrBuff), @CTime);
878
 
    SQL_TYPE_TIME :
879
 
      isc_decode_sql_time(PISC_TIME(CurrBuff), @CTime);
880
 
    SQL_TIMESTAMP :
881
 
      isc_decode_timestamp(PISC_TIMESTAMP(CurrBuff), @CTime);
882
 
  end;
883
 
  STime.Year        := CTime.tm_year + 1900;
884
 
  STime.Month       := CTime.tm_mon + 1;
885
 
  STime.Day         := CTime.tm_mday;
886
 
  STime.Hour        := CTime.tm_hour;
887
 
  STime.Minute      := CTime.tm_min;
888
 
  STime.Second      := CTime.tm_sec;
889
 
  STime.Millisecond := 0;
890
 
 
891
 
  PTime := SystemTimeToDateTime(STime);
892
 
  Move(PTime, Buffer^, SizeOf(PTime));
893
 
end;
894
 
 
895
 
procedure TIBQuery.GetFloat(CurrBuff, Buffer : pointer; Field : TField);
896
 
var
897
 
  Ext : extended;
898
 
  Dbl : double;
899
 
  Sin : single;
900
 
begin
901
 
  case Field.Size of
902
 
    4 :
903
 
      begin
904
 
        Move(CurrBuff^, Sin, 4);
905
 
        Ext := Sin;
906
 
      end;
907
 
    8 :
908
 
      begin
909
 
        Move(CurrBuff^, Dbl, 8);
910
 
        Ext := Dbl;
911
 
      end;
912
 
    10: Move(CurrBuff^, Ext, 10);
913
 
  end;
914
 
  Move(Ext, Buffer^, 10);
915
 
end;
916
 
 
917
 
function TIBQuery.AllocRecordBuffer: PChar;
918
 
begin
919
 
  Result := AllocMem(FBufferSize);
920
 
end;
921
 
 
922
 
procedure TIBQuery.FreeRecordBuffer(var Buffer: PChar);
923
 
begin
924
 
  if Assigned(@Buffer) then
925
 
    FreeMem(Buffer);
926
 
end;
927
 
 
928
 
procedure TIBQuery.GetBookmarkData(Buffer: PChar; Data: Pointer);
929
 
begin
930
 
  PInteger(Data)^ := PIBBookmark(Buffer + FRecordSize)^.BookmarkData;
931
 
end;
932
 
 
933
 
function TIBQuery.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
934
 
begin
935
 
  Result := PIBBookmark(Buffer + FRecordSize)^.BookmarkFlag;
936
 
end;
937
 
 
938
 
function TIBQuery.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
939
 
var
940
 
  x : longint;
941
 
  b : longint;
942
 
  CurrBuff : PChar;
943
 
begin
944
 
  Result := False;
945
 
  CurrBuff := ActiveBuffer;
946
 
 
947
 
  for x := 0 to FSQLDA^.SQLD - 1 do
948
 
  begin
949
 
    {$R-}
950
 
    if (Field.FieldName = FSQLDA^.SQLVar[x].SQLName) then
951
 
    begin
952
 
      case Field.DataType of
953
 
        ftInteger :
954
 
          begin
955
 
            b := 0;
956
 
            Move(b, Buffer^, 4);
957
 
            Move(CurrBuff^, Buffer^, Field.Size);
958
 
          end;
959
 
        ftDate, ftTime, ftDateTime:
960
 
          GetDateTime(CurrBuff, Buffer, FSQLDA^.SQLVar[x].SQLType);
961
 
        ftString  :
962
 
          begin
963
 
            Move(CurrBuff^, Buffer^, Field.Size);
964
 
            PChar(Buffer + Field.Size)^ := #0;
965
 
          end;
966
 
        ftFloat   :
967
 
          GetFloat(CurrBuff, Buffer, Field);
968
 
      end;
969
 
 
970
 
      Result := True;
971
 
 
972
 
      Break;
973
 
    end
974
 
    else Inc(CurrBuff, FSQLDA^.SQLVar[x].SQLLen);
975
 
    {$R+}
976
 
  end;
977
 
end;
978
 
 
979
 
function TIBQuery.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
980
 
begin
981
 
  if FStatementType <> stSelect then
982
 
  begin
983
 
    Result := grEOF;
984
 
    Exit;
985
 
  end;
986
 
  if FIsEOF then
987
 
    Result := grEOF
988
 
  else begin
989
 
    Result := grOK;
990
 
    case GetMode of
991
 
      gmPrior :
992
 
        if FCurrentRecord <= 0 then
993
 
        begin
994
 
          Result := grBOF;
995
 
          FCurrentRecord := -1;
996
 
        end
997
 
        else Dec(FCurrentRecord);
998
 
      gmCurrent :
999
 
        if (FCurrentRecord < 0) or (FCurrentRecord >= RecordCount) then
1000
 
          Result := grError;
1001
 
      gmNext :
1002
 
        if FCurrentRecord >= (RecordCount - 1) then
1003
 
        begin
1004
 
          Result := LoadBufferFromSQLDA(Buffer);
1005
 
          if Result = grOK then
1006
 
          begin
1007
 
            Inc(FCurrentRecord);
1008
 
            Inc(FRecordCount);
1009
 
          end;
1010
 
        end
1011
 
        else Inc(FCurrentRecord);
1012
 
    end;
1013
 
  end;
1014
 
 
1015
 
  if Result = grOK then
1016
 
  begin
1017
 
    with PIBBookmark(Buffer + FRecordSize)^ do
1018
 
    begin
1019
 
      BookmarkData := FCurrentRecord;
1020
 
      BookmarkFlag := bfCurrent;
1021
 
    end;
1022
 
  end
1023
 
  else if (Result = grError) then
1024
 
    DatabaseError('No record');
1025
 
end;
1026
 
 
1027
 
function TIBQuery.GetRecordCount: integer;
1028
 
begin
1029
 
  Result := FRecordCount;
1030
 
end;
1031
 
 
1032
 
function TIBQuery.GetRecordSize: Word;
1033
 
begin
1034
 
  Result := FRecordSize;
1035
 
end;
1036
 
 
1037
 
procedure TIBQuery.InternalAddRecord(Buffer: Pointer; AAppend: Boolean);
1038
 
begin
1039
 
  // not implemented - sql dataset
1040
 
end;
1041
 
 
1042
 
procedure TIBQuery.InternalClose;
1043
 
begin
1044
 
  FreeFldBuffers;
1045
 
  FreeStatement;
1046
 
  if DefaultFields then
1047
 
    DestroyFields;
1048
 
  FIsEOF := False;
1049
 
  FCurrentRecord := -1;
1050
 
  FBufferSize := 0;
1051
 
  FRecordSize := 0;
1052
 
  FRecordCount:= 0;
1053
 
  FOpen:=False;
1054
 
end;
1055
 
 
1056
 
procedure TIBQuery.InternalDelete;
1057
 
begin
1058
 
  // not implemented - sql dataset
1059
 
end;
1060
 
 
1061
 
procedure TIBQuery.InternalFirst;
1062
 
begin
1063
 
  FCurrentRecord := -1;
1064
 
end;
1065
 
 
1066
 
procedure TIBQuery.InternalGotoBookmark(ABookmark: Pointer);
1067
 
begin
1068
 
  FCurrentRecord := PInteger(ABookmark)^;
1069
 
end;
1070
 
 
1071
 
procedure TIBQuery.InternalHandleException;
1072
 
begin
1073
 
end;
1074
 
 
1075
 
procedure TIBQuery.InternalInitFieldDefs;
1076
 
var
1077
 
  x         : integer;
1078
 
  lenset    : boolean;
1079
 
  TransLen  : word;
1080
 
  TransType : TFieldType;
1081
 
begin
1082
 
  if FLoadingFieldDefs then
1083
 
    Exit;
1084
 
 
1085
 
  FLoadingFieldDefs := True;
1086
 
 
1087
 
  try
1088
 
    FieldDefs.Clear;
1089
 
    {$R-}
1090
 
    for x := 0 to FSQLDA^.SQLD - 1 do
1091
 
    begin
1092
 
      TranslateFldType(FSQLDA^.SQLVar[x].SQLType, FSQLDA^.SQLVar[x].SQLLen, lenset,
1093
 
        TransType, TransLen);
1094
 
      TFieldDef.Create(FieldDefs, FSQLDA^.SQLVar[x].SQLName, TransType,
1095
 
        TransLen, False, (x + 1));
1096
 
    end;
1097
 
    {$R+}
1098
 
  finally
1099
 
    FLoadingFieldDefs := False;
1100
 
  end;
1101
 
end;
1102
 
 
1103
 
procedure TIBQuery.InternalInitRecord(Buffer: PChar);
1104
 
begin
1105
 
  FillChar(Buffer^, FBufferSize, #0);
1106
 
end;
1107
 
 
1108
 
procedure TIBQuery.InternalLast;
1109
 
begin
1110
 
  FCurrentRecord := RecordCount;
1111
 
end;
1112
 
 
1113
 
procedure TIBQuery.InternalOpen;
1114
 
begin
1115
 
  try
1116
 
    AllocStatement;
1117
 
    PrepareStatement;
1118
 
    GetStatementType;
1119
 
    if FStatementType in [stSelect] then
1120
 
    begin
1121
 
      DescribeStatement;
1122
 
      AllocFldBuffers;
1123
 
      Execute;
1124
 
      FOpen:=True;
1125
 
      InternalInitFieldDefs;
1126
 
      if DefaultFields then
1127
 
        CreateFields;
1128
 
      SetFieldSizes;
1129
 
      BindFields(True);
1130
 
    end
1131
 
    else Execute;
1132
 
  except
1133
 
    on E:Exception do
1134
 
      raise;
1135
 
  end;
1136
 
end;
1137
 
 
1138
 
procedure TIBQuery.InternalPost;
1139
 
begin
1140
 
  // not implemented - sql dataset
1141
 
end;
1142
 
 
1143
 
procedure TIBQuery.InternalSetToRecord(Buffer: PChar);
1144
 
begin
1145
 
  FCurrentRecord := PIBBookmark(Buffer + FRecordSize)^.BookmarkData;
1146
 
end;
1147
 
 
1148
 
function TIBQuery.IsCursorOpen: Boolean;
1149
 
begin
1150
 
  Result := FOpen;
1151
 
end;
1152
 
 
1153
 
procedure TIBQuery.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
1154
 
begin
1155
 
  PIBBookmark(Buffer + FRecordSize)^.BookmarkFlag := Value;
1156
 
end;
1157
 
 
1158
 
procedure TIBQuery.SetBookmarkData(Buffer: PChar; Data: Pointer);
1159
 
begin
1160
 
  PIBBookmark(Buffer + FRecordSize)^.BookmarkData := PInteger(Data)^;
1161
 
end;
1162
 
 
1163
 
procedure TIBQuery.SetFieldData(Field: TField; Buffer: Pointer);
1164
 
begin
1165
 
end;
1166
 
 
1167
 
// public part
1168
 
 
1169
 
procedure TIBQuery.ExecSQL;
1170
 
begin
1171
 
  AllocStatement;
1172
 
  try
1173
 
    PrepareStatement;
1174
 
    GetStatementType;
1175
 
    Execute;
1176
 
  finally
1177
 
    FreeStatement;
1178
 
  end;
1179
 
end;
1180
 
 
1181
 
constructor TIBQuery.Create(AOwner : TComponent);
1182
 
begin
1183
 
  inherited Create(AOwner);
1184
 
  FSQL := TStringList.Create;
1185
 
  FCurrentRecord := -1;
1186
 
  AllocSQLDA(10);
1187
 
end;
1188
 
 
1189
 
destructor TIBQuery.Destroy;
1190
 
begin
1191
 
  if Active then Close;
1192
 
  FSQL.Free;
1193
 
  inherited Destroy;
1194
 
  FreeMem(FSQLDA);
1195
 
end;
1196
 
 
1197
 
{ TIBStoredProc }
1198
 
 
1199
 
end.
1200
 
 
1201
 
{
1202
 
  $Log: interbase.pp,v $
1203
 
  Revision 1.12  2004/05/01 23:56:59  michael
1204
 
  + Published TDataset properties
1205
 
 
1206
 
  Revision 1.11  2003/12/07 23:13:34  sg
1207
 
  * Added Log entries to end of file
1208
 
 
1209
 
}