1 |
{************************************************************************} |
2 |
{ } |
3 |
{ Borland Delphi Visual Component Library } |
4 |
{ InterBase Express core components } |
5 |
{ } |
6 |
{ Copyright (c) 1998-2000 Inprise Corporation } |
7 |
{ } |
8 |
{ InterBase Express is based in part on the product } |
9 |
{ Free IB Components, written by Gregory H. Deatz for } |
10 |
{ Hoagland, Longo, Moran, Dunst & Doukas Company. } |
11 |
{ Free IB Components is used under license. } |
12 |
{ } |
13 |
{ The contents of this file are subject to the InterBase } |
14 |
{ Public License Version 1.0 (the "License"); you may not } |
15 |
{ use this file except in compliance with the License. You } |
16 |
{ may obtain a copy of the License at http://www.Inprise.com/IPL.html } |
17 |
{ Software distributed under the License is distributed on } |
18 |
{ an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either } |
19 |
{ express or implied. See the License for the specific language } |
20 |
{ governing rights and limitations under the License. } |
21 |
{ The Original Code was created by InterBase Software Corporation } |
22 |
{ and its successors. } |
23 |
{ Portions created by Inprise Corporation are Copyright (C) Inprise } |
24 |
{ Corporation. All Rights Reserved. } |
25 |
{ Contributor(s): Jeff Overcash } |
26 |
{ } |
27 |
{************************************************************************} |
28 |
|
29 |
unit IBCustomDataSet; |
30 |
|
31 |
interface |
32 |
|
33 |
uses |
34 |
Windows, SysUtils, Classes, Forms, Controls, StdVCL, |
35 |
IBExternals, IB, IBHeader, IBDatabase, IBSQL, Db, |
36 |
IBUtils, IBBlob; |
37 |
|
38 |
const |
39 |
BufferCacheSize = 1000; { Allocate cache in this many record chunks} |
40 |
UniCache = 2; { Uni-directional cache is 2 records big } |
41 |
|
42 |
type |
43 |
TIBCustomDataSet = class; |
44 |
TIBDataSet = class; |
45 |
|
46 |
TIBDataSetUpdateObject = class(TComponent) |
47 |
private |
48 |
FRefreshSQL: TStrings; |
49 |
procedure SetRefreshSQL(value: TStrings); |
50 |
protected |
51 |
function GetDataSet: TIBCustomDataSet; virtual; abstract; |
52 |
procedure SetDataSet(ADataSet: TIBCustomDataSet); virtual; abstract; |
53 |
procedure Apply(UpdateKind: TUpdateKind); virtual; abstract; |
54 |
function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract; |
55 |
property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet; |
56 |
public |
57 |
constructor Create(AOwner: TComponent); override; |
58 |
destructor Destroy; override; |
59 |
published |
60 |
property RefreshSQL: TStrings read FRefreshSQL write SetRefreshSQL; |
61 |
end; |
62 |
|
63 |
PDateTime = ^TDateTime; |
64 |
TBlobDataArray = array[0..0] of TIBBlobStream; |
65 |
PBlobDataArray = ^TBlobDataArray; |
66 |
|
67 |
{ TIBCustomDataSet } |
68 |
TFieldData = record |
69 |
fdDataType: Short; |
70 |
fdDataScale: Short; |
71 |
fdNullable: Boolean; |
72 |
fdIsNull: Boolean; |
73 |
fdDataSize: Short; |
74 |
fdDataLength: Short; |
75 |
fdDataOfs: Integer; |
76 |
end; |
77 |
PFieldData = ^TFieldData; |
78 |
|
79 |
TCachedUpdateStatus = ( |
80 |
cusUnmodified, cusModified, cusInserted, |
81 |
cusDeleted, cusUninserted |
82 |
); |
83 |
TIBDBKey = record |
84 |
DBKey: array[0..7] of Byte; |
85 |
end; |
86 |
PIBDBKey = ^TIBDBKey; |
87 |
|
88 |
TRecordData = record |
89 |
rdBookmarkFlag: TBookmarkFlag; |
90 |
rdFieldCount: Short; |
91 |
rdRecordNumber: Long; |
92 |
rdCachedUpdateStatus: TCachedUpdateStatus; |
93 |
rdUpdateStatus: TUpdateStatus; |
94 |
rdSavedOffset: DWORD; |
95 |
rdDBKey: TIBDBKey; |
96 |
rdFields: array[1..1] of TFieldData; |
97 |
end; |
98 |
PRecordData = ^TRecordData; |
99 |
|
100 |
{ TIBStringField allows us to have strings longer than 8196 } |
101 |
|
102 |
TIBStringField = class(TStringField) |
103 |
public |
104 |
constructor create(AOwner: TComponent); override; |
105 |
class procedure CheckTypeSize(Value: Integer); override; |
106 |
function GetAsString: string; override; |
107 |
function GetAsVariant: Variant; override; |
108 |
function GetValue(var Value: string): Boolean; |
109 |
procedure SetAsString(const Value: string); override; |
110 |
end; |
111 |
|
112 |
{ TIBBCDField } |
113 |
{ Actually, there is no BCD involved in this type, |
114 |
instead it deals with currency types. |
115 |
In IB, this is an encapsulation of Numeric (x, y) |
116 |
where x < 18 and y <= 4. |
117 |
Note: y > 4 will default to Floats |
118 |
} |
119 |
TIBBCDField = class(TBCDField) |
120 |
protected |
121 |
class procedure CheckTypeSize(Value: Integer); override; |
122 |
function GetAsCurrency: Currency; override; |
123 |
function GetAsString: string; override; |
124 |
function GetAsVariant: Variant; override; |
125 |
function GetDataSize: Integer; override; |
126 |
public |
127 |
constructor Create(AOwner: TComponent); override; |
128 |
published |
129 |
property Size default 8; |
130 |
end; |
131 |
|
132 |
TIBDataLink = class(TDetailDataLink) |
133 |
private |
134 |
FDataSet: TIBCustomDataSet; |
135 |
protected |
136 |
procedure ActiveChanged; override; |
137 |
procedure RecordChanged(Field: TField); override; |
138 |
function GetDetailDataSet: TDataSet; override; |
139 |
procedure CheckBrowseMode; override; |
140 |
public |
141 |
constructor Create(ADataSet: TIBCustomDataSet); |
142 |
destructor Destroy; override; |
143 |
end; |
144 |
|
145 |
{ TIBCustomDataSet } |
146 |
TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied); |
147 |
|
148 |
TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError; |
149 |
UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction) |
150 |
of object; |
151 |
TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind; |
152 |
var UpdateAction: TIBUpdateAction) of object; |
153 |
|
154 |
TIBUpdateRecordTypes = set of TCachedUpdateStatus; |
155 |
|
156 |
TIBCustomDataSet = class(TDataset) |
157 |
private |
158 |
FNeedsRefresh: Boolean; |
159 |
FForcedRefresh: Boolean; |
160 |
FDidActivate: Boolean; |
161 |
FIBLoaded: Boolean; |
162 |
FBase: TIBBase; |
163 |
FBlobCacheOffset: Integer; |
164 |
FBlobStreamList: TList; |
165 |
FBufferChunks: Integer; |
166 |
FBufferCache, |
167 |
FOldBufferCache: PChar; |
168 |
FBufferChunkSize, |
169 |
FCacheSize, |
170 |
FOldCacheSize: Integer; |
171 |
FFilterBuffer: PChar; |
172 |
FBPos, |
173 |
FOBPos, |
174 |
FBEnd, |
175 |
FOBEnd: DWord; |
176 |
FCachedUpdates: Boolean; |
177 |
FCalcFieldsOffset: Integer; |
178 |
FCurrentRecord: Long; |
179 |
FDeletedRecords: Long; |
180 |
FModelBuffer, |
181 |
FOldBuffer: PChar; |
182 |
FOpen: Boolean; |
183 |
FInternalPrepared: Boolean; |
184 |
FQDelete, |
185 |
FQInsert, |
186 |
FQRefresh, |
187 |
FQSelect, |
188 |
FQModify: TIBSQL; |
189 |
FRecordBufferSize: Integer; |
190 |
FRecordCount: Integer; |
191 |
FRecordSize: Integer; |
192 |
FUniDirectional: Boolean; |
193 |
FUpdateMode: TUpdateMode; |
194 |
FUpdateObject: TIBDataSetUpdateObject; |
195 |
FParamCheck: Boolean; |
196 |
FUpdatesPending: Boolean; |
197 |
FUpdateRecordTypes: TIBUpdateRecordTypes; |
198 |
FMappedFieldPosition: array of Integer; |
199 |
FDataLink: TIBDataLink; |
200 |
|
201 |
FBeforeDatabaseDisconnect, |
202 |
FAfterDatabaseDisconnect, |
203 |
FDatabaseFree: TNotifyEvent; |
204 |
FOnUpdateError: TIBUpdateErrorEvent; |
205 |
FOnUpdateRecord: TIBUpdateRecordEvent; |
206 |
FBeforeTransactionEnd, |
207 |
FAfterTransactionEnd, |
208 |
FTransactionFree: TNotifyEvent; |
209 |
|
210 |
function GetSelectStmtHandle: TISC_STMT_HANDLE; |
211 |
procedure SetUpdateMode(const Value: TUpdateMode); |
212 |
procedure SetUpdateObject(Value: TIBDataSetUpdateObject); |
213 |
|
214 |
function AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode): TGetResult; |
215 |
procedure AdjustRecordOnInsert(Buffer: Pointer); |
216 |
function CanEdit: Boolean; |
217 |
function CanInsert: Boolean; |
218 |
function CanDelete: Boolean; |
219 |
function CanRefresh: Boolean; |
220 |
procedure CheckEditState; |
221 |
procedure ClearBlobCache; |
222 |
procedure CopyRecordBuffer(Source, Dest: Pointer); |
223 |
procedure DoBeforeDatabaseDisconnect(Sender: TObject); |
224 |
procedure DoAfterDatabaseDisconnect(Sender: TObject); |
225 |
procedure DoDatabaseFree(Sender: TObject); |
226 |
procedure DoBeforeTransactionEnd(Sender: TObject); |
227 |
procedure DoAfterTransactionEnd(Sender: TObject); |
228 |
procedure DoTransactionFree(Sender: TObject); |
229 |
procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer; |
230 |
Buffer: PChar); |
231 |
function GetDatabase: TIBDatabase; |
232 |
function GetDBHandle: PISC_DB_HANDLE; |
233 |
function GetDeleteSQL: TStrings; |
234 |
function GetInsertSQL: TStrings; |
235 |
function GetSQLParams: TIBXSQLDA; |
236 |
function GetRefreshSQL: TStrings; |
237 |
function GetSelectSQL: TStrings; |
238 |
function GetStatementType: TIBSQLTypes; |
239 |
function GetModifySQL: TStrings; |
240 |
function GetTransaction: TIBTransaction; |
241 |
function GetTRHandle: PISC_TR_HANDLE; |
242 |
procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); |
243 |
function InternalLocate(const KeyFields: string; const KeyValues: Variant; |
244 |
Options: TLocateOptions): Boolean; virtual; |
245 |
procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); |
246 |
procedure InternalRevertRecord(RecordNumber: Integer); |
247 |
function IsVisible(Buffer: PChar): Boolean; |
248 |
procedure SaveOldBuffer(Buffer: PChar); |
249 |
procedure SetBufferChunks(Value: Integer); |
250 |
procedure SetDatabase(Value: TIBDatabase); |
251 |
procedure SetDeleteSQL(Value: TStrings); |
252 |
procedure SetInsertSQL(Value: TStrings); |
253 |
procedure SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer); |
254 |
procedure SetRefreshSQL(Value: TStrings); |
255 |
procedure SetSelectSQL(Value: TStrings); |
256 |
procedure SetModifySQL(Value: TStrings); |
257 |
procedure SetTransaction(Value: TIBTransaction); |
258 |
procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes); |
259 |
procedure SetUniDirectional(Value: Boolean); |
260 |
procedure RefreshParams; |
261 |
procedure SQLChanging(Sender: TObject); virtual; |
262 |
function AdjustPosition(FCache: PChar; Offset: DWORD; |
263 |
Origin: Integer): Integer; |
264 |
procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer; |
265 |
Buffer: PChar); |
266 |
procedure ReadRecordCache(RecordNumber: Integer; Buffer: PChar; |
267 |
ReadOldBuffer: Boolean); |
268 |
procedure WriteCache(FCache: PChar; Offset: DWORD; Origin: Integer; |
269 |
Buffer: PChar); |
270 |
procedure WriteRecordCache(RecordNumber: Integer; Buffer: PChar); |
271 |
function InternalGetRecord(Buffer: PChar; GetMode: TGetMode; |
272 |
DoCheck: Boolean): TGetResult; |
273 |
|
274 |
protected |
275 |
procedure ActivateConnection; |
276 |
function ActivateTransaction: Boolean; |
277 |
procedure DeactivateTransaction; |
278 |
procedure CheckDatasetClosed; |
279 |
procedure CheckDatasetOpen; |
280 |
function GetActiveBuf: PChar; |
281 |
procedure InternalBatchInput(InputObject: TIBBatchInput); |
282 |
procedure InternalBatchOutput(OutputObject: TIBBatchOutput); |
283 |
procedure InternalPrepare; virtual; |
284 |
procedure InternalUnPrepare; virtual; |
285 |
procedure InternalExecQuery; virtual; |
286 |
procedure InternalRefreshRow; virtual; |
287 |
procedure InternalSetParamsFromCursor; |
288 |
procedure CheckNotUniDirectional; |
289 |
|
290 |
{ IProviderSupport } |
291 |
procedure PSEndTransaction(Commit: Boolean); override; |
292 |
function PSExecuteStatement(const ASQL: string; AParams: TParams; |
293 |
ResultSet: Pointer = nil): Integer; override; |
294 |
function PsGetTableName: string; override; |
295 |
function PSGetQuoteChar: string; override; |
296 |
function PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; override; |
297 |
function PSInTransaction: Boolean; override; |
298 |
function PSIsSQLBased: Boolean; override; |
299 |
function PSIsSQLSupported: Boolean; override; |
300 |
procedure PSStartTransaction; override; |
301 |
procedure PSReset; override; |
302 |
function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override; |
303 |
|
304 |
{ TDataSet support } |
305 |
procedure InternalInsert; override; |
306 |
procedure InitRecord(Buffer: PChar); override; |
307 |
procedure Disconnect; virtual; |
308 |
function ConstraintsStored: Boolean; |
309 |
procedure ClearCalcFields(Buffer: PChar); override; |
310 |
function AllocRecordBuffer: PChar; override; |
311 |
procedure DoBeforeDelete; override; |
312 |
procedure DoBeforeEdit; override; |
313 |
procedure DoBeforeInsert; override; |
314 |
procedure FreeRecordBuffer(var Buffer: PChar); override; |
315 |
procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override; |
316 |
function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override; |
317 |
function GetCanModify: Boolean; override; |
318 |
function GetDataSource: TDataSource; override; |
319 |
function GetFieldClass(FieldType: TFieldType): TFieldClass; override; |
320 |
function GetRecNo: Integer; override; |
321 |
function GetRecord(Buffer: PChar; GetMode: TGetMode; |
322 |
DoCheck: Boolean): TGetResult; override; |
323 |
function GetRecordCount: Integer; override; |
324 |
function GetRecordSize: Word; override; |
325 |
procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override; |
326 |
procedure InternalCancel; override; |
327 |
procedure InternalClose; override; |
328 |
procedure InternalDelete; override; |
329 |
procedure InternalFirst; override; |
330 |
function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean; |
331 |
procedure InternalGotoBookmark(Bookmark: Pointer); override; |
332 |
procedure InternalHandleException; override; |
333 |
procedure InternalInitFieldDefs; override; |
334 |
procedure InternalInitRecord(Buffer: PChar); override; |
335 |
procedure InternalLast; override; |
336 |
procedure InternalOpen; override; |
337 |
procedure InternalPost; override; |
338 |
procedure InternalRefresh; override; |
339 |
procedure InternalSetFieldData(Field: TField; Buffer: Pointer); |
340 |
procedure InternalSetToRecord(Buffer: PChar); override; |
341 |
function IsCursorOpen: Boolean; override; |
342 |
procedure ReQuery; |
343 |
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override; |
344 |
procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override; |
345 |
procedure SetCachedUpdates(Value: Boolean); |
346 |
procedure SetDataSource(Value: TDataSource); |
347 |
procedure SetFieldData(Field : TField; Buffer : Pointer); override; |
348 |
procedure SetFieldData(Field : TField; Buffer : Pointer; |
349 |
NativeFormat : Boolean); overload; override; |
350 |
procedure SetRecNo(Value: Integer); override; |
351 |
|
352 |
protected |
353 |
{Likely to be made public by descendant classes} |
354 |
property SQLParams: TIBXSQLDA read GetSQLParams; |
355 |
property Params: TIBXSQLDA read GetSQLParams; |
356 |
property InternalPrepared: Boolean read FInternalPrepared; |
357 |
property QDelete: TIBSQL read FQDelete; |
358 |
property QInsert: TIBSQL read FQInsert; |
359 |
property QRefresh: TIBSQL read FQRefresh; |
360 |
property QSelect: TIBSQL read FQSelect; |
361 |
property QModify: TIBSQL read FQModify; |
362 |
property StatementType: TIBSQLTypes read GetStatementType; |
363 |
property SelectStmtHandle: TISC_STMT_HANDLE read GetSelectStmtHandle; |
364 |
|
365 |
{Likely to be made published by descendant classes} |
366 |
property BufferChunks: Integer read FBufferChunks write SetBufferChunks; |
367 |
property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates; |
368 |
property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False; |
369 |
property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL; |
370 |
property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL; |
371 |
property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL; |
372 |
property SelectSQL: TStrings read GetSelectSQL write SetSelectSQL; |
373 |
property ModifySQL: TStrings read GetModifySQL write SetModifySQL; |
374 |
property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll; |
375 |
property ParamCheck: Boolean read FParamCheck write FParamCheck default True; |
376 |
|
377 |
property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect |
378 |
write FBeforeDatabaseDisconnect; |
379 |
property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect |
380 |
write FAfterDatabaseDisconnect; |
381 |
property DatabaseFree: TNotifyEvent read FDatabaseFree |
382 |
write FDatabaseFree; |
383 |
property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd |
384 |
write FBeforeTransactionEnd; |
385 |
property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd |
386 |
write FAfterTransactionEnd; |
387 |
property TransactionFree: TNotifyEvent read FTransactionFree |
388 |
write FTransactionFree; |
389 |
|
390 |
public |
391 |
constructor Create(AOwner: TComponent); override; |
392 |
destructor Destroy; override; |
393 |
procedure ApplyUpdates; |
394 |
function CachedUpdateStatus: TCachedUpdateStatus; |
395 |
procedure CancelUpdates; |
396 |
procedure FetchAll; |
397 |
function LocateNext(const KeyFields: string; const KeyValues: Variant; |
398 |
Options: TLocateOptions): Boolean; |
399 |
procedure RecordModified(Value: Boolean); |
400 |
procedure RevertRecord; |
401 |
procedure Undelete; |
402 |
|
403 |
{ TDataSet support methods } |
404 |
function BookmarkValid(Bookmark: TBookmark): Boolean; override; |
405 |
function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override; |
406 |
function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override; |
407 |
function GetCurrentRecord(Buffer: PChar): Boolean; override; |
408 |
function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override; |
409 |
function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; override; |
410 |
function GetFieldData(Field : TField; Buffer : Pointer; |
411 |
NativeFormat : Boolean) : Boolean; overload; override; |
412 |
function Locate(const KeyFields: string; const KeyValues: Variant; |
413 |
Options: TLocateOptions): Boolean; override; |
414 |
function Lookup(const KeyFields: string; const KeyValues: Variant; |
415 |
const ResultFields: string): Variant; override; |
416 |
function UpdateStatus: TUpdateStatus; override; |
417 |
function IsSequenced: Boolean; override; |
418 |
|
419 |
property DBHandle: PISC_DB_HANDLE read GetDBHandle; |
420 |
property TRHandle: PISC_TR_HANDLE read GetTRHandle; |
421 |
property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject; |
422 |
property UpdatesPending: Boolean read FUpdatesPending; |
423 |
property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes |
424 |
write SetUpdateRecordTypes; |
425 |
|
426 |
published |
427 |
property Database: TIBDatabase read GetDatabase write SetDatabase; |
428 |
property Transaction: TIBTransaction read GetTransaction |
429 |
write SetTransaction; |
430 |
property ForcedRefresh: Boolean read FForcedRefresh |
431 |
write FForcedRefresh default False; |
432 |
property AutoCalcFields; |
433 |
property ObjectView default False; |
434 |
|
435 |
property AfterCancel; |
436 |
property AfterClose; |
437 |
property AfterDelete; |
438 |
property AfterEdit; |
439 |
property AfterInsert; |
440 |
property AfterOpen; |
441 |
property AfterPost; |
442 |
property AfterRefresh; |
443 |
property AfterScroll; |
444 |
property BeforeCancel; |
445 |
property BeforeClose; |
446 |
property BeforeDelete; |
447 |
property BeforeEdit; |
448 |
property BeforeInsert; |
449 |
property BeforeOpen; |
450 |
property BeforePost; |
451 |
property BeforeRefresh; |
452 |
property BeforeScroll; |
453 |
property OnCalcFields; |
454 |
property OnDeleteError; |
455 |
property OnEditError; |
456 |
property OnNewRecord; |
457 |
property OnPostError; |
458 |
property OnUpdateError: TIBUpdateErrorEvent read FOnUpdateError |
459 |
write FOnUpdateError; |
460 |
property OnUpdateRecord: TIBUpdateRecordEvent read FOnUpdateRecord |
461 |
write FOnUpdateRecord; |
462 |
end; |
463 |
|
464 |
TIBDataSet = class(TIBCustomDataSet) |
465 |
private |
466 |
function GetPrepared: Boolean; |
467 |
|
468 |
protected |
469 |
procedure SetFiltered(Value: Boolean); override; |
470 |
procedure InternalOpen; override; |
471 |
|
472 |
public |
473 |
procedure Prepare; |
474 |
procedure UnPrepare; |
475 |
procedure BatchInput(InputObject: TIBBatchInput); |
476 |
procedure BatchOutput(OutputObject: TIBBatchOutput); |
477 |
procedure ExecSQL; |
478 |
|
479 |
public |
480 |
property Params; |
481 |
property Prepared : Boolean read GetPrepared; |
482 |
property QDelete; |
483 |
property QInsert; |
484 |
property QRefresh; |
485 |
property QSelect; |
486 |
property QModify; |
487 |
property StatementType; |
488 |
property SelectStmtHandle; |
489 |
|
490 |
published |
491 |
{ TIBCustomDataSet } |
492 |
property BufferChunks; |
493 |
property CachedUpdates; |
494 |
property DeleteSQL; |
495 |
property InsertSQL; |
496 |
property RefreshSQL; |
497 |
property SelectSQL; |
498 |
property ModifySQL; |
499 |
property ParamCheck; |
500 |
property UniDirectional; |
501 |
property Filtered; |
502 |
|
503 |
property BeforeDatabaseDisconnect; |
504 |
property AfterDatabaseDisconnect; |
505 |
property DatabaseFree; |
506 |
property BeforeTransactionEnd; |
507 |
property AfterTransactionEnd; |
508 |
property TransactionFree; |
509 |
|
510 |
{ TIBDataSet } |
511 |
property Active; |
512 |
property AutoCalcFields; |
513 |
property DataSource read GetDataSource write SetDataSource; |
514 |
|
515 |
property AfterCancel; |
516 |
property AfterClose; |
517 |
property AfterDelete; |
518 |
property AfterEdit; |
519 |
property AfterInsert; |
520 |
property AfterOpen; |
521 |
property AfterPost; |
522 |
property AfterScroll; |
523 |
property BeforeCancel; |
524 |
property BeforeClose; |
525 |
property BeforeDelete; |
526 |
property BeforeEdit; |
527 |
property BeforeInsert; |
528 |
property BeforeOpen; |
529 |
property BeforePost; |
530 |
property BeforeScroll; |
531 |
property OnCalcFields; |
532 |
property OnDeleteError; |
533 |
property OnEditError; |
534 |
property OnFilterRecord; |
535 |
property OnNewRecord; |
536 |
property OnPostError; |
537 |
end; |
538 |
|
539 |
{ TIBDSBlobStream } |
540 |
TIBDSBlobStream = class(TStream) |
541 |
protected |
542 |
FField: TField; |
543 |
FBlobStream: TIBBlobStream; |
544 |
public |
545 |
constructor Create(AField: TField; ABlobStream: TIBBlobStream; |
546 |
Mode: TBlobStreamMode); |
547 |
function Read(var Buffer; Count: Longint): Longint; override; |
548 |
function Seek(Offset: Longint; Origin: Word): Longint; override; |
549 |
procedure SetSize(NewSize: Longint); override; |
550 |
function Write(const Buffer; Count: Longint): Longint; override; |
551 |
end; |
552 |
|
553 |
const |
554 |
DefaultFieldClasses: array[TFieldType] of TFieldClass = ( |
555 |
nil, { ftUnknown } |
556 |
TIBStringField, { ftString } |
557 |
TSmallintField, { ftSmallint } |
558 |
TIntegerField, { ftInteger } |
559 |
TWordField, { ftWord } |
560 |
TBooleanField, { ftBoolean } |
561 |
TFloatField, { ftFloat } |
562 |
TCurrencyField, { ftCurrency } |
563 |
TIBBCDField, { ftBCD } |
564 |
TDateField, { ftDate } |
565 |
TTimeField, { ftTime } |
566 |
TDateTimeField, { ftDateTime } |
567 |
TBytesField, { ftBytes } |
568 |
TVarBytesField, { ftVarBytes } |
569 |
TAutoIncField, { ftAutoInc } |
570 |
TBlobField, { ftBlob } |
571 |
TMemoField, { ftMemo } |
572 |
TGraphicField, { ftGraphic } |
573 |
TBlobField, { ftFmtMemo } |
574 |
TBlobField, { ftParadoxOle } |
575 |
TBlobField, { ftDBaseOle } |
576 |
TBlobField, { ftTypedBinary } |
577 |
nil, { ftCursor } |
578 |
TStringField, { ftFixedChar } |
579 |
nil, {TWideStringField } { ftWideString } |
580 |
TLargeIntField, { ftLargeInt } |
581 |
TADTField, { ftADT } |
582 |
TArrayField, { ftArray } |
583 |
TReferenceField, { ftReference } |
584 |
TDataSetField, { ftDataSet } |
585 |
TBlobField, { ftOraBlob } |
586 |
TMemoField, { ftOraClob } |
587 |
TVariantField, { ftVariant } |
588 |
TInterfaceField, { ftInterface } |
589 |
TIDispatchField, { ftIDispatch } |
590 |
TGuidField); { ftGuid } |
591 |
var |
592 |
CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil; |
593 |
|
594 |
implementation |
595 |
|
596 |
uses IBIntf, IBQuery; |
597 |
|
598 |
type |
599 |
|
600 |
TFieldNode = class(TObject) |
601 |
protected |
602 |
FieldName : String; |
603 |
COMPUTED_BLR : Boolean; |
604 |
DEFAULT_VALUE : boolean; |
605 |
NextField : TFieldNode; |
606 |
end; |
607 |
|
608 |
TRelationNode = class(TObject) |
609 |
protected |
610 |
RelationName : String; |
611 |
FieldNodes : TFieldNode; |
612 |
NextRelation : TRelationNode; |
613 |
end; |
614 |
|
615 |
|
616 |
{ TIBStringField} |
617 |
|
618 |
constructor TIBStringField.Create(AOwner: TComponent); |
619 |
begin |
620 |
inherited; |
621 |
end; |
622 |
|
623 |
class procedure TIBStringField.CheckTypeSize(Value: Integer); |
624 |
begin |
625 |
{ don't check string size. all sizes valid } |
626 |
end; |
627 |
|
628 |
function TIBStringField.GetAsString: string; |
629 |
begin |
630 |
if not GetValue(Result) then Result := ''; |
631 |
end; |
632 |
|
633 |
function TIBStringField.GetAsVariant: Variant; |
634 |
var |
635 |
S: string; |
636 |
begin |
637 |
if GetValue(S) then Result := S else Result := Null; |
638 |
end; |
639 |
|
640 |
function TIBStringField.GetValue(var Value: string): Boolean; |
641 |
var |
642 |
Buffer: PChar; |
643 |
begin |
644 |
Buffer := nil; |
645 |
IBAlloc(Buffer, 0, Size + 1); |
646 |
try |
647 |
Result := GetData(Buffer); |
648 |
if Result then |
649 |
begin |
650 |
Value := string(Buffer); |
651 |
if Transliterate and (Value <> '') then |
652 |
DataSet.Translate(PChar(Value), PChar(Value), False); |
653 |
end |
654 |
finally |
655 |
FreeMem(Buffer); |
656 |
end; |
657 |
end; |
658 |
|
659 |
procedure TIBStringField.SetAsString(const Value: string); |
660 |
var |
661 |
Buffer: PChar; |
662 |
begin |
663 |
Buffer := nil; |
664 |
IBAlloc(Buffer, 0, Size + 1); |
665 |
try |
666 |
StrLCopy(Buffer, PChar(Value), Size); |
667 |
if Transliterate then |
668 |
DataSet.Translate(Buffer, Buffer, True); |
669 |
SetData(Buffer); |
670 |
finally |
671 |
FreeMem(Buffer); |
672 |
end; |
673 |
end; |
674 |
|
675 |
{ TIBBCDField } |
676 |
|
677 |
constructor TIBBCDField.Create(AOwner: TComponent); |
678 |
begin |
679 |
inherited Create(AOwner); |
680 |
SetDataType(ftBCD); |
681 |
Size := 8; |
682 |
end; |
683 |
|
684 |
class procedure TIBBCDField.CheckTypeSize(Value: Integer); |
685 |
begin |
686 |
{ No need to check as the base type is currency, not BCD } |
687 |
end; |
688 |
|
689 |
function TIBBCDField.GetAsCurrency: Currency; |
690 |
begin |
691 |
if not GetValue(Result) then |
692 |
Result := 0; |
693 |
end; |
694 |
|
695 |
function TIBBCDField.GetAsString: string; |
696 |
var |
697 |
C: System.Currency; |
698 |
begin |
699 |
if GetValue(C) then |
700 |
Result := CurrToStr(C) |
701 |
else |
702 |
Result := ''; |
703 |
end; |
704 |
|
705 |
function TIBBCDField.GetAsVariant: Variant; |
706 |
var |
707 |
C: System.Currency; |
708 |
begin |
709 |
if GetValue(C) then |
710 |
Result := C |
711 |
else |
712 |
Result := Null; |
713 |
end; |
714 |
|
715 |
function TIBBCDField.GetDataSize: Integer; |
716 |
begin |
717 |
Result := 8; |
718 |
end; |
719 |
|
720 |
{ TIBDataLink } |
721 |
|
722 |
constructor TIBDataLink.Create(ADataSet: TIBCustomDataSet); |
723 |
begin |
724 |
inherited Create; |
725 |
FDataSet := ADataSet; |
726 |
end; |
727 |
|
728 |
destructor TIBDataLink.Destroy; |
729 |
begin |
730 |
FDataSet.FDataLink := nil; |
731 |
inherited; |
732 |
end; |
733 |
|
734 |
|
735 |
procedure TIBDataLink.ActiveChanged; |
736 |
begin |
737 |
if FDataSet.Active then |
738 |
FDataSet.RefreshParams; |
739 |
end; |
740 |
|
741 |
|
742 |
function TIBDataLink.GetDetailDataSet: TDataSet; |
743 |
begin |
744 |
Result := FDataSet; |
745 |
end; |
746 |
|
747 |
procedure TIBDataLink.RecordChanged(Field: TField); |
748 |
begin |
749 |
if (Field = nil) and FDataSet.Active then |
750 |
FDataSet.RefreshParams; |
751 |
end; |
752 |
|
753 |
procedure TIBDataLink.CheckBrowseMode; |
754 |
begin |
755 |
if FDataSet.Active then |
756 |
FDataSet.CheckBrowseMode; |
757 |
end; |
758 |
|
759 |
{ TIBCustomDataSet } |
760 |
|
761 |
constructor TIBCustomDataSet.Create(AOwner: TComponent); |
762 |
begin |
763 |
inherited; |
764 |
FIBLoaded := False; |
765 |
CheckIBLoaded; |
766 |
FIBLoaded := True; |
767 |
FBase := TIBBase.Create(Self); |
768 |
FCurrentRecord := -1; |
769 |
FDeletedRecords := 0; |
770 |
FUniDirectional := False; |
771 |
FBufferChunks := BufferCacheSize; |
772 |
FBlobStreamList := TList.Create; |
773 |
FDataLink := TIBDataLink.Create(Self); |
774 |
FQDelete := TIBSQL.Create(Self); |
775 |
FQDelete.OnSQLChanging := SQLChanging; |
776 |
FQDelete.GoToFirstRecordOnExecute := False; |
777 |
FQInsert := TIBSQL.Create(Self); |
778 |
FQInsert.OnSQLChanging := SQLChanging; |
779 |
FQInsert.GoToFirstRecordOnExecute := False; |
780 |
FQRefresh := TIBSQL.Create(Self); |
781 |
FQRefresh.OnSQLChanging := SQLChanging; |
782 |
FQRefresh.GoToFirstRecordOnExecute := False; |
783 |
FQSelect := TIBSQL.Create(Self); |
784 |
FQSelect.OnSQLChanging := SQLChanging; |
785 |
FQSelect.GoToFirstRecordOnExecute := False; |
786 |
FQModify := TIBSQL.Create(Self); |
787 |
FQModify.OnSQLChanging := SQLChanging; |
788 |
FQModify.GoToFirstRecordOnExecute := False; |
789 |
FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted]; |
790 |
FParamCheck := True; |
791 |
FForcedRefresh := False; |
792 |
{Bookmark Size is Integer for IBX} |
793 |
BookmarkSize := SizeOf(Integer); |
794 |
FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect; |
795 |
FBase.AfterDatabaseDisconnect := DoAfterDatabaseDisconnect; |
796 |
FBase.OnDatabaseFree := DoDatabaseFree; |
797 |
FBase.BeforeTransactionEnd := DoBeforeTransactionEnd; |
798 |
FBase.AfterTransactionEnd := DoAfterTransactionEnd; |
799 |
FBase.OnTransactionFree := DoTransactionFree; |
800 |
if AOwner is TIBDatabase then |
801 |
Database := TIBDatabase(AOwner) |
802 |
else |
803 |
if AOwner is TIBTransaction then |
804 |
Transaction := TIBTransaction(AOwner); |
805 |
end; |
806 |
|
807 |
destructor TIBCustomDataSet.Destroy; |
808 |
begin |
809 |
inherited; |
810 |
if FIBLoaded then |
811 |
begin |
812 |
FDataLink.Free; |
813 |
FBase.Free; |
814 |
ClearBlobCache; |
815 |
FBlobStreamList.Free; |
816 |
FreeMem(FBufferCache); |
817 |
FBufferCache := nil; |
818 |
FreeMem(FOldBufferCache); |
819 |
FOldBufferCache := nil; |
820 |
FCacheSize := 0; |
821 |
FOldCacheSize := 0; |
822 |
FMappedFieldPosition := nil; |
823 |
end; |
824 |
end; |
825 |
|
826 |
function TIBCustomDataSet.AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode): |
827 |
TGetResult; |
828 |
begin |
829 |
while not IsVisible(Buffer) do |
830 |
begin |
831 |
if GetMode = gmPrior then |
832 |
begin |
833 |
Dec(FCurrentRecord); |
834 |
if FCurrentRecord = -1 then |
835 |
begin |
836 |
result := grBOF; |
837 |
exit; |
838 |
end; |
839 |
ReadRecordCache(FCurrentRecord, Buffer, False); |
840 |
end |
841 |
else begin |
842 |
Inc(FCurrentRecord); |
843 |
if (FCurrentRecord = FRecordCount) then |
844 |
begin |
845 |
if (not FQSelect.EOF) and (FQSelect.Next <> nil) then |
846 |
begin |
847 |
FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer); |
848 |
Inc(FRecordCount); |
849 |
end |
850 |
else begin |
851 |
result := grEOF; |
852 |
exit; |
853 |
end; |
854 |
end |
855 |
else |
856 |
ReadRecordCache(FCurrentRecord, Buffer, False); |
857 |
end; |
858 |
end; |
859 |
result := grOK; |
860 |
end; |
861 |
|
862 |
procedure TIBCustomDataSet.ApplyUpdates; |
863 |
var |
864 |
CurBookmark: string; |
865 |
Buffer: PRecordData; |
866 |
CurUpdateTypes: TIBUpdateRecordTypes; |
867 |
UpdateAction: TIBUpdateAction; |
868 |
UpdateKind: TUpdateKind; |
869 |
bRecordsSkipped: Boolean; |
870 |
|
871 |
procedure GetUpdateKind; |
872 |
begin |
873 |
case Buffer^.rdCachedUpdateStatus of |
874 |
cusModified: |
875 |
UpdateKind := ukModify; |
876 |
cusInserted: |
877 |
UpdateKind := ukInsert; |
878 |
else |
879 |
UpdateKind := ukDelete; |
880 |
end; |
881 |
end; |
882 |
|
883 |
procedure ResetBufferUpdateStatus; |
884 |
begin |
885 |
case Buffer^.rdCachedUpdateStatus of |
886 |
cusModified: |
887 |
begin |
888 |
PRecordData(Buffer)^.rdUpdateStatus := usUnmodified; |
889 |
PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified; |
890 |
end; |
891 |
cusInserted: |
892 |
begin |
893 |
PRecordData(Buffer)^.rdUpdateStatus := usUnmodified; |
894 |
PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified; |
895 |
end; |
896 |
cusDeleted: |
897 |
begin |
898 |
PRecordData(Buffer)^.rdUpdateStatus := usDeleted; |
899 |
PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified; |
900 |
end; |
901 |
end; |
902 |
WriteRecordCache(PRecordData(Buffer)^.rdRecordNumber, Pointer(Buffer)); |
903 |
end; |
904 |
|
905 |
procedure UpdateUsingOnUpdateRecord; |
906 |
begin |
907 |
UpdateAction := uaFail; |
908 |
try |
909 |
FOnUpdateRecord(Self, UpdateKind, UpdateAction); |
910 |
except |
911 |
on E: Exception do |
912 |
begin |
913 |
if (E is EDatabaseError) and Assigned(FOnUpdateError) then |
914 |
FOnUpdateError(Self, EIBError(E), UpdateKind, UpdateAction); |
915 |
if UpdateAction = uaFail then |
916 |
raise; |
917 |
end; |
918 |
end; |
919 |
end; |
920 |
|
921 |
procedure UpdateUsingUpdateObject; |
922 |
begin |
923 |
try |
924 |
FUpdateObject.Apply(UpdateKind); |
925 |
ResetBufferUpdateStatus; |
926 |
except |
927 |
on E: Exception do |
928 |
if (E is EDatabaseError) and Assigned(FOnUpdateError) then |
929 |
FOnUpdateError(Self, EIBError(E), UpdateKind, UpdateAction); |
930 |
end; |
931 |
end; |
932 |
|
933 |
procedure UpdateUsingInternalquery; |
934 |
begin |
935 |
try |
936 |
case Buffer^.rdCachedUpdateStatus of |
937 |
cusModified: |
938 |
InternalPostRecord(FQModify, Buffer); |
939 |
cusInserted: |
940 |
InternalPostRecord(FQInsert, Buffer); |
941 |
cusDeleted: |
942 |
InternalDeleteRecord(FQDelete, Buffer); |
943 |
end; |
944 |
except |
945 |
on E: EIBError do begin |
946 |
UpdateAction := uaFail; |
947 |
if Assigned(FOnUpdateError) then |
948 |
FOnUpdateError(Self, E, UpdateKind, UpdateAction); |
949 |
case UpdateAction of |
950 |
uaFail: raise; |
951 |
uaAbort: SysUtils.Abort; |
952 |
uaSkip: bRecordsSkipped := True; |
953 |
end; |
954 |
end; |
955 |
end; |
956 |
end; |
957 |
|
958 |
begin |
959 |
if State in [dsEdit, dsInsert] then |
960 |
Post; |
961 |
FBase.CheckDatabase; |
962 |
FBase.CheckTransaction; |
963 |
DisableControls; |
964 |
CurBookmark := Bookmark; |
965 |
CurUpdateTypes := FUpdateRecordTypes; |
966 |
FUpdateRecordTypes := [cusModified, cusInserted, cusDeleted]; |
967 |
try |
968 |
First; |
969 |
bRecordsSkipped := False; |
970 |
while not EOF do |
971 |
begin |
972 |
Buffer := PRecordData(GetActiveBuf); |
973 |
GetUpdateKind; |
974 |
UpdateAction := uaApply; |
975 |
if Assigned(FUpdateObject) or Assigned(FOnUpdateRecord) then |
976 |
begin |
977 |
if (Assigned(FOnUpdateRecord)) then |
978 |
UpdateUsingOnUpdateRecord |
979 |
else |
980 |
if Assigned(FUpdateObject) then |
981 |
UpdateUsingUpdateObject; |
982 |
case UpdateAction of |
983 |
uaFail: |
984 |
IBError(ibxeUserAbort, [nil]); |
985 |
uaAbort: |
986 |
SysUtils.Abort; |
987 |
uaApplied: |
988 |
ResetBufferUpdateStatus; |
989 |
uaSkip: |
990 |
bRecordsSkipped := True; |
991 |
uaRetry: |
992 |
Continue; |
993 |
end; |
994 |
end; |
995 |
if (not Assigned(FUpdateObject)) and (UpdateAction = UaApply) then |
996 |
begin |
997 |
UpdateUsingInternalquery; |
998 |
UpdateAction := uaApplied; |
999 |
end; |
1000 |
Next; |
1001 |
end; |
1002 |
FUpdatesPending := bRecordsSkipped; |
1003 |
finally |
1004 |
FUpdateRecordTypes := CurUpdateTypes; |
1005 |
Bookmark := CurBookmark; |
1006 |
EnableControls; |
1007 |
end; |
1008 |
end; |
1009 |
|
1010 |
procedure TIBCustomDataSet.InternalBatchInput(InputObject: TIBBatchInput); |
1011 |
begin |
1012 |
FQSelect.BatchInput(InputObject); |
1013 |
end; |
1014 |
|
1015 |
procedure TIBCustomDataSet.InternalBatchOutput(OutputObject: TIBBatchOutput); |
1016 |
var |
1017 |
Qry: TIBSQL; |
1018 |
begin |
1019 |
Qry := TIBSQL.Create(Self); |
1020 |
try |
1021 |
Qry.Database := FBase.Database; |
1022 |
Qry.Transaction := FBase.Transaction; |
1023 |
Qry.SQL.Assign(FQSelect.SQL); |
1024 |
Qry.BatchOutput(OutputObject); |
1025 |
finally |
1026 |
Qry.Free; |
1027 |
end; |
1028 |
end; |
1029 |
|
1030 |
procedure TIBCustomDataSet.CancelUpdates; |
1031 |
var |
1032 |
CurUpdateTypes: TIBUpdateRecordTypes; |
1033 |
begin |
1034 |
if State in [dsEdit, dsInsert] then |
1035 |
Post; |
1036 |
if FCachedUpdates and FUpdatesPending then |
1037 |
begin |
1038 |
DisableControls; |
1039 |
CurUpdateTypes := UpdateRecordTypes; |
1040 |
UpdateRecordTypes := [cusModified, cusInserted, cusDeleted]; |
1041 |
try |
1042 |
First; |
1043 |
while not EOF do |
1044 |
begin |
1045 |
if UpdateStatus = usInserted then |
1046 |
RevertRecord |
1047 |
else |
1048 |
begin |
1049 |
RevertRecord; |
1050 |
Next; |
1051 |
end; |
1052 |
end; |
1053 |
finally |
1054 |
UpdateRecordTypes := CurUpdateTypes; |
1055 |
First; |
1056 |
FUpdatesPending := False; |
1057 |
EnableControls; |
1058 |
end; |
1059 |
end; |
1060 |
end; |
1061 |
|
1062 |
procedure TIBCustomDataSet.ActivateConnection; |
1063 |
begin |
1064 |
if not Assigned(Database) then |
1065 |
IBError(ibxeDatabaseNotAssigned, [nil]); |
1066 |
if not Assigned(Transaction) then |
1067 |
IBError(ibxeTransactionNotAssigned, [nil]); |
1068 |
if not Database.Connected then Database.Open; |
1069 |
end; |
1070 |
|
1071 |
function TIBCustomDataSet.ActivateTransaction: Boolean; |
1072 |
begin |
1073 |
Result := False; |
1074 |
if not Assigned(Transaction) then |
1075 |
IBError(ibxeTransactionNotAssigned, [nil]); |
1076 |
if not Transaction.Active then |
1077 |
begin |
1078 |
Result := True; |
1079 |
Transaction.StartTransaction; |
1080 |
FDidActivate := True; |
1081 |
end; |
1082 |
end; |
1083 |
|
1084 |
procedure TIBCustomDataSet.DeactivateTransaction; |
1085 |
var |
1086 |
i: Integer; |
1087 |
begin |
1088 |
if not Assigned(Transaction) then |
1089 |
IBError(ibxeTransactionNotAssigned, [nil]); |
1090 |
with Transaction do |
1091 |
begin |
1092 |
for i := 0 to SQLObjectCount - 1 do |
1093 |
begin |
1094 |
if (SQLObjects[i] <> nil) and ((SQLObjects[i]).owner is TDataSet) then |
1095 |
begin |
1096 |
if TDataSet(SQLObjects[i].owner).Active then |
1097 |
begin |
1098 |
FDidActivate := False; |
1099 |
exit; |
1100 |
end; |
1101 |
end; |
1102 |
end; |
1103 |
end; |
1104 |
FInternalPrepared := False; |
1105 |
if Transaction.InTransaction then |
1106 |
Transaction.Commit; |
1107 |
FDidActivate := False; |
1108 |
end; |
1109 |
|
1110 |
procedure TIBCustomDataSet.CheckDatasetClosed; |
1111 |
begin |
1112 |
if FOpen then |
1113 |
IBError(ibxeDatasetOpen, [nil]); |
1114 |
end; |
1115 |
|
1116 |
procedure TIBCustomDataSet.CheckDatasetOpen; |
1117 |
begin |
1118 |
if not FOpen then |
1119 |
IBError(ibxeDatasetClosed, [nil]); |
1120 |
end; |
1121 |
|
1122 |
procedure TIBCustomDataSet.CheckNotUniDirectional; |
1123 |
begin |
1124 |
if UniDirectional then |
1125 |
IBError(ibxeDataSetUniDirectional, [nil]); |
1126 |
end; |
1127 |
|
1128 |
procedure TIBCustomDataSet.AdjustRecordOnInsert(Buffer: Pointer); |
1129 |
begin |
1130 |
with PRecordData(Buffer)^ do |
1131 |
if (State = dsInsert) and (not Modified) then |
1132 |
begin |
1133 |
rdRecordNumber := FRecordCount; |
1134 |
FCurrentRecord := FRecordCount; |
1135 |
end; |
1136 |
end; |
1137 |
|
1138 |
function TIBCustomDataSet.CanEdit: Boolean; |
1139 |
var |
1140 |
Buff: PRecordData; |
1141 |
begin |
1142 |
Buff := PRecordData(GetActiveBuf); |
1143 |
result := (FQModify.SQL.Text <> '') or |
1144 |
(Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukModify).Text <> '')) or |
1145 |
((Buff <> nil) and (Buff^.rdCachedUpdateStatus = cusInserted) and |
1146 |
(FCachedUpdates)); |
1147 |
end; |
1148 |
|
1149 |
function TIBCustomDataSet.CanInsert: Boolean; |
1150 |
begin |
1151 |
result := (FQInsert.SQL.Text <> '') or |
1152 |
(Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukInsert).Text <> '')); |
1153 |
end; |
1154 |
|
1155 |
function TIBCustomDataSet.CanDelete: Boolean; |
1156 |
begin |
1157 |
if (FQDelete.SQL.Text <> '') or |
1158 |
(Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then |
1159 |
result := True |
1160 |
else |
1161 |
result := False; |
1162 |
end; |
1163 |
|
1164 |
function TIBCustomDataSet.CanRefresh: Boolean; |
1165 |
begin |
1166 |
result := (FQRefresh.SQL.Text <> '') or |
1167 |
(Assigned(FUpdateObject) and (FUpdateObject.RefreshSQL.Text <> '')); |
1168 |
end; |
1169 |
|
1170 |
procedure TIBCustomDataSet.CheckEditState; |
1171 |
begin |
1172 |
case State of |
1173 |
{ Check all the wsEditMode types } |
1174 |
dsEdit, dsInsert, dsSetKey, dsCalcFields, dsFilter, |
1175 |
dsNewValue, dsInternalCalc : |
1176 |
begin |
1177 |
if (State in [dsEdit]) and (not CanEdit) then |
1178 |
IBError(ibxeCannotUpdate, [nil]); |
1179 |
if (State in [dsInsert]) and (not CanInsert) then |
1180 |
IBError(ibxeCannotInsert, [nil]); |
1181 |
end; |
1182 |
else |
1183 |
IBError(ibxeNotEditing, []) |
1184 |
end; |
1185 |
end; |
1186 |
|
1187 |
procedure TIBCustomDataSet.ClearBlobCache; |
1188 |
var |
1189 |
i: Integer; |
1190 |
begin |
1191 |
for i := 0 to FBlobStreamList.Count - 1 do |
1192 |
begin |
1193 |
TIBBlobStream(FBlobStreamList[i]).Free; |
1194 |
FBlobStreamList[i] := nil; |
1195 |
end; |
1196 |
FBlobStreamList.Pack; |
1197 |
end; |
1198 |
|
1199 |
procedure TIBCustomDataSet.CopyRecordBuffer(Source, Dest: Pointer); |
1200 |
begin |
1201 |
Move(Source^, Dest^, FRecordBufferSize); |
1202 |
end; |
1203 |
|
1204 |
procedure TIBCustomDataSet.DoBeforeDatabaseDisconnect(Sender: TObject); |
1205 |
begin |
1206 |
if Active then |
1207 |
Active := False; |
1208 |
FInternalPrepared := False; |
1209 |
if Assigned(FBeforeDatabaseDisconnect) then |
1210 |
FBeforeDatabaseDisconnect(Sender); |
1211 |
end; |
1212 |
|
1213 |
procedure TIBCustomDataSet.DoAfterDatabaseDisconnect(Sender: TObject); |
1214 |
begin |
1215 |
if Assigned(FAfterDatabaseDisconnect) then |
1216 |
FAfterDatabaseDisconnect(Sender); |
1217 |
end; |
1218 |
|
1219 |
procedure TIBCustomDataSet.DoDatabaseFree(Sender: TObject); |
1220 |
begin |
1221 |
if Assigned(FDatabaseFree) then |
1222 |
FDatabaseFree(Sender); |
1223 |
end; |
1224 |
|
1225 |
procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject); |
1226 |
begin |
1227 |
if Active then |
1228 |
Active := False; |
1229 |
if FQSelect <> nil then |
1230 |
FQSelect.FreeHandle; |
1231 |
if FQDelete <> nil then |
1232 |
FQDelete.FreeHandle; |
1233 |
if FQInsert <> nil then |
1234 |
FQInsert.FreeHandle; |
1235 |
if FQModify <> nil then |
1236 |
FQModify.FreeHandle; |
1237 |
if FQRefresh <> nil then |
1238 |
FQRefresh.FreeHandle; |
1239 |
if Assigned(FBeforeTransactionEnd) then |
1240 |
FBeforeTransactionEnd(Sender); |
1241 |
end; |
1242 |
|
1243 |
procedure TIBCustomDataSet.DoAfterTransactionEnd(Sender: TObject); |
1244 |
begin |
1245 |
if Assigned(FAfterTransactionEnd) then |
1246 |
FAfterTransactionEnd(Sender); |
1247 |
end; |
1248 |
|
1249 |
procedure TIBCustomDataSet.DoTransactionFree(Sender: TObject); |
1250 |
begin |
1251 |
if Assigned(FTransactionFree) then |
1252 |
FTransactionFree(Sender); |
1253 |
end; |
1254 |
|
1255 |
{ Read the record from FQSelect.Current into the record buffer |
1256 |
Then write the buffer to in memory cache } |
1257 |
procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL; |
1258 |
RecordNumber: Integer; Buffer: PChar); |
1259 |
var |
1260 |
p: PRecordData; |
1261 |
pbd: PBlobDataArray; |
1262 |
i, j: Integer; |
1263 |
LocalData: Pointer; |
1264 |
LocalDate, LocalDouble: Double; |
1265 |
LocalInt: Integer; |
1266 |
LocalInt64: Int64; |
1267 |
LocalCurrency: Currency; |
1268 |
FieldsLoaded: Integer; |
1269 |
begin |
1270 |
p := PRecordData(Buffer); |
1271 |
{ Make sure blob cache is empty } |
1272 |
pbd := PBlobDataArray(Buffer + FBlobCacheOffset); |
1273 |
if RecordNumber > -1 then |
1274 |
for i := 0 to BlobFieldCount - 1 do |
1275 |
pbd^[i] := nil; |
1276 |
{ Get record information } |
1277 |
p^.rdBookmarkFlag := bfCurrent; |
1278 |
p^.rdFieldCount := Qry.Current.Count; |
1279 |
p^.rdRecordNumber := RecordNumber; |
1280 |
p^.rdUpdateStatus := usUnmodified; |
1281 |
p^.rdCachedUpdateStatus := cusUnmodified; |
1282 |
p^.rdSavedOffset := $FFFFFFFF; |
1283 |
|
1284 |
{ Load up the fields } |
1285 |
FieldsLoaded := FQSelect.Current.Count; |
1286 |
j := 1; |
1287 |
for i := 0 to Qry.Current.Count - 1 do |
1288 |
begin |
1289 |
if (Qry = FQSelect) then |
1290 |
j := i + 1 |
1291 |
else begin |
1292 |
if FieldsLoaded = 0 then |
1293 |
break; |
1294 |
j := FQSelect.FieldIndex[Qry.Current[i].Name] + 1; |
1295 |
if j < 1 then |
1296 |
continue |
1297 |
else |
1298 |
Dec(FieldsLoaded); |
1299 |
end; |
1300 |
with FQSelect.Current[j - 1].Data^ do |
1301 |
if aliasname = 'IBX_INTERNAL_DBKEY' then {do not localize} |
1302 |
begin |
1303 |
if sqllen <= 8 then |
1304 |
p^.rdDBKey := PIBDBKEY(Qry.Current[i].AsPointer)^; |
1305 |
continue; |
1306 |
end; |
1307 |
if j > 0 then with p^ do |
1308 |
begin |
1309 |
rdFields[j].fdDataType := |
1310 |
Qry.Current[i].Data^.sqltype and (not 1); |
1311 |
rdFields[j].fdDataScale := |
1312 |
Qry.Current[i].Data^.sqlscale; |
1313 |
rdFields[j].fdNullable := |
1314 |
(Qry.Current[i].Data^.sqltype and 1 = 1); |
1315 |
rdFields[j].fdIsNull := |
1316 |
(rdFields[j].fdNullable and (Qry.Current[i].Data^.sqlind^ = -1)); |
1317 |
LocalData := Qry.Current[i].Data^.sqldata; |
1318 |
case rdFields[j].fdDataType of |
1319 |
SQL_TIMESTAMP: |
1320 |
begin |
1321 |
rdFields[j].fdDataSize := SizeOf(TDateTime); |
1322 |
if RecordNumber >= 0 then |
1323 |
LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry.Current[i].AsDateTime)); |
1324 |
LocalData := PChar(@LocalDate); |
1325 |
end; |
1326 |
SQL_TYPE_DATE: |
1327 |
begin |
1328 |
rdFields[j].fdDataSize := SizeOf(TDateTime); |
1329 |
if RecordNumber >= 0 then |
1330 |
LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Date; |
1331 |
LocalData := PChar(@LocalInt); |
1332 |
end; |
1333 |
SQL_TYPE_TIME: |
1334 |
begin |
1335 |
rdFields[j].fdDataSize := SizeOf(TDateTime); |
1336 |
if RecordNumber >= 0 then |
1337 |
LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Time; |
1338 |
LocalData := PChar(@LocalInt); |
1339 |
end; |
1340 |
SQL_SHORT, SQL_LONG: |
1341 |
begin |
1342 |
if (rdFields[j].fdDataScale = 0) then |
1343 |
begin |
1344 |
rdFields[j].fdDataSize := SizeOf(Integer); |
1345 |
if RecordNumber >= 0 then |
1346 |
LocalInt := Qry.Current[i].AsLong; |
1347 |
LocalData := PChar(@LocalInt); |
1348 |
end |
1349 |
else if (rdFields[j].fdDataScale >= (-4)) then |
1350 |
begin |
1351 |
rdFields[j].fdDataSize := SizeOf(Currency); |
1352 |
if RecordNumber >= 0 then |
1353 |
LocalCurrency := Qry.Current[i].AsCurrency; |
1354 |
LocalData := PChar(@LocalCurrency); |
1355 |
end |
1356 |
else begin |
1357 |
rdFields[j].fdDataSize := SizeOf(Double); |
1358 |
if RecordNumber >= 0 then |
1359 |
LocalDouble := Qry.Current[i].AsDouble; |
1360 |
LocalData := PChar(@LocalDouble); |
1361 |
end; |
1362 |
end; |
1363 |
SQL_INT64: |
1364 |
begin |
1365 |
if (rdFields[j].fdDataScale = 0) then |
1366 |
begin |
1367 |
rdFields[j].fdDataSize := SizeOf(Int64); |
1368 |
if RecordNumber >= 0 then |
1369 |
LocalInt64 := Qry.Current[i].AsInt64; |
1370 |
LocalData := PChar(@LocalInt64); |
1371 |
end |
1372 |
else if (rdFields[j].fdDataScale >= (-4)) then |
1373 |
begin |
1374 |
rdFields[j].fdDataSize := SizeOf(Currency); |
1375 |
if RecordNumber >= 0 then |
1376 |
LocalCurrency := Qry.Current[i].AsCurrency; |
1377 |
LocalData := PChar(@LocalCurrency); |
1378 |
end |
1379 |
else begin |
1380 |
rdFields[j].fdDataSize := SizeOf(Double); |
1381 |
if RecordNumber >= 0 then |
1382 |
LocalDouble := Qry.Current[i].AsDouble; |
1383 |
LocalData := PChar(@LocalDouble); |
1384 |
end |
1385 |
end; |
1386 |
SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: |
1387 |
begin |
1388 |
rdFields[j].fdDataSize := SizeOf(Double); |
1389 |
if RecordNumber >= 0 then |
1390 |
LocalDouble := Qry.Current[i].AsDouble; |
1391 |
LocalData := PChar(@LocalDouble); |
1392 |
end; |
1393 |
SQL_VARYING: |
1394 |
begin |
1395 |
rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen; |
1396 |
rdFields[j].fdDataLength := isc_vax_integer(Qry.Current[i].Data^.sqldata, 2); |
1397 |
if RecordNumber >= 0 then |
1398 |
begin |
1399 |
if (rdFields[j].fdDataLength = 0) then |
1400 |
LocalData := nil |
1401 |
else |
1402 |
LocalData := @Qry.Current[i].Data^.sqldata[2]; |
1403 |
end; |
1404 |
end; |
1405 |
else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD } |
1406 |
begin |
1407 |
rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen; |
1408 |
if (rdFields[j].fdDataType = SQL_TEXT) then |
1409 |
rdFields[j].fdDataLength := rdFields[j].fdDataSize; |
1410 |
end; |
1411 |
end; |
1412 |
if RecordNumber < 0 then |
1413 |
begin |
1414 |
rdFields[j].fdIsNull := True; |
1415 |
rdFields[j].fdDataOfs := FRecordSize; |
1416 |
Inc(FRecordSize, rdFields[j].fdDataSize); |
1417 |
end |
1418 |
else begin |
1419 |
if rdFields[j].fdDataType = SQL_VARYING then |
1420 |
begin |
1421 |
if LocalData <> nil then |
1422 |
Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataLength) |
1423 |
end |
1424 |
else |
1425 |
Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataSize) |
1426 |
end; |
1427 |
end; |
1428 |
end; |
1429 |
WriteRecordCache(RecordNumber, PChar(p)); |
1430 |
end; |
1431 |
|
1432 |
function TIBCustomDataSet.GetActiveBuf: PChar; |
1433 |
begin |
1434 |
case State of |
1435 |
dsBrowse: |
1436 |
if IsEmpty then |
1437 |
result := nil |
1438 |
else |
1439 |
result := ActiveBuffer; |
1440 |
dsEdit, dsInsert: |
1441 |
result := ActiveBuffer; |
1442 |
dsCalcFields: |
1443 |
result := CalcBuffer; |
1444 |
dsFilter: |
1445 |
result := FFilterBuffer; |
1446 |
dsNewValue: |
1447 |
result := ActiveBuffer; |
1448 |
dsOldValue: |
1449 |
if (PRecordData(ActiveBuffer)^.rdRecordNumber = |
1450 |
PRecordData(FOldBuffer)^.rdRecordNumber) then |
1451 |
result := FOldBuffer |
1452 |
else |
1453 |
result := ActiveBuffer; |
1454 |
else if not FOpen then |
1455 |
result := nil |
1456 |
else |
1457 |
result := ActiveBuffer; |
1458 |
end; |
1459 |
end; |
1460 |
|
1461 |
function TIBCustomDataSet.CachedUpdateStatus: TCachedUpdateStatus; |
1462 |
begin |
1463 |
if Active then |
1464 |
result := PRecordData(GetActiveBuf)^.rdCachedUpdateStatus |
1465 |
else |
1466 |
result := cusUnmodified; |
1467 |
end; |
1468 |
|
1469 |
function TIBCustomDataSet.GetDatabase: TIBDatabase; |
1470 |
begin |
1471 |
result := FBase.Database; |
1472 |
end; |
1473 |
|
1474 |
function TIBCustomDataSet.GetDBHandle: PISC_DB_HANDLE; |
1475 |
begin |
1476 |
result := FBase.DBHandle; |
1477 |
end; |
1478 |
|
1479 |
function TIBCustomDataSet.GetDeleteSQL: TStrings; |
1480 |
begin |
1481 |
result := FQDelete.SQL; |
1482 |
end; |
1483 |
|
1484 |
function TIBCustomDataSet.GetInsertSQL: TStrings; |
1485 |
begin |
1486 |
result := FQInsert.SQL; |
1487 |
end; |
1488 |
|
1489 |
function TIBCustomDataSet.GetSQLParams: TIBXSQLDA; |
1490 |
begin |
1491 |
if not FInternalPrepared then |
1492 |
InternalPrepare; |
1493 |
result := FQSelect.Params; |
1494 |
end; |
1495 |
|
1496 |
function TIBCustomDataSet.GetRefreshSQL: TStrings; |
1497 |
begin |
1498 |
result := FQRefresh.SQL; |
1499 |
end; |
1500 |
|
1501 |
function TIBCustomDataSet.GetSelectSQL: TStrings; |
1502 |
begin |
1503 |
result := FQSelect.SQL; |
1504 |
end; |
1505 |
|
1506 |
function TIBCustomDataSet.GetStatementType: TIBSQLTypes; |
1507 |
begin |
1508 |
result := FQSelect.SQLType; |
1509 |
end; |
1510 |
|
1511 |
function TIBCustomDataSet.GetModifySQL: TStrings; |
1512 |
begin |
1513 |
result := FQModify.SQL; |
1514 |
end; |
1515 |
|
1516 |
function TIBCustomDataSet.GetTransaction: TIBTransaction; |
1517 |
begin |
1518 |
result := FBase.Transaction; |
1519 |
end; |
1520 |
|
1521 |
function TIBCustomDataSet.GetTRHandle: PISC_TR_HANDLE; |
1522 |
begin |
1523 |
result := FBase.TRHandle; |
1524 |
end; |
1525 |
|
1526 |
procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); |
1527 |
begin |
1528 |
if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then |
1529 |
FUpdateObject.Apply(ukDelete) |
1530 |
else |
1531 |
begin |
1532 |
SetInternalSQLParams(FQDelete, Buff); |
1533 |
FQDelete.ExecQuery; |
1534 |
end; |
1535 |
with PRecordData(Buff)^ do |
1536 |
begin |
1537 |
rdUpdateStatus := usDeleted; |
1538 |
rdCachedUpdateStatus := cusUnmodified; |
1539 |
end; |
1540 |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff); |
1541 |
end; |
1542 |
|
1543 |
function TIBCustomDataSet.InternalLocate(const KeyFields: string; |
1544 |
const KeyValues: Variant; Options: TLocateOptions): Boolean; |
1545 |
var |
1546 |
fl: TList; |
1547 |
CurBookmark: string; |
1548 |
fld, val: Variant; |
1549 |
i, fld_cnt: Integer; |
1550 |
begin |
1551 |
fl := TList.Create; |
1552 |
try |
1553 |
GetFieldList(fl, KeyFields); |
1554 |
fld_cnt := fl.Count; |
1555 |
CurBookmark := Bookmark; |
1556 |
result := False; |
1557 |
while ((not result) and (not EOF)) do |
1558 |
begin |
1559 |
i := 0; |
1560 |
result := True; |
1561 |
while (result and (i < fld_cnt)) do |
1562 |
begin |
1563 |
if fld_cnt > 1 then |
1564 |
val := KeyValues[i] |
1565 |
else |
1566 |
val := KeyValues; |
1567 |
fld := TField(fl[i]).Value; |
1568 |
result := not (VarIsNull(val) xor VarIsNull(fld)); |
1569 |
if result and not VarIsNull(val) then |
1570 |
begin |
1571 |
try |
1572 |
fld := VarAsType(fld, VarType(val)); |
1573 |
except |
1574 |
on E: EVariantError do result := False; |
1575 |
end; |
1576 |
if Result then |
1577 |
if TField(fl[i]).DataType = ftString then |
1578 |
begin |
1579 |
if (loCaseInsensitive in Options) then |
1580 |
begin |
1581 |
fld := AnsiUpperCase(fld); |
1582 |
val := AnsiUpperCase(val); |
1583 |
end; |
1584 |
fld := TrimRight(fld); |
1585 |
val := TrimRight(val); |
1586 |
if (loPartialKey in Options) then |
1587 |
result := result and (AnsiPos(val, fld) = 1) |
1588 |
else |
1589 |
result := result and (val = fld); |
1590 |
end else |
1591 |
result := result and (val = fld); |
1592 |
end; |
1593 |
Inc(i); |
1594 |
end; |
1595 |
if not result then |
1596 |
Next; |
1597 |
end; |
1598 |
if not result then |
1599 |
Bookmark := CurBookmark |
1600 |
else |
1601 |
CursorPosChanged; |
1602 |
finally |
1603 |
fl.Free; |
1604 |
end; |
1605 |
end; |
1606 |
|
1607 |
procedure TIBCustomDataSet.InternalPostRecord(Qry: TIBSQL; Buff: Pointer); |
1608 |
var |
1609 |
i, j, k: Integer; |
1610 |
pbd: PBlobDataArray; |
1611 |
begin |
1612 |
pbd := PBlobDataArray(PChar(Buff) + FBlobCacheOffset); |
1613 |
j := 0; |
1614 |
for i := 0 to FieldCount - 1 do |
1615 |
if Fields[i].IsBlob then |
1616 |
begin |
1617 |
k := FMappedFieldPosition[Fields[i].FieldNo -1]; |
1618 |
if pbd^[j] <> nil then |
1619 |
begin |
1620 |
pbd^[j].Finalize; |
1621 |
PISC_QUAD( |
1622 |
PChar(Buff) + PRecordData(Buff)^.rdFields[k].fdDataOfs)^ := |
1623 |
pbd^[j].BlobID; |
1624 |
PRecordData(Buff)^.rdFields[k].fdIsNull := pbd^[j].Size = 0; |
1625 |
end; |
1626 |
Inc(j); |
1627 |
end; |
1628 |
if Assigned(FUpdateObject) then |
1629 |
begin |
1630 |
if (Qry = FQDelete) then |
1631 |
FUpdateObject.Apply(ukDelete) |
1632 |
else if (Qry = FQInsert) then |
1633 |
FUpdateObject.Apply(ukInsert) |
1634 |
else |
1635 |
FUpdateObject.Apply(ukModify); |
1636 |
end |
1637 |
else begin |
1638 |
SetInternalSQLParams(Qry, Buff); |
1639 |
Qry.ExecQuery; |
1640 |
end; |
1641 |
PRecordData(Buff)^.rdUpdateStatus := usUnmodified; |
1642 |
PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified; |
1643 |
SetModified(False); |
1644 |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff); |
1645 |
if (FForcedRefresh or FNeedsRefresh) and CanRefresh then |
1646 |
InternalRefreshRow; |
1647 |
end; |
1648 |
|
1649 |
procedure TIBCustomDataSet.InternalRefreshRow; |
1650 |
var |
1651 |
Buff: PChar; |
1652 |
SetCursor: Boolean; |
1653 |
ofs: DWORD; |
1654 |
Qry: TIBSQL; |
1655 |
begin |
1656 |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
1657 |
if SetCursor then |
1658 |
Screen.Cursor := crHourGlass; |
1659 |
try |
1660 |
Buff := GetActiveBuf; |
1661 |
if CanRefresh then |
1662 |
begin |
1663 |
if Buff <> nil then |
1664 |
begin |
1665 |
if (Assigned(FUpdateObject) and (FUpdateObject.RefreshSQL.Text <> '')) then |
1666 |
begin |
1667 |
Qry := TIBSQL.Create(self); |
1668 |
Qry.Database := Database; |
1669 |
Qry.Transaction := Transaction; |
1670 |
Qry.GoToFirstRecordOnExecute := False; |
1671 |
Qry.SQL.Text := FUpdateObject.RefreshSQL.Text; |
1672 |
end |
1673 |
else |
1674 |
Qry := FQRefresh; |
1675 |
SetInternalSQLParams(Qry, Buff); |
1676 |
Qry.ExecQuery; |
1677 |
try |
1678 |
if (Qry.SQLType = SQLExecProcedure) or |
1679 |
(Qry.Next <> nil) then |
1680 |
begin |
1681 |
ofs := PRecordData(Buff)^.rdSavedOffset; |
1682 |
FetchCurrentRecordToBuffer(Qry, |
1683 |
PRecordData(Buff)^.rdRecordNumber, |
1684 |
Buff); |
1685 |
if FCachedUpdates and (ofs <> $FFFFFFFF) then |
1686 |
begin |
1687 |
PRecordData(Buff)^.rdSavedOffset := ofs; |
1688 |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff); |
1689 |
SaveOldBuffer(Buff); |
1690 |
end; |
1691 |
end; |
1692 |
finally |
1693 |
Qry.Close; |
1694 |
end; |
1695 |
if Qry <> FQRefresh then |
1696 |
Qry.Free; |
1697 |
end |
1698 |
end |
1699 |
else |
1700 |
IBError(ibxeCannotRefresh, [nil]); |
1701 |
finally |
1702 |
if SetCursor and (Screen.Cursor = crHourGlass) then |
1703 |
Screen.Cursor := crDefault; |
1704 |
end; |
1705 |
end; |
1706 |
|
1707 |
procedure TIBCustomDataSet.InternalRevertRecord(RecordNumber: Integer); |
1708 |
var |
1709 |
NewBuffer, OldBuffer: PRecordData; |
1710 |
|
1711 |
begin |
1712 |
NewBuffer := nil; |
1713 |
OldBuffer := nil; |
1714 |
NewBuffer := PRecordData(AllocRecordBuffer); |
1715 |
OldBuffer := PRecordData(AllocRecordBuffer); |
1716 |
try |
1717 |
ReadRecordCache(RecordNumber, PChar(NewBuffer), False); |
1718 |
ReadRecordCache(RecordNumber, PChar(OldBuffer), True); |
1719 |
case NewBuffer^.rdCachedUpdateStatus of |
1720 |
cusInserted: |
1721 |
begin |
1722 |
NewBuffer^.rdCachedUpdateStatus := cusUninserted; |
1723 |
Inc(FDeletedRecords); |
1724 |
end; |
1725 |
cusModified, |
1726 |
cusDeleted: |
1727 |
begin |
1728 |
if (NewBuffer^.rdCachedUpdateStatus = cusDeleted) then |
1729 |
Dec(FDeletedRecords); |
1730 |
CopyRecordBuffer(OldBuffer, NewBuffer); |
1731 |
end; |
1732 |
end; |
1733 |
|
1734 |
if State in dsEditModes then |
1735 |
Cancel; |
1736 |
|
1737 |
WriteRecordCache(RecordNumber, PChar(NewBuffer)); |
1738 |
|
1739 |
if (NewBuffer^.rdCachedUpdateStatus = cusUninserted ) then |
1740 |
ReSync([]); |
1741 |
finally |
1742 |
FreeRecordBuffer(PChar(NewBuffer)); |
1743 |
FreeRecordBuffer(PChar(OldBuffer)); |
1744 |
end; |
1745 |
end; |
1746 |
|
1747 |
{ A visible record is one that is not truly deleted, |
1748 |
and it is also listed in the FUpdateRecordTypes set } |
1749 |
|
1750 |
function TIBCustomDataSet.IsVisible(Buffer: PChar): Boolean; |
1751 |
begin |
1752 |
result := True; |
1753 |
if not (State = dsOldValue) then |
1754 |
result := |
1755 |
(PRecordData(Buffer)^.rdCachedUpdateStatus in FUpdateRecordTypes) and |
1756 |
(not ((PRecordData(Buffer)^.rdCachedUpdateStatus = cusUnmodified) and |
1757 |
(PRecordData(Buffer)^.rdUpdateStatus = usDeleted))); |
1758 |
end; |
1759 |
|
1760 |
|
1761 |
function TIBCustomDataSet.LocateNext(const KeyFields: string; |
1762 |
const KeyValues: Variant; Options: TLocateOptions): Boolean; |
1763 |
begin |
1764 |
DisableControls; |
1765 |
try |
1766 |
result := InternalLocate(KeyFields, KeyValues, Options); |
1767 |
finally |
1768 |
EnableControls; |
1769 |
end; |
1770 |
end; |
1771 |
|
1772 |
procedure TIBCustomDataSet.InternalPrepare; |
1773 |
var |
1774 |
SetCursor: Boolean; |
1775 |
DidActivate: Boolean; |
1776 |
begin |
1777 |
if FInternalPrepared then |
1778 |
Exit; |
1779 |
DidActivate := False; |
1780 |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
1781 |
if SetCursor then |
1782 |
Screen.Cursor := crHourGlass; |
1783 |
try |
1784 |
ActivateConnection; |
1785 |
DidActivate := ActivateTransaction; |
1786 |
FBase.CheckDatabase; |
1787 |
FBase.CheckTransaction; |
1788 |
if FQSelect.SQL.Text <> '' then |
1789 |
begin |
1790 |
if not FQSelect.Prepared then |
1791 |
begin |
1792 |
FQSelect.ParamCheck := ParamCheck; |
1793 |
FQSelect.Prepare; |
1794 |
end; |
1795 |
if (FQDelete.SQL.Text <> '') and (not FQDelete.Prepared) then |
1796 |
FQDelete.Prepare; |
1797 |
if (FQInsert.SQL.Text <> '') and (not FQInsert.Prepared) then |
1798 |
FQInsert.Prepare; |
1799 |
if (FQRefresh.SQL.Text <> '') and (not FQRefresh.Prepared) then |
1800 |
FQRefresh.Prepare; |
1801 |
if (FQModify.SQL.Text <> '') and (not FQModify.Prepared) then |
1802 |
FQModify.Prepare; |
1803 |
FInternalPrepared := True; |
1804 |
InternalInitFieldDefs; |
1805 |
end else |
1806 |
IBError(ibxeEmptyQuery, [nil]); |
1807 |
finally |
1808 |
if DidActivate then |
1809 |
DeactivateTransaction; |
1810 |
if SetCursor and (Screen.Cursor = crHourGlass) then |
1811 |
Screen.Cursor := crDefault; |
1812 |
end; |
1813 |
end; |
1814 |
|
1815 |
procedure TIBCustomDataSet.RecordModified(Value: Boolean); |
1816 |
begin |
1817 |
SetModified(Value); |
1818 |
end; |
1819 |
|
1820 |
procedure TIBCustomDataSet.RevertRecord; |
1821 |
var |
1822 |
Buff: PRecordData; |
1823 |
begin |
1824 |
if FCachedUpdates and FUpdatesPending then |
1825 |
begin |
1826 |
Buff := PRecordData(GetActiveBuf); |
1827 |
InternalRevertRecord(Buff^.rdRecordNumber); |
1828 |
ReadRecordCache(Buff^.rdRecordNumber, PChar(Buff), False); |
1829 |
DataEvent(deRecordChange, 0); |
1830 |
end; |
1831 |
end; |
1832 |
|
1833 |
procedure TIBCustomDataSet.SaveOldBuffer(Buffer: PChar); |
1834 |
var |
1835 |
OldBuffer: Pointer; |
1836 |
procedure CopyOldBuffer; |
1837 |
begin |
1838 |
CopyRecordBuffer(Buffer, OldBuffer); |
1839 |
if BlobFieldCount > 0 then |
1840 |
FillChar(PChar(OldBuffer)[FBlobCacheOffset], BlobFieldCount * SizeOf(TIBBlobStream), |
1841 |
0); |
1842 |
end; |
1843 |
|
1844 |
begin |
1845 |
if (Buffer <> nil) and (PRecordData(Buffer)^.rdRecordNumber >= 0) then |
1846 |
begin |
1847 |
OldBuffer := AllocRecordBuffer; |
1848 |
try |
1849 |
if (PRecordData(Buffer)^.rdSavedOffset = $FFFFFFFF) then |
1850 |
begin |
1851 |
PRecordData(Buffer)^.rdSavedOffset := AdjustPosition(FOldBufferCache, 0, |
1852 |
FILE_END); |
1853 |
CopyOldBuffer; |
1854 |
WriteCache(FOldBufferCache, 0, FILE_CURRENT, OldBuffer); |
1855 |
WriteCache(FBufferCache, PRecordData(Buffer)^.rdRecordNumber * FRecordBufferSize, |
1856 |
FILE_BEGIN, Buffer); |
1857 |
end |
1858 |
else begin |
1859 |
CopyOldBuffer; |
1860 |
WriteCache(FOldBufferCache, PRecordData(Buffer)^.rdSavedOffset, FILE_BEGIN, |
1861 |
OldBuffer); |
1862 |
end; |
1863 |
finally |
1864 |
FreeRecordBuffer(PChar(OldBuffer)); |
1865 |
end; |
1866 |
end; |
1867 |
end; |
1868 |
|
1869 |
procedure TIBCustomDataSet.SetBufferChunks(Value: Integer); |
1870 |
begin |
1871 |
if (Value <= 0) then |
1872 |
FBufferChunks := BufferCacheSize |
1873 |
else |
1874 |
FBufferChunks := Value; |
1875 |
end; |
1876 |
|
1877 |
procedure TIBCustomDataSet.SetDatabase(Value: TIBDatabase); |
1878 |
begin |
1879 |
if (FBase.Database <> Value) then |
1880 |
begin |
1881 |
CheckDatasetClosed; |
1882 |
FBase.Database := Value; |
1883 |
FQDelete.Database := Value; |
1884 |
FQInsert.Database := Value; |
1885 |
FQRefresh.Database := Value; |
1886 |
FQSelect.Database := Value; |
1887 |
FQModify.Database := Value; |
1888 |
end; |
1889 |
end; |
1890 |
|
1891 |
procedure TIBCustomDataSet.SetDeleteSQL(Value: TStrings); |
1892 |
begin |
1893 |
if FQDelete.SQL.Text <> Value.Text then |
1894 |
begin |
1895 |
Disconnect; |
1896 |
FQDelete.SQL.Assign(Value); |
1897 |
end; |
1898 |
end; |
1899 |
|
1900 |
procedure TIBCustomDataSet.SetInsertSQL(Value: TStrings); |
1901 |
begin |
1902 |
if FQInsert.SQL.Text <> Value.Text then |
1903 |
begin |
1904 |
Disconnect; |
1905 |
FQInsert.SQL.Assign(Value); |
1906 |
end; |
1907 |
end; |
1908 |
|
1909 |
procedure TIBCustomDataSet.SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer); |
1910 |
var |
1911 |
i, j: Integer; |
1912 |
cr, data: PChar; |
1913 |
fn, st: string; |
1914 |
OldBuffer: Pointer; |
1915 |
ts: TTimeStamp; |
1916 |
begin |
1917 |
if (Buffer = nil) then |
1918 |
IBError(ibxeBufferNotSet, [nil]); |
1919 |
if (not FInternalPrepared) then |
1920 |
InternalPrepare; |
1921 |
OldBuffer := nil; |
1922 |
try |
1923 |
for i := 0 to Qry.Params.Count - 1 do |
1924 |
begin |
1925 |
fn := Qry.Params[i].Name; |
1926 |
if (Pos('OLD_', fn) = 1) then {mbcs ok} |
1927 |
begin |
1928 |
fn := Copy(fn, 5, Length(fn)); |
1929 |
if not Assigned(OldBuffer) then |
1930 |
begin |
1931 |
OldBuffer := AllocRecordBuffer; |
1932 |
ReadRecordCache(PRecordData(Buffer)^.rdRecordNumber, OldBuffer, True); |
1933 |
end; |
1934 |
cr := OldBuffer; |
1935 |
end |
1936 |
else if (Pos('NEW_', fn) = 1) then {mbcs ok} |
1937 |
begin |
1938 |
fn := Copy(fn, 5, Length(fn)); |
1939 |
cr := Buffer; |
1940 |
end |
1941 |
else |
1942 |
cr := Buffer; |
1943 |
j := FQSelect.FieldIndex[fn] + 1; |
1944 |
if (j > 0) then |
1945 |
with PRecordData(cr)^ do |
1946 |
begin |
1947 |
if Qry.Params[i].name = 'IBX_INTERNAL_DBKEY' then {do not localize} |
1948 |
begin |
1949 |
PIBDBKey(Qry.Params[i].AsPointer)^ := rdDBKey; |
1950 |
continue; |
1951 |
end; |
1952 |
if rdFields[j].fdIsNull then |
1953 |
Qry.Params[i].IsNull := True |
1954 |
else begin |
1955 |
Qry.Params[i].IsNull := False; |
1956 |
data := cr + rdFields[j].fdDataOfs; |
1957 |
case rdFields[j].fdDataType of |
1958 |
SQL_TEXT, SQL_VARYING: |
1959 |
begin |
1960 |
SetString(st, data, rdFields[j].fdDataLength); |
1961 |
Qry.Params[i].AsString := st; |
1962 |
end; |
1963 |
SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT: |
1964 |
Qry.Params[i].AsDouble := PDouble(data)^; |
1965 |
SQL_SHORT, SQL_LONG: |
1966 |
begin |
1967 |
if rdFields[j].fdDataScale = 0 then |
1968 |
Qry.Params[i].AsLong := PLong(data)^ |
1969 |
else if rdFields[j].fdDataScale >= (-4) then |
1970 |
Qry.Params[i].AsCurrency := PCurrency(data)^ |
1971 |
else |
1972 |
Qry.Params[i].AsDouble := PDouble(data)^; |
1973 |
end; |
1974 |
SQL_INT64: |
1975 |
begin |
1976 |
if rdFields[j].fdDataScale = 0 then |
1977 |
Qry.Params[i].AsInt64 := PInt64(data)^ |
1978 |
else if rdFields[j].fdDataScale >= (-4) then |
1979 |
Qry.Params[i].AsCurrency := PCurrency(data)^ |
1980 |
else |
1981 |
Qry.Params[i].AsDouble := PDouble(data)^; |
1982 |
end; |
1983 |
SQL_BLOB, SQL_ARRAY, SQL_QUAD: |
1984 |
Qry.Params[i].AsQuad := PISC_QUAD(data)^; |
1985 |
SQL_TYPE_DATE: |
1986 |
begin |
1987 |
ts.Date := PInt(data)^; |
1988 |
ts.Time := 0; |
1989 |
Qry.Params[i].AsDate := |
1990 |
TimeStampToDateTime(ts); |
1991 |
end; |
1992 |
SQL_TYPE_TIME: |
1993 |
begin |
1994 |
ts.Date := 0; |
1995 |
ts.Time := PInt(data)^; |
1996 |
Qry.Params[i].AsTime := |
1997 |
TimeStampToDateTime(ts); |
1998 |
end; |
1999 |
SQL_TIMESTAMP: |
2000 |
Qry.Params[i].AsDateTime := |
2001 |
TimeStampToDateTime( |
2002 |
MSecsToTimeStamp(PDouble(data)^)); |
2003 |
end; |
2004 |
end; |
2005 |
end; |
2006 |
end; |
2007 |
finally |
2008 |
if (OldBuffer <> nil) then |
2009 |
FreeRecordBuffer(PChar(OldBuffer)); |
2010 |
end; |
2011 |
end; |
2012 |
|
2013 |
procedure TIBCustomDataSet.SetRefreshSQL(Value: TStrings); |
2014 |
begin |
2015 |
if FQRefresh.SQL.Text <> Value.Text then |
2016 |
begin |
2017 |
Disconnect; |
2018 |
FQRefresh.SQL.Assign(Value); |
2019 |
end; |
2020 |
end; |
2021 |
|
2022 |
procedure TIBCustomDataSet.SetSelectSQL(Value: TStrings); |
2023 |
begin |
2024 |
if FQSelect.SQL.Text <> Value.Text then |
2025 |
begin |
2026 |
Disconnect; |
2027 |
FQSelect.SQL.Assign(Value); |
2028 |
end; |
2029 |
end; |
2030 |
|
2031 |
procedure TIBCustomDataSet.SetModifySQL(Value: TStrings); |
2032 |
begin |
2033 |
if FQModify.SQL.Text <> Value.Text then |
2034 |
begin |
2035 |
Disconnect; |
2036 |
FQModify.SQL.Assign(Value); |
2037 |
end; |
2038 |
end; |
2039 |
|
2040 |
procedure TIBCustomDataSet.SetTransaction(Value: TIBTransaction); |
2041 |
begin |
2042 |
if (FBase.Transaction <> Value) then |
2043 |
begin |
2044 |
CheckDatasetClosed; |
2045 |
FBase.Transaction := Value; |
2046 |
FQDelete.Transaction := Value; |
2047 |
FQInsert.Transaction := Value; |
2048 |
FQRefresh.Transaction := Value; |
2049 |
FQSelect.Transaction := Value; |
2050 |
FQModify.Transaction := Value; |
2051 |
end; |
2052 |
end; |
2053 |
|
2054 |
procedure TIBCustomDataSet.SetUniDirectional(Value: Boolean); |
2055 |
begin |
2056 |
CheckDatasetClosed; |
2057 |
FUniDirectional := Value; |
2058 |
end; |
2059 |
|
2060 |
procedure TIBCustomDataSet.SetUpdateRecordTypes(Value: TIBUpdateRecordTypes); |
2061 |
begin |
2062 |
FUpdateRecordTypes := Value; |
2063 |
if Active then |
2064 |
First; |
2065 |
end; |
2066 |
|
2067 |
procedure TIBCustomDataSet.RefreshParams; |
2068 |
var |
2069 |
DataSet: TDataSet; |
2070 |
begin |
2071 |
DisableControls; |
2072 |
try |
2073 |
if FDataLink.DataSource <> nil then |
2074 |
begin |
2075 |
DataSet := FDataLink.DataSource.DataSet; |
2076 |
if DataSet <> nil then |
2077 |
if DataSet.Active and (DataSet.State <> dsSetKey) then |
2078 |
begin |
2079 |
Close; |
2080 |
Open; |
2081 |
end; |
2082 |
end; |
2083 |
finally |
2084 |
EnableControls; |
2085 |
end; |
2086 |
end; |
2087 |
|
2088 |
|
2089 |
procedure TIBCustomDataSet.SQLChanging(Sender: TObject); |
2090 |
begin |
2091 |
if FOpen then |
2092 |
InternalClose; |
2093 |
if FInternalPrepared then |
2094 |
InternalUnPrepare; |
2095 |
end; |
2096 |
|
2097 |
{ I can "undelete" uninserted records (make them "inserted" again). |
2098 |
I can "undelete" cached deleted (the deletion hasn't yet occurred) } |
2099 |
procedure TIBCustomDataSet.Undelete; |
2100 |
var |
2101 |
Buff: PRecordData; |
2102 |
begin |
2103 |
CheckActive; |
2104 |
Buff := PRecordData(GetActiveBuf); |
2105 |
with Buff^ do |
2106 |
begin |
2107 |
if rdCachedUpdateStatus = cusUninserted then |
2108 |
begin |
2109 |
rdCachedUpdateStatus := cusInserted; |
2110 |
Dec(FDeletedRecords); |
2111 |
end |
2112 |
else if (rdUpdateStatus = usDeleted) and |
2113 |
(rdCachedUpdateStatus = cusDeleted) then |
2114 |
begin |
2115 |
rdCachedUpdateStatus := cusUnmodified; |
2116 |
rdUpdateStatus := usUnmodified; |
2117 |
Dec(FDeletedRecords); |
2118 |
end; |
2119 |
WriteRecordCache(rdRecordNumber, PChar(Buff)); |
2120 |
end; |
2121 |
end; |
2122 |
|
2123 |
function TIBCustomDataSet.UpdateStatus: TUpdateStatus; |
2124 |
begin |
2125 |
if Active then |
2126 |
if GetActiveBuf <> nil then |
2127 |
result := PRecordData(GetActiveBuf)^.rdUpdateStatus |
2128 |
else |
2129 |
result := usUnmodified |
2130 |
else |
2131 |
result := usUnmodified; |
2132 |
end; |
2133 |
|
2134 |
function TIBCustomDataSet.IsSequenced: Boolean; |
2135 |
begin |
2136 |
Result := Assigned( FQSelect ) and FQSelect.EOF; |
2137 |
end; |
2138 |
|
2139 |
function TIBCustomDataSet.AdjustPosition(FCache: PChar; Offset: DWORD; |
2140 |
Origin: Integer): Integer; |
2141 |
var |
2142 |
OldCacheSize: Integer; |
2143 |
begin |
2144 |
if (FCache = FBufferCache) then |
2145 |
begin |
2146 |
case Origin of |
2147 |
FILE_BEGIN: FBPos := Offset; |
2148 |
FILE_CURRENT: FBPos := FBPos + Offset; |
2149 |
FILE_END: FBPos := DWORD(FBEnd) + Offset; |
2150 |
end; |
2151 |
OldCacheSize := FCacheSize; |
2152 |
while (FBPos >= DWORD(FCacheSize)) do |
2153 |
Inc(FCacheSize, FBufferChunkSize); |
2154 |
if FCacheSize > OldCacheSize then |
2155 |
IBAlloc(FBufferCache, FCacheSize, FCacheSize); |
2156 |
result := FBPos; |
2157 |
end |
2158 |
else begin |
2159 |
case Origin of |
2160 |
FILE_BEGIN: FOBPos := Offset; |
2161 |
FILE_CURRENT: FOBPos := FOBPos + Offset; |
2162 |
FILE_END: FOBPos := DWORD(FOBEnd) + Offset; |
2163 |
end; |
2164 |
OldCacheSize := FOldCacheSize; |
2165 |
while (FBPos >= DWORD(FOldCacheSize)) do |
2166 |
Inc(FOldCacheSize, FBufferChunkSize); |
2167 |
if FOldCacheSize > OldCacheSize then |
2168 |
IBAlloc(FOldBufferCache, FOldCacheSize, FOldCacheSize); |
2169 |
result := FOBPos; |
2170 |
end; |
2171 |
end; |
2172 |
|
2173 |
procedure TIBCustomDataSet.ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer; |
2174 |
Buffer: PChar); |
2175 |
var |
2176 |
pCache: PChar; |
2177 |
bOld: Boolean; |
2178 |
begin |
2179 |
bOld := (FCache = FOldBufferCache); |
2180 |
pCache := PChar(AdjustPosition(FCache, Offset, Origin)); |
2181 |
if not bOld then |
2182 |
pCache := FBufferCache + Integer(pCache) |
2183 |
else |
2184 |
pCache := FOldBufferCache + Integer(pCache); |
2185 |
Move(pCache^, Buffer^, DWORD(FRecordBufferSize)); |
2186 |
AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT); |
2187 |
end; |
2188 |
|
2189 |
procedure TIBCustomDataSet.ReadRecordCache(RecordNumber: Integer; Buffer: PChar; |
2190 |
ReadOldBuffer: Boolean); |
2191 |
begin |
2192 |
if FUniDirectional then |
2193 |
RecordNumber := RecordNumber mod UniCache; |
2194 |
if (ReadOldBuffer) then |
2195 |
begin |
2196 |
ReadRecordCache(RecordNumber, Buffer, False); |
2197 |
if FCachedUpdates and |
2198 |
(PRecordData(Buffer)^.rdSavedOffset <> $FFFFFFFF) then |
2199 |
ReadCache(FOldBufferCache, PRecordData(Buffer)^.rdSavedOffset, FILE_BEGIN, |
2200 |
Buffer) |
2201 |
else |
2202 |
if ReadOldBuffer and |
2203 |
(PRecordData(FOldBuffer)^.rdRecordNumber = RecordNumber) then |
2204 |
CopyRecordBuffer( FOldBuffer, Buffer ) |
2205 |
end |
2206 |
else |
2207 |
ReadCache(FBufferCache, RecordNumber * FRecordBufferSize, FILE_BEGIN, Buffer); |
2208 |
end; |
2209 |
|
2210 |
procedure TIBCustomDataSet.WriteCache(FCache: PChar; Offset: DWORD; Origin: Integer; |
2211 |
Buffer: PChar); |
2212 |
var |
2213 |
pCache: PChar; |
2214 |
bOld: Boolean; |
2215 |
dwEnd: DWORD; |
2216 |
begin |
2217 |
bOld := (FCache = FOldBufferCache); |
2218 |
pCache := PChar(AdjustPosition(FCache, Offset, Origin)); |
2219 |
if not bOld then |
2220 |
pCache := FBufferCache + Integer(pCache) |
2221 |
else |
2222 |
pCache := FOldBufferCache + Integer(pCache); |
2223 |
Move(Buffer^, pCache^, FRecordBufferSize); |
2224 |
dwEnd := AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT); |
2225 |
if not bOld then |
2226 |
begin |
2227 |
if (dwEnd > FBEnd) then |
2228 |
FBEnd := dwEnd; |
2229 |
end |
2230 |
else begin |
2231 |
if (dwEnd > FOBEnd) then |
2232 |
FOBEnd := dwEnd; |
2233 |
end; |
2234 |
end; |
2235 |
|
2236 |
procedure TIBCustomDataSet.WriteRecordCache(RecordNumber: Integer; Buffer: PChar); |
2237 |
begin |
2238 |
if RecordNumber >= 0 then |
2239 |
begin |
2240 |
if FUniDirectional then |
2241 |
RecordNumber := RecordNumber mod UniCache; |
2242 |
WriteCache(FBufferCache, RecordNumber * FRecordBufferSize, FILE_BEGIN, Buffer); |
2243 |
end; |
2244 |
end; |
2245 |
|
2246 |
function TIBCustomDataSet.AllocRecordBuffer: PChar; |
2247 |
begin |
2248 |
result := nil; |
2249 |
IBAlloc(result, FRecordBufferSize, FRecordBufferSize); |
2250 |
Move(FModelBuffer^, result^, FRecordBufferSize); |
2251 |
end; |
2252 |
|
2253 |
function TIBCustomDataSet.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; |
2254 |
var |
2255 |
pb: PBlobDataArray; |
2256 |
fs: TIBBlobStream; |
2257 |
Buff: PChar; |
2258 |
bTr, bDB: Boolean; |
2259 |
begin |
2260 |
Buff := GetActiveBuf; |
2261 |
if Buff = nil then |
2262 |
begin |
2263 |
fs := TIBBlobStream.Create; |
2264 |
fs.Mode := bmReadWrite; |
2265 |
FBlobStreamList.Add(Pointer(fs)); |
2266 |
result := TIBDSBlobStream.Create(Field, fs, Mode); |
2267 |
exit; |
2268 |
end; |
2269 |
pb := PBlobDataArray(Buff + FBlobCacheOffset); |
2270 |
if pb^[Field.Offset] = nil then |
2271 |
begin |
2272 |
AdjustRecordOnInsert(Buff); |
2273 |
pb^[Field.Offset] := TIBBlobStream.Create; |
2274 |
fs := pb^[Field.Offset]; |
2275 |
FBlobStreamList.Add(Pointer(fs)); |
2276 |
fs.Mode := bmReadWrite; |
2277 |
fs.Database := Database; |
2278 |
fs.Transaction := Transaction; |
2279 |
fs.BlobID := |
2280 |
PISC_QUAD(@Buff[PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^; |
2281 |
if (CachedUpdates) then |
2282 |
begin |
2283 |
bTr := not Transaction.InTransaction; |
2284 |
bDB := not Database.Connected; |
2285 |
if bDB then |
2286 |
Database.Open; |
2287 |
if bTr then |
2288 |
Transaction.StartTransaction; |
2289 |
fs.Seek(0, soFromBeginning); |
2290 |
if bTr then |
2291 |
Transaction.Commit; |
2292 |
if bDB then |
2293 |
Database.Close; |
2294 |
end; |
2295 |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff)); |
2296 |
end else |
2297 |
fs := pb^[Field.Offset]; |
2298 |
result := TIBDSBlobStream.Create(Field, fs, Mode); |
2299 |
end; |
2300 |
|
2301 |
function TIBCustomDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; |
2302 |
const |
2303 |
CMPLess = -1; |
2304 |
CMPEql = 0; |
2305 |
CMPGtr = 1; |
2306 |
RetCodes: array[Boolean, Boolean] of ShortInt = ((2, CMPLess), |
2307 |
(CMPGtr, CMPEql)); |
2308 |
begin |
2309 |
result := RetCodes[Bookmark1 = nil, Bookmark2 = nil]; |
2310 |
|
2311 |
if Result = 2 then |
2312 |
begin |
2313 |
if PInteger(Bookmark1)^ < PInteger(Bookmark2)^ then |
2314 |
Result := CMPLess |
2315 |
else |
2316 |
if PInteger(Bookmark1)^ > PInteger(Bookmark2)^ then |
2317 |
Result := CMPGtr |
2318 |
else |
2319 |
Result := CMPEql; |
2320 |
end; |
2321 |
end; |
2322 |
|
2323 |
procedure TIBCustomDataSet.DoBeforeDelete; |
2324 |
var |
2325 |
Buff: PRecordData; |
2326 |
begin |
2327 |
if not CanDelete then |
2328 |
IBError(ibxeCannotDelete, [nil]); |
2329 |
Buff := PRecordData(GetActiveBuf); |
2330 |
if FCachedUpdates and |
2331 |
(Buff^.rdCachedUpdateStatus in [cusUnmodified]) then |
2332 |
SaveOldBuffer(PChar(Buff)); |
2333 |
inherited; |
2334 |
end; |
2335 |
|
2336 |
procedure TIBCustomDataSet.DoBeforeEdit; |
2337 |
var |
2338 |
Buff: PRecordData; |
2339 |
begin |
2340 |
Buff := PRecordData(GetActiveBuf); |
2341 |
if not(CanEdit or (FQModify.SQL.Count <> 0) or |
2342 |
(FCachedUpdates and Assigned(FOnUpdateRecord))) then |
2343 |
IBError(ibxeCannotUpdate, [nil]); |
2344 |
if FCachedUpdates and (Buff^.rdCachedUpdateStatus in [cusUnmodified, cusInserted]) then |
2345 |
SaveOldBuffer(PChar(Buff)); |
2346 |
CopyRecordBuffer(GetActiveBuf, FOldBuffer); |
2347 |
inherited; |
2348 |
end; |
2349 |
|
2350 |
procedure TIBCustomDataSet.DoBeforeInsert; |
2351 |
begin |
2352 |
if not CanInsert then |
2353 |
IBError(ibxeCannotInsert, [nil]); |
2354 |
inherited; |
2355 |
end; |
2356 |
|
2357 |
procedure TIBCustomDataSet.FetchAll; |
2358 |
var |
2359 |
SetCursor: Boolean; |
2360 |
CurBookmark: string; |
2361 |
begin |
2362 |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
2363 |
if SetCursor then |
2364 |
Screen.Cursor := crHourGlass; |
2365 |
try |
2366 |
if FQSelect.EOF or not FQSelect.Open then |
2367 |
exit; |
2368 |
DisableControls; |
2369 |
try |
2370 |
CurBookmark := Bookmark; |
2371 |
Last; |
2372 |
Bookmark := CurBookmark; |
2373 |
finally |
2374 |
EnableControls; |
2375 |
end; |
2376 |
finally |
2377 |
if SetCursor and (Screen.Cursor = crHourGlass) then |
2378 |
Screen.Cursor := crDefault; |
2379 |
end; |
2380 |
end; |
2381 |
|
2382 |
procedure TIBCustomDataSet.FreeRecordBuffer(var Buffer: PChar); |
2383 |
begin |
2384 |
FreeMem(Buffer); |
2385 |
Buffer := nil; |
2386 |
end; |
2387 |
|
2388 |
procedure TIBCustomDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer); |
2389 |
begin |
2390 |
Move(PRecordData(Buffer)^.rdRecordNumber, Data^, BookmarkSize); |
2391 |
end; |
2392 |
|
2393 |
function TIBCustomDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; |
2394 |
begin |
2395 |
result := PRecordData(Buffer)^.rdBookmarkFlag; |
2396 |
end; |
2397 |
|
2398 |
function TIBCustomDataSet.GetCanModify: Boolean; |
2399 |
begin |
2400 |
result := (FQInsert.SQL.Text <> '') or |
2401 |
(FQModify.SQL.Text <> '') or |
2402 |
(FQDelete.SQL.Text <> '') or |
2403 |
(Assigned(FUpdateObject)); |
2404 |
end; |
2405 |
|
2406 |
function TIBCustomDataSet.GetCurrentRecord(Buffer: PChar): Boolean; |
2407 |
begin |
2408 |
if not IsEmpty and (GetBookmarkFlag(ActiveBuffer) = bfCurrent) then |
2409 |
begin |
2410 |
UpdateCursorPos; |
2411 |
ReadRecordCache(PRecordData(ActiveBuffer)^.rdRecordNumber, Buffer, False); |
2412 |
result := True; |
2413 |
end |
2414 |
else |
2415 |
result := False; |
2416 |
end; |
2417 |
|
2418 |
function TIBCustomDataSet.GetDataSource: TDataSource; |
2419 |
begin |
2420 |
if FDataLink = nil then |
2421 |
result := nil |
2422 |
else |
2423 |
result := FDataLink.DataSource; |
2424 |
end; |
2425 |
|
2426 |
function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass; |
2427 |
begin |
2428 |
Result := DefaultFieldClasses[FieldType]; |
2429 |
end; |
2430 |
|
2431 |
function TIBCustomDataSet.GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; |
2432 |
begin |
2433 |
result := GetFieldData(FieldByNumber(FieldNo), buffer); |
2434 |
end; |
2435 |
|
2436 |
function TIBCustomDataSet.InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean; |
2437 |
var |
2438 |
Buff, Data: PChar; |
2439 |
CurrentRecord: PRecordData; |
2440 |
begin |
2441 |
result := False; |
2442 |
Buff := GetActiveBuf; |
2443 |
if (Buff = nil) or |
2444 |
(not IsVisible(Buff)) then |
2445 |
exit; |
2446 |
{ The intention here is to stuff the buffer with the data for the |
2447 |
referenced field for the current record } |
2448 |
CurrentRecord := PRecordData(Buff); |
2449 |
if (Field.FieldNo < 0) then |
2450 |
begin |
2451 |
Inc(Buff, FRecordSize + Field.Offset); |
2452 |
result := Boolean(Buff[0]); |
2453 |
if result and (Buffer <> nil) then |
2454 |
Move(Buff[1], Buffer^, Field.DataSize); |
2455 |
end |
2456 |
else if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and |
2457 |
(FMappedFieldPosition[Field.FieldNo - 1] <= CurrentRecord^.rdFieldCount) then |
2458 |
begin |
2459 |
result := not CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull; |
2460 |
if result and (Buffer <> nil) then |
2461 |
with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]] do |
2462 |
begin |
2463 |
Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs; |
2464 |
if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then |
2465 |
begin |
2466 |
Move(Data^, Buffer^, fdDataLength); |
2467 |
PChar(Buffer)[fdDataLength] := #0; |
2468 |
end |
2469 |
else |
2470 |
Move(Data^, Buffer^, Field.DataSize); |
2471 |
end; |
2472 |
end; |
2473 |
end; |
2474 |
|
2475 |
{ GetRecNo and SetRecNo both operate off of 1-based indexes as |
2476 |
opposed to 0-based indexes. |
2477 |
This is because we want LastRecordNumber/RecordCount = 1 } |
2478 |
|
2479 |
function TIBCustomDataSet.GetRecNo: Integer; |
2480 |
begin |
2481 |
if GetActiveBuf = nil then |
2482 |
result := 0 |
2483 |
else |
2484 |
result := PRecordData(GetActiveBuf)^.rdRecordNumber + 1; |
2485 |
end; |
2486 |
|
2487 |
function TIBCustomDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode; |
2488 |
DoCheck: Boolean): TGetResult; |
2489 |
var |
2490 |
Accept: Boolean; |
2491 |
SaveState: TDataSetState; |
2492 |
begin |
2493 |
Result := grOK; |
2494 |
if Filtered and Assigned(OnFilterRecord) then |
2495 |
begin |
2496 |
Accept := False; |
2497 |
SaveState := SetTempState(dsFilter); |
2498 |
while not Accept do |
2499 |
begin |
2500 |
Result := InternalGetRecord(Buffer, GetMode, DoCheck); |
2501 |
if Result <> grOK then |
2502 |
break; |
2503 |
FFilterBuffer := Buffer; |
2504 |
try |
2505 |
Accept := True; |
2506 |
OnFilterRecord(Self, Accept); |
2507 |
if not Accept and (GetMode = gmCurrent) then |
2508 |
GetMode := gmPrior; |
2509 |
except |
2510 |
// Application.HandleException(Self); |
2511 |
end; |
2512 |
end; |
2513 |
RestoreState(SaveState); |
2514 |
end |
2515 |
else |
2516 |
Result := InternalGetRecord(Buffer, GetMode, DoCheck); |
2517 |
end; |
2518 |
|
2519 |
function TIBCustomDataSet.InternalGetRecord(Buffer: PChar; GetMode: TGetMode; |
2520 |
DoCheck: Boolean): TGetResult; |
2521 |
begin |
2522 |
result := grError; |
2523 |
case GetMode of |
2524 |
gmCurrent: begin |
2525 |
if (FCurrentRecord >= 0) then begin |
2526 |
if FCurrentRecord < FRecordCount then |
2527 |
ReadRecordCache(FCurrentRecord, Buffer, False) |
2528 |
else begin |
2529 |
while (not FQSelect.EOF) and |
2530 |
(FQSelect.Next <> nil) and |
2531 |
(FCurrentRecord >= FRecordCount) do begin |
2532 |
FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer); |
2533 |
Inc(FRecordCount); |
2534 |
end; |
2535 |
FCurrentRecord := FRecordCount - 1; |
2536 |
if (FCurrentRecord >= 0) then |
2537 |
ReadRecordCache(FCurrentRecord, Buffer, False); |
2538 |
end; |
2539 |
result := grOk; |
2540 |
end else |
2541 |
result := grBOF; |
2542 |
end; |
2543 |
gmNext: begin |
2544 |
result := grOk; |
2545 |
if FCurrentRecord = FRecordCount then |
2546 |
result := grEOF |
2547 |
else if FCurrentRecord = FRecordCount - 1 then begin |
2548 |
if (not FQSelect.EOF) then begin |
2549 |
FQSelect.Next; |
2550 |
Inc(FCurrentRecord); |
2551 |
end; |
2552 |
if (FQSelect.EOF) then begin |
2553 |
result := grEOF; |
2554 |
end else begin |
2555 |
Inc(FRecordCount); |
2556 |
FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer); |
2557 |
end; |
2558 |
end else if (FCurrentRecord < FRecordCount) then begin |
2559 |
Inc(FCurrentRecord); |
2560 |
ReadRecordCache(FCurrentRecord, Buffer, False); |
2561 |
end; |
2562 |
end; |
2563 |
else { gmPrior } |
2564 |
begin |
2565 |
if (FCurrentRecord = 0) then begin |
2566 |
Dec(FCurrentRecord); |
2567 |
result := grBOF; |
2568 |
end else if (FCurrentRecord > 0) and |
2569 |
(FCurrentRecord <= FRecordCount) then begin |
2570 |
Dec(FCurrentRecord); |
2571 |
ReadRecordCache(FCurrentRecord, Buffer, False); |
2572 |
result := grOk; |
2573 |
end else if (FCurrentRecord = -1) then |
2574 |
result := grBOF; |
2575 |
end; |
2576 |
end; |
2577 |
if result = grOk then |
2578 |
result := AdjustCurrentRecord(Buffer, GetMode); |
2579 |
if result = grOk then with PRecordData(Buffer)^ do begin |
2580 |
rdBookmarkFlag := bfCurrent; |
2581 |
GetCalcFields(Buffer); |
2582 |
end else if (result = grEOF) then begin |
2583 |
CopyRecordBuffer(FModelBuffer, Buffer); |
2584 |
PRecordData(Buffer)^.rdBookmarkFlag := bfEOF; |
2585 |
end else if (result = grBOF) then begin |
2586 |
CopyRecordBuffer(FModelBuffer, Buffer); |
2587 |
PRecordData(Buffer)^.rdBookmarkFlag := bfBOF; |
2588 |
end else if (result = grError) then begin |
2589 |
CopyRecordBuffer(FModelBuffer, Buffer); |
2590 |
PRecordData(Buffer)^.rdBookmarkFlag := bfEOF; |
2591 |
end;; |
2592 |
end; |
2593 |
|
2594 |
function TIBCustomDataSet.GetRecordCount: Integer; |
2595 |
begin |
2596 |
result := FRecordCount - FDeletedRecords; |
2597 |
end; |
2598 |
|
2599 |
function TIBCustomDataSet.GetRecordSize: Word; |
2600 |
begin |
2601 |
result := FRecordBufferSize; |
2602 |
end; |
2603 |
|
2604 |
procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean); |
2605 |
begin |
2606 |
CheckEditState; |
2607 |
begin |
2608 |
{ When adding records, we *always* append. |
2609 |
Insertion is just too costly } |
2610 |
AdjustRecordOnInsert(Buffer); |
2611 |
with PRecordData(Buffer)^ do |
2612 |
begin |
2613 |
rdUpdateStatus := usInserted; |
2614 |
rdCachedUpdateStatus := cusInserted; |
2615 |
end; |
2616 |
if not CachedUpdates then |
2617 |
InternalPostRecord(FQInsert, Buffer) |
2618 |
else begin |
2619 |
WriteRecordCache(FCurrentRecord, Buffer); |
2620 |
FUpdatesPending := True; |
2621 |
end; |
2622 |
Inc(FRecordCount); |
2623 |
InternalSetToRecord(Buffer); |
2624 |
end |
2625 |
end; |
2626 |
|
2627 |
procedure TIBCustomDataSet.InternalCancel; |
2628 |
var |
2629 |
Buff: PChar; |
2630 |
CurRec: Integer; |
2631 |
begin |
2632 |
inherited; |
2633 |
Buff := GetActiveBuf; |
2634 |
if Buff <> nil then begin |
2635 |
CurRec := FCurrentRecord; |
2636 |
AdjustRecordOnInsert(Buff); |
2637 |
if (State = dsEdit) then begin |
2638 |
CopyRecordBuffer(FOldBuffer, Buff); |
2639 |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff); |
2640 |
end else begin |
2641 |
CopyRecordBuffer(FModelBuffer, Buff); |
2642 |
PRecordData(Buff)^.rdUpdateStatus := usDeleted; |
2643 |
PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified; |
2644 |
PRecordData(Buff)^.rdBookmarkFlag := bfEOF; |
2645 |
FCurrentRecord := CurRec; |
2646 |
end; |
2647 |
end; |
2648 |
end; |
2649 |
|
2650 |
|
2651 |
procedure TIBCustomDataSet.InternalClose; |
2652 |
begin |
2653 |
if FDidActivate then |
2654 |
DeactivateTransaction; |
2655 |
FQSelect.Close; |
2656 |
ClearBlobCache; |
2657 |
FreeRecordBuffer(FModelBuffer); |
2658 |
FreeRecordBuffer(FOldBuffer); |
2659 |
FCurrentRecord := -1; |
2660 |
FOpen := False; |
2661 |
FRecordCount := 0; |
2662 |
FDeletedRecords := 0; |
2663 |
FRecordSize := 0; |
2664 |
FBPos := 0; |
2665 |
FOBPos := 0; |
2666 |
FCacheSize := 0; |
2667 |
FOldCacheSize := 0; |
2668 |
FBEnd := 0; |
2669 |
FOBEnd := 0; |
2670 |
FreeMem(FBufferCache); |
2671 |
FBufferCache := nil; |
2672 |
FreeMem(FOldBufferCache); |
2673 |
FOldBufferCache := nil; |
2674 |
BindFields(False); |
2675 |
if DefaultFields then DestroyFields; |
2676 |
end; |
2677 |
|
2678 |
procedure TIBCustomDataSet.InternalDelete; |
2679 |
var |
2680 |
Buff: PChar; |
2681 |
SetCursor: Boolean; |
2682 |
begin |
2683 |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
2684 |
if SetCursor then |
2685 |
Screen.Cursor := crHourGlass; |
2686 |
try |
2687 |
Buff := GetActiveBuf; |
2688 |
if CanDelete then |
2689 |
begin |
2690 |
if not CachedUpdates then |
2691 |
InternalDeleteRecord(FQDelete, Buff) |
2692 |
else |
2693 |
begin |
2694 |
with PRecordData(Buff)^ do |
2695 |
begin |
2696 |
if rdCachedUpdateStatus = cusInserted then |
2697 |
rdCachedUpdateStatus := cusUninserted |
2698 |
else begin |
2699 |
rdUpdateStatus := usDeleted; |
2700 |
rdCachedUpdateStatus := cusDeleted; |
2701 |
end; |
2702 |
end; |
2703 |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff); |
2704 |
end; |
2705 |
Inc(FDeletedRecords); |
2706 |
FUpdatesPending := True; |
2707 |
end else |
2708 |
IBError(ibxeCannotDelete, [nil]); |
2709 |
finally |
2710 |
if SetCursor and (Screen.Cursor = crHourGlass) then |
2711 |
Screen.Cursor := crDefault; |
2712 |
end; |
2713 |
end; |
2714 |
|
2715 |
procedure TIBCustomDataSet.InternalFirst; |
2716 |
begin |
2717 |
FCurrentRecord := -1; |
2718 |
end; |
2719 |
|
2720 |
procedure TIBCustomDataSet.InternalGotoBookmark(Bookmark: Pointer); |
2721 |
begin |
2722 |
FCurrentRecord := PInteger(Bookmark)^; |
2723 |
end; |
2724 |
|
2725 |
procedure TIBCustomDataSet.InternalHandleException; |
2726 |
begin |
2727 |
Application.HandleException(Self) |
2728 |
end; |
2729 |
|
2730 |
procedure TIBCustomDataSet.InternalInitFieldDefs; |
2731 |
const |
2732 |
DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize} |
2733 |
'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize} |
2734 |
'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize} |
2735 |
'where R.RDB$RELATION_NAME = :RELATION ' + {do not localize} |
2736 |
'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize} |
2737 |
'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize} |
2738 |
' (not F.RDB$DEFAULT_VALUE is NULL)) '; {do not localize} |
2739 |
var |
2740 |
FieldType: TFieldType; |
2741 |
FieldSize: Word; |
2742 |
FieldNullable : Boolean; |
2743 |
i, FieldPosition, FieldPrecision: Integer; |
2744 |
FieldAliasName: string; |
2745 |
RelationName, FieldName: string; |
2746 |
Query : TIBSQL; |
2747 |
FieldIndex: Integer; |
2748 |
FRelationNodes : TRelationNode; |
2749 |
|
2750 |
function Add_Node(Relation, Field : String) : TRelationNode; |
2751 |
var |
2752 |
FField : TFieldNode; |
2753 |
begin |
2754 |
if FRelationNodes.RelationName = '' then |
2755 |
Result := FRelationNodes |
2756 |
else |
2757 |
begin |
2758 |
Result := TRelationNode.Create; |
2759 |
Result.NextRelation := FRelationNodes; |
2760 |
end; |
2761 |
Result.RelationName := Relation; |
2762 |
FRelationNodes := Result; |
2763 |
Query.Params[0].AsString := Relation; |
2764 |
Query.ExecQuery; |
2765 |
while not Query.Eof do |
2766 |
begin |
2767 |
FField := TFieldNode.Create; |
2768 |
FField.FieldName := Query.Fields[2].AsString; |
2769 |
FField.DEFAULT_VALUE := not Query.Fields[1].IsNull; |
2770 |
FField.COMPUTED_BLR := not Query.Fields[0].IsNull; |
2771 |
FField.NextField := Result.FieldNodes; |
2772 |
Result.FieldNodes := FField; |
2773 |
Query.Next; |
2774 |
end; |
2775 |
Query.Close; |
2776 |
end; |
2777 |
|
2778 |
function Has_COMPUTED_BLR(Relation, Field : String) : Boolean; |
2779 |
var |
2780 |
FRelation : TRelationNode; |
2781 |
FField : TFieldNode; |
2782 |
begin |
2783 |
FRelation := FRelationNodes; |
2784 |
while Assigned(FRelation) and |
2785 |
(FRelation.RelationName <> Relation) do |
2786 |
FRelation := FRelation.NextRelation; |
2787 |
if not Assigned(FRelation) then |
2788 |
FRelation := Add_Node(Relation, Field); |
2789 |
Result := false; |
2790 |
FField := FRelation.FieldNodes; |
2791 |
while Assigned(FField) do |
2792 |
if FField.FieldName = Field then |
2793 |
begin |
2794 |
Result := Ffield.COMPUTED_BLR; |
2795 |
Exit; |
2796 |
end |
2797 |
else |
2798 |
FField := Ffield.NextField; |
2799 |
end; |
2800 |
|
2801 |
function Has_DEFAULT_VALUE(Relation, Field : String) : Boolean; |
2802 |
var |
2803 |
FRelation : TRelationNode; |
2804 |
FField : TFieldNode; |
2805 |
begin |
2806 |
FRelation := FRelationNodes; |
2807 |
while Assigned(FRelation) and |
2808 |
(FRelation.RelationName <> Relation) do |
2809 |
FRelation := FRelation.NextRelation; |
2810 |
if not Assigned(FRelation) then |
2811 |
FRelation := Add_Node(Relation, Field); |
2812 |
Result := false; |
2813 |
FField := FRelation.FieldNodes; |
2814 |
while Assigned(FField) do |
2815 |
if FField.FieldName = Field then |
2816 |
begin |
2817 |
Result := Ffield.DEFAULT_VALUE; |
2818 |
Exit; |
2819 |
end |
2820 |
else |
2821 |
FField := Ffield.NextField; |
2822 |
end; |
2823 |
|
2824 |
Procedure FreeNodes; |
2825 |
var |
2826 |
FRelation : TRelationNode; |
2827 |
FField : TFieldNode; |
2828 |
begin |
2829 |
while Assigned(FRelationNodes) do |
2830 |
begin |
2831 |
While Assigned(FRelationNodes.FieldNodes) do |
2832 |
begin |
2833 |
FField := FRelationNodes.FieldNodes.NextField; |
2834 |
FRelationNodes.FieldNodes.Free; |
2835 |
FRelationNodes.FieldNodes := FField; |
2836 |
end; |
2837 |
FRelation := FRelationNodes.NextRelation; |
2838 |
FRelationNodes.Free; |
2839 |
FRelationNodes := FRelation; |
2840 |
end; |
2841 |
end; |
2842 |
|
2843 |
begin |
2844 |
if not InternalPrepared then |
2845 |
begin |
2846 |
InternalPrepare; |
2847 |
exit; |
2848 |
end; |
2849 |
FRelationNodes := TRelationNode.Create; |
2850 |
FNeedsRefresh := False; |
2851 |
Database.InternalTransaction.StartTransaction; |
2852 |
Query := TIBSQL.Create(self); |
2853 |
try |
2854 |
Query.Database := DataBase; |
2855 |
Query.Transaction := Database.InternalTransaction; |
2856 |
FieldDefs.BeginUpdate; |
2857 |
FieldDefs.Clear; |
2858 |
FieldIndex := 0; |
2859 |
if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then |
2860 |
SetLength(FMappedFieldPosition, FQSelect.Current.Count); |
2861 |
Query.SQL.Text := DefaultSQL; |
2862 |
Query.Prepare; |
2863 |
for i := 0 to FQSelect.Current.Count - 1 do |
2864 |
with FQSelect.Current[i].Data^ do |
2865 |
begin |
2866 |
{ Get the field name } |
2867 |
SetString(FieldAliasName, aliasname, aliasname_length); |
2868 |
SetString(RelationName, relname, relname_length); |
2869 |
SetString(FieldName, sqlname, sqlname_length); |
2870 |
FieldSize := 0; |
2871 |
FieldPrecision := 0; |
2872 |
FieldNullable := FQSelect.Current[i].IsNullable; |
2873 |
case sqltype and not 1 of |
2874 |
{ All VARCHAR's must be converted to strings before recording |
2875 |
their values } |
2876 |
SQL_VARYING, SQL_TEXT: |
2877 |
begin |
2878 |
FieldSize := sqllen; |
2879 |
FieldType := ftString; |
2880 |
end; |
2881 |
{ All Doubles/Floats should be cast to doubles } |
2882 |
SQL_DOUBLE, SQL_FLOAT: |
2883 |
FieldType := ftFloat; |
2884 |
SQL_SHORT: |
2885 |
begin |
2886 |
if (sqlscale = 0) then |
2887 |
FieldType := ftSmallInt |
2888 |
else begin |
2889 |
FieldType := ftBCD; |
2890 |
FieldPrecision := 4; |
2891 |
FieldSize := -sqlscale; |
2892 |
end; |
2893 |
end; |
2894 |
SQL_LONG: |
2895 |
begin |
2896 |
if (sqlscale = 0) then |
2897 |
FieldType := ftInteger |
2898 |
else if (sqlscale >= (-4)) then |
2899 |
begin |
2900 |
FieldType := ftBCD; |
2901 |
FieldPrecision := 9; |
2902 |
FieldSize := -sqlscale; |
2903 |
end |
2904 |
else |
2905 |
FieldType := ftFloat; |
2906 |
end; |
2907 |
SQL_INT64: |
2908 |
begin |
2909 |
if (sqlscale = 0) then |
2910 |
FieldType := ftLargeInt |
2911 |
else if (sqlscale >= (-4)) then |
2912 |
begin |
2913 |
FieldType := ftBCD; |
2914 |
FieldPrecision := 18; |
2915 |
FieldSize := -sqlscale; |
2916 |
end |
2917 |
else |
2918 |
FieldType := ftFloat; |
2919 |
end; |
2920 |
SQL_TIMESTAMP: FieldType := ftDateTime; |
2921 |
SQL_TYPE_TIME: FieldType := ftTime; |
2922 |
SQL_TYPE_DATE: FieldType := ftDate; |
2923 |
SQL_BLOB: |
2924 |
begin |
2925 |
FieldSize := sizeof (TISC_QUAD); |
2926 |
if (sqlsubtype = 1) then |
2927 |
FieldType := ftmemo |
2928 |
else |
2929 |
FieldType := ftBlob; |
2930 |
end; |
2931 |
SQL_ARRAY: |
2932 |
begin |
2933 |
FieldSize := sizeof (TISC_QUAD); |
2934 |
FieldType := ftUnknown; |
2935 |
end; |
2936 |
else |
2937 |
FieldType := ftUnknown; |
2938 |
end; |
2939 |
FieldPosition := i + 1; |
2940 |
if (FieldType <> ftUnknown) and (FieldAliasName <> 'IBX_INTERNAL_DBKEY') then {do not localize} |
2941 |
begin |
2942 |
FMappedFieldPosition[FieldIndex] := FieldPosition; |
2943 |
Inc(FieldIndex); |
2944 |
with FieldDefs.AddFieldDef do |
2945 |
begin |
2946 |
Name := string( FieldAliasName ); |
2947 |
FieldNo := FieldPosition; |
2948 |
DataType := FieldType; |
2949 |
Size := FieldSize; |
2950 |
Precision := FieldPrecision; |
2951 |
Required := False; |
2952 |
InternalCalcField := False; |
2953 |
if (FieldName <> '') and (RelationName <> '') then |
2954 |
begin |
2955 |
if Has_COMPUTED_BLR(RelationName, FieldName) then |
2956 |
begin |
2957 |
Attributes := [faReadOnly]; |
2958 |
InternalCalcField := True; |
2959 |
FNeedsRefresh := True; |
2960 |
end |
2961 |
else |
2962 |
begin |
2963 |
if Has_DEFAULT_VALUE(RelationName, FieldName) then |
2964 |
begin |
2965 |
if not FieldNullable then |
2966 |
Attributes := [faRequired]; |
2967 |
end |
2968 |
else |
2969 |
FNeedsRefresh := True; |
2970 |
end; |
2971 |
end; |
2972 |
end; |
2973 |
end; |
2974 |
end; |
2975 |
finally |
2976 |
Query.free; |
2977 |
FreeNodes; |
2978 |
Database.InternalTransaction.Commit; |
2979 |
FieldDefs.EndUpdate; |
2980 |
end; |
2981 |
end; |
2982 |
|
2983 |
procedure TIBCustomDataSet.InternalInitRecord(Buffer: PChar); |
2984 |
begin |
2985 |
CopyRecordBuffer(FModelBuffer, Buffer); |
2986 |
end; |
2987 |
|
2988 |
procedure TIBCustomDataSet.InternalLast; |
2989 |
var |
2990 |
Buffer: PChar; |
2991 |
begin |
2992 |
if (FQSelect.EOF) then |
2993 |
FCurrentRecord := FRecordCount |
2994 |
else begin |
2995 |
Buffer := AllocRecordBuffer; |
2996 |
try |
2997 |
while FQSelect.Next <> nil do |
2998 |
begin |
2999 |
FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer); |
3000 |
Inc(FRecordCount); |
3001 |
end; |
3002 |
FCurrentRecord := FRecordCount; |
3003 |
finally |
3004 |
FreeRecordBuffer(Buffer); |
3005 |
end; |
3006 |
end; |
3007 |
end; |
3008 |
|
3009 |
procedure TIBCustomDataSet.InternalSetParamsFromCursor; |
3010 |
var |
3011 |
i: Integer; |
3012 |
cur_param: TIBXSQLVAR; |
3013 |
cur_field: TField; |
3014 |
s: TStream; |
3015 |
begin |
3016 |
if FQSelect.SQL.Text = '' then |
3017 |
IBError(ibxeEmptyQuery, [nil]); |
3018 |
if not FInternalPrepared then |
3019 |
InternalPrepare; |
3020 |
if (SQLParams.Count > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then |
3021 |
begin |
3022 |
for i := 0 to SQLParams.Count - 1 do |
3023 |
begin |
3024 |
cur_field := DataSource.DataSet.FindField(SQLParams[i].Name); |
3025 |
cur_param := SQLParams[i]; |
3026 |
if (cur_field <> nil) then begin |
3027 |
if (cur_field.IsNull) then |
3028 |
cur_param.IsNull := True |
3029 |
else case cur_field.DataType of |
3030 |
ftString: |
3031 |
cur_param.AsString := cur_field.AsString; |
3032 |
ftBoolean, ftSmallint, ftWord: |
3033 |
cur_param.AsShort := cur_field.AsInteger; |
3034 |
ftInteger: |
3035 |
cur_param.AsLong := cur_field.AsInteger; |
3036 |
ftLargeInt: |
3037 |
cur_param.AsInt64 := TLargeIntField(cur_field).AsLargeInt; |
3038 |
ftFloat, ftCurrency: |
3039 |
cur_param.AsDouble := cur_field.AsFloat; |
3040 |
ftBCD: |
3041 |
cur_param.AsCurrency := cur_field.AsCurrency; |
3042 |
ftDate: |
3043 |
cur_param.AsDate := cur_field.AsDateTime; |
3044 |
ftTime: |
3045 |
cur_param.AsTime := cur_field.AsDateTime; |
3046 |
ftDateTime: |
3047 |
cur_param.AsDateTime := cur_field.AsDateTime; |
3048 |
ftBlob, ftMemo: |
3049 |
begin |
3050 |
s := nil; |
3051 |
try |
3052 |
s := DataSource.DataSet. |
3053 |
CreateBlobStream(cur_field, bmRead); |
3054 |
cur_param.LoadFromStream(s); |
3055 |
finally |
3056 |
s.free; |
3057 |
end; |
3058 |
end; |
3059 |
else |
3060 |
IBError(ibxeNotSupported, [nil]); |
3061 |
end; |
3062 |
end; |
3063 |
end; |
3064 |
end; |
3065 |
end; |
3066 |
|
3067 |
procedure TIBCustomDataSet.ReQuery; |
3068 |
begin |
3069 |
FQSelect.Close; |
3070 |
ClearBlobCache; |
3071 |
FCurrentRecord := -1; |
3072 |
FRecordCount := 0; |
3073 |
FDeletedRecords := 0; |
3074 |
FBPos := 0; |
3075 |
FOBPos := 0; |
3076 |
FBEnd := 0; |
3077 |
FOBEnd := 0; |
3078 |
FQSelect.Close; |
3079 |
FQSelect.ExecQuery; |
3080 |
FOpen := FQSelect.Open; |
3081 |
First; |
3082 |
end; |
3083 |
|
3084 |
procedure TIBCustomDataSet.InternalOpen; |
3085 |
var |
3086 |
SetCursor: Boolean; |
3087 |
|
3088 |
function RecordDataLength(n: Integer): Long; |
3089 |
begin |
3090 |
result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData)); |
3091 |
end; |
3092 |
|
3093 |
begin |
3094 |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
3095 |
if SetCursor then |
3096 |
Screen.Cursor := crHourGlass; |
3097 |
try |
3098 |
ActivateConnection; |
3099 |
ActivateTransaction; |
3100 |
if FQSelect.SQL.Text = '' then |
3101 |
IBError(ibxeEmptyQuery, [nil]); |
3102 |
if not FInternalPrepared then |
3103 |
InternalPrepare; |
3104 |
if FQSelect.SQLType = SQLSelect then |
3105 |
begin |
3106 |
if DefaultFields then |
3107 |
CreateFields; |
3108 |
BindFields(True); |
3109 |
FCurrentRecord := -1; |
3110 |
FQSelect.ExecQuery; |
3111 |
FOpen := FQSelect.Open; |
3112 |
|
3113 |
{ Initialize offsets, buffer sizes, etc... |
3114 |
1. Initially FRecordSize is just the "RecordDataLength". |
3115 |
2. Allocate a "model" buffer and do a dummy fetch |
3116 |
3. After the dummy fetch, FRecordSize will be appropriately |
3117 |
adjusted to reflect the additional "weight" of the field |
3118 |
data. |
3119 |
4. Set up the FCalcFieldsOffset, FBlobCacheOffset and FRecordBufferSize. |
3120 |
5. Now, with the BufferSize available, allocate memory for chunks of records |
3121 |
6. Re-allocate the model buffer, accounting for the new |
3122 |
FRecordBufferSize. |
3123 |
7. Finally, calls to AllocRecordBuffer will work!. |
3124 |
} |
3125 |
{Step 1} |
3126 |
FRecordSize := RecordDataLength(FQSelect.Current.Count); |
3127 |
{Step 2, 3} |
3128 |
IBAlloc(FModelBuffer, 0, FRecordSize); |
3129 |
FetchCurrentRecordToBuffer(FQSelect, -1, FModelBuffer); |
3130 |
{Step 4} |
3131 |
FCalcFieldsOffset := FRecordSize; |
3132 |
FBlobCacheOffset := FCalcFieldsOffset + CalcFieldsSize; |
3133 |
FRecordBufferSize := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream))); |
3134 |
{Step 5} |
3135 |
if UniDirectional then |
3136 |
FBufferChunkSize := FRecordBufferSize * UniCache |
3137 |
else |
3138 |
FBufferChunkSize := FRecordBufferSize * BufferChunks; |
3139 |
IBAlloc(FBufferCache, FBufferChunkSize, FBufferChunkSize); |
3140 |
if FCachedUpdates or (csReading in ComponentState) then |
3141 |
IBAlloc(FOldBufferCache, FBufferChunkSize, FBufferChunkSize); |
3142 |
FBPos := 0; |
3143 |
FOBPos := 0; |
3144 |
FBEnd := 0; |
3145 |
FOBEnd := 0; |
3146 |
FCacheSize := FBufferChunkSize; |
3147 |
FOldCacheSize := FBufferChunkSize; |
3148 |
{Step 6} |
3149 |
IBAlloc(FModelBuffer, RecordDataLength(FQSelect.Current.Count), |
3150 |
FRecordBufferSize); |
3151 |
{Step 7} |
3152 |
FOldBuffer := AllocRecordBuffer; |
3153 |
end |
3154 |
else |
3155 |
FQSelect.ExecQuery; |
3156 |
finally |
3157 |
if SetCursor and (Screen.Cursor = crHourGlass) then |
3158 |
Screen.Cursor := crDefault; |
3159 |
end; |
3160 |
end; |
3161 |
|
3162 |
procedure TIBCustomDataSet.InternalPost; |
3163 |
var |
3164 |
Qry: TIBSQL; |
3165 |
Buff: PChar; |
3166 |
SetCursor: Boolean; |
3167 |
bInserting: Boolean; |
3168 |
begin |
3169 |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
3170 |
if SetCursor then |
3171 |
Screen.Cursor := crHourGlass; |
3172 |
try |
3173 |
Buff := GetActiveBuf; |
3174 |
CheckEditState; |
3175 |
AdjustRecordOnInsert(Buff); |
3176 |
if (State = dsInsert) then |
3177 |
begin |
3178 |
bInserting := True; |
3179 |
Qry := FQInsert; |
3180 |
PRecordData(Buff)^.rdUpdateStatus := usInserted; |
3181 |
PRecordData(Buff)^.rdCachedUpdateStatus := cusInserted; |
3182 |
WriteRecordCache(FRecordCount, Buff); |
3183 |
FCurrentRecord := FRecordCount; |
3184 |
end |
3185 |
else begin |
3186 |
bInserting := False; |
3187 |
Qry := FQModify; |
3188 |
if PRecordData(Buff)^.rdCachedUpdateStatus = cusUnmodified then |
3189 |
begin |
3190 |
PRecordData(Buff)^.rdUpdateStatus := usModified; |
3191 |
PRecordData(Buff)^.rdCachedUpdateStatus := cusModified; |
3192 |
end |
3193 |
else if PRecordData(Buff)^. |
3194 |
rdCachedUpdateStatus = cusUninserted then |
3195 |
begin |
3196 |
PRecordData(Buff)^.rdCachedUpdateStatus := cusInserted; |
3197 |
Dec(FDeletedRecords); |
3198 |
end; |
3199 |
end; |
3200 |
if (not CachedUpdates) then |
3201 |
InternalPostRecord(Qry, Buff) |
3202 |
else begin |
3203 |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff); |
3204 |
FUpdatesPending := True; |
3205 |
end; |
3206 |
if bInserting then |
3207 |
Inc(FRecordCount); |
3208 |
finally |
3209 |
if SetCursor and (Screen.Cursor = crHourGlass) then |
3210 |
Screen.Cursor := crDefault; |
3211 |
end; |
3212 |
end; |
3213 |
|
3214 |
procedure TIBCustomDataSet.InternalRefresh; |
3215 |
begin |
3216 |
inherited; |
3217 |
InternalRefreshRow; |
3218 |
end; |
3219 |
|
3220 |
procedure TIBCustomDataSet.InternalSetToRecord(Buffer: PChar); |
3221 |
begin |
3222 |
InternalGotoBookmark(@(PRecordData(Buffer)^.rdRecordNumber)); |
3223 |
end; |
3224 |
|
3225 |
function TIBCustomDataSet.IsCursorOpen: Boolean; |
3226 |
begin |
3227 |
result := FOpen; |
3228 |
end; |
3229 |
|
3230 |
function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant; |
3231 |
Options: TLocateOptions): Boolean; |
3232 |
var |
3233 |
CurBookmark: string; |
3234 |
begin |
3235 |
DisableControls; |
3236 |
try |
3237 |
CurBookmark := Bookmark; |
3238 |
First; |
3239 |
result := InternalLocate(KeyFields, KeyValues, Options); |
3240 |
if not result then |
3241 |
Bookmark := CurBookmark; |
3242 |
finally |
3243 |
EnableControls; |
3244 |
end; |
3245 |
end; |
3246 |
|
3247 |
function TIBCustomDataSet.Lookup(const KeyFields: string; const KeyValues: Variant; |
3248 |
const ResultFields: string): Variant; |
3249 |
var |
3250 |
fl: TList; |
3251 |
CurBookmark: string; |
3252 |
begin |
3253 |
DisableControls; |
3254 |
fl := TList.Create; |
3255 |
CurBookmark := Bookmark; |
3256 |
try |
3257 |
First; |
3258 |
if InternalLocate(KeyFields, KeyValues, []) then |
3259 |
begin |
3260 |
if (ResultFields <> '') then |
3261 |
result := FieldValues[ResultFields] |
3262 |
else |
3263 |
result := NULL; |
3264 |
end |
3265 |
else |
3266 |
result := Null; |
3267 |
finally |
3268 |
Bookmark := CurBookmark; |
3269 |
fl.Free; |
3270 |
EnableControls; |
3271 |
end; |
3272 |
end; |
3273 |
|
3274 |
procedure TIBCustomDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer); |
3275 |
begin |
3276 |
PRecordData(Buffer)^.rdRecordNumber := PInteger(Data)^; |
3277 |
end; |
3278 |
|
3279 |
procedure TIBCustomDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); |
3280 |
begin |
3281 |
PRecordData(Buffer)^.rdBookmarkFlag := Value; |
3282 |
end; |
3283 |
|
3284 |
procedure TIBCustomDataSet.SetCachedUpdates(Value: Boolean); |
3285 |
begin |
3286 |
if not Value and FCachedUpdates then |
3287 |
CancelUpdates; |
3288 |
if (not (csReading in ComponentState)) and Value then |
3289 |
CheckDatasetClosed; |
3290 |
FCachedUpdates := Value; |
3291 |
end; |
3292 |
|
3293 |
procedure TIBCustomDataSet.SetDataSource(Value: TDataSource); |
3294 |
begin |
3295 |
if IsLinkedTo(Value) then |
3296 |
IBError(ibxeCircularReference, [nil]); |
3297 |
if FDataLink <> nil then |
3298 |
FDataLink.DataSource := Value; |
3299 |
end; |
3300 |
|
3301 |
procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer); |
3302 |
var |
3303 |
Buff, TmpBuff: PChar; |
3304 |
begin |
3305 |
Buff := GetActiveBuf; |
3306 |
if Field.FieldNo < 0 then |
3307 |
begin |
3308 |
TmpBuff := Buff + FRecordSize + Field.Offset; |
3309 |
Boolean(TmpBuff[0]) := LongBool(Buffer); |
3310 |
if Boolean(TmpBuff[0]) then |
3311 |
Move(Buffer^, TmpBuff[1], Field.DataSize); |
3312 |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff); |
3313 |
end |
3314 |
else begin |
3315 |
CheckEditState; |
3316 |
with PRecordData(Buff)^ do |
3317 |
begin |
3318 |
{ If inserting, Adjust record position } |
3319 |
AdjustRecordOnInsert(Buff); |
3320 |
if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and |
3321 |
(FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then |
3322 |
begin |
3323 |
Field.Validate(Buffer); |
3324 |
if (Buffer = nil) or |
3325 |
(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then |
3326 |
rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True |
3327 |
else begin |
3328 |
Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs], |
3329 |
rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize); |
3330 |
if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or |
3331 |
(rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then |
3332 |
rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer)); |
3333 |
rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False; |
3334 |
if rdUpdateStatus = usUnmodified then |
3335 |
begin |
3336 |
if CachedUpdates then |
3337 |
begin |
3338 |
FUpdatesPending := True; |
3339 |
if State = dsInsert then |
3340 |
rdCachedUpdateStatus := cusInserted |
3341 |
else if State = dsEdit then |
3342 |
rdCachedUpdateStatus := cusModified; |
3343 |
end; |
3344 |
|
3345 |
if State = dsInsert then |
3346 |
rdUpdateStatus := usInserted |
3347 |
else |
3348 |
rdUpdateStatus := usModified; |
3349 |
end; |
3350 |
WriteRecordCache(rdRecordNumber, Buff); |
3351 |
SetModified(True); |
3352 |
end; |
3353 |
end; |
3354 |
end; |
3355 |
end; |
3356 |
if not (State in [dsCalcFields, dsFilter, dsNewValue]) then |
3357 |
DataEvent(deFieldChange, Longint(Field)); |
3358 |
end; |
3359 |
|
3360 |
procedure TIBCustomDataSet.SetRecNo(Value: Integer); |
3361 |
begin |
3362 |
CheckBrowseMode; |
3363 |
if (Value < 1) then |
3364 |
Value := 1 |
3365 |
else if Value > FRecordCount then |
3366 |
begin |
3367 |
InternalLast; |
3368 |
Value := Min(FRecordCount, Value); |
3369 |
end; |
3370 |
if (Value <> RecNo) then |
3371 |
begin |
3372 |
DoBeforeScroll; |
3373 |
FCurrentRecord := Value - 1; |
3374 |
Resync([]); |
3375 |
DoAfterScroll; |
3376 |
end; |
3377 |
end; |
3378 |
|
3379 |
procedure TIBCustomDataSet.Disconnect; |
3380 |
begin |
3381 |
Close; |
3382 |
InternalUnPrepare; |
3383 |
end; |
3384 |
|
3385 |
procedure TIBCustomDataSet.SetUpdateMode(const Value: TUpdateMode); |
3386 |
begin |
3387 |
if not CanModify then |
3388 |
IBError(ibxeCannotUpdate, [nil]) |
3389 |
else |
3390 |
FUpdateMode := Value; |
3391 |
end; |
3392 |
|
3393 |
|
3394 |
procedure TIBCustomDataSet.SetUpdateObject(Value: TIBDataSetUpdateObject); |
3395 |
begin |
3396 |
if Value <> FUpdateObject then |
3397 |
begin |
3398 |
if Assigned(FUpdateObject) and (FUpdateObject.DataSet = Self) then |
3399 |
FUpdateObject.DataSet := nil; |
3400 |
FUpdateObject := Value; |
3401 |
if Assigned(FUpdateObject) then |
3402 |
begin |
3403 |
if Assigned(FUpdateObject.DataSet) and |
3404 |
(FUpdateObject.DataSet <> Self) then |
3405 |
FUpdateObject.DataSet.UpdateObject := nil; |
3406 |
FUpdateObject.DataSet := Self; |
3407 |
end; |
3408 |
end; |
3409 |
end; |
3410 |
|
3411 |
function TIBCustomDataSet.ConstraintsStored: Boolean; |
3412 |
begin |
3413 |
Result := Constraints.Count > 0; |
3414 |
end; |
3415 |
|
3416 |
procedure TIBCustomDataSet.ClearCalcFields(Buffer: PChar); |
3417 |
begin |
3418 |
FillChar(Buffer[FRecordSize], CalcFieldsSize, 0); |
3419 |
end; |
3420 |
|
3421 |
|
3422 |
procedure TIBCustomDataSet.InternalUnPrepare; |
3423 |
begin |
3424 |
if FInternalPrepared then |
3425 |
begin |
3426 |
CheckDatasetClosed; |
3427 |
FieldDefs.Clear; |
3428 |
FInternalPrepared := False; |
3429 |
end; |
3430 |
end; |
3431 |
|
3432 |
procedure TIBCustomDataSet.InternalExecQuery; |
3433 |
var |
3434 |
DidActivate: Boolean; |
3435 |
SetCursor: Boolean; |
3436 |
begin |
3437 |
DidActivate := False; |
3438 |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
3439 |
if SetCursor then |
3440 |
Screen.Cursor := crHourGlass; |
3441 |
try |
3442 |
ActivateConnection; |
3443 |
DidActivate := ActivateTransaction; |
3444 |
if FQSelect.SQL.Text = '' then |
3445 |
IBError(ibxeEmptyQuery, [nil]); |
3446 |
if not FInternalPrepared then |
3447 |
InternalPrepare; |
3448 |
if FQSelect.SQLType = SQLSelect then |
3449 |
begin |
3450 |
IBError(ibxeIsASelectStatement, [nil]); |
3451 |
end |
3452 |
else |
3453 |
FQSelect.ExecQuery; |
3454 |
finally |
3455 |
if DidActivate then |
3456 |
DeactivateTransaction; |
3457 |
if SetCursor and (Screen.Cursor = crHourGlass) then |
3458 |
Screen.Cursor := crDefault; |
3459 |
end; |
3460 |
end; |
3461 |
|
3462 |
function TIBCustomDataSet.GetSelectStmtHandle: TISC_STMT_HANDLE; |
3463 |
begin |
3464 |
Result := FQSelect.Handle; |
3465 |
end; |
3466 |
|
3467 |
procedure TIBCustomDataSet.InitRecord(Buffer: PChar); |
3468 |
begin |
3469 |
inherited InitRecord(Buffer); |
3470 |
with PRecordData(Buffer)^ do |
3471 |
begin |
3472 |
rdUpdateStatus := TUpdateStatus(usInserted); |
3473 |
rdBookMarkFlag := bfInserted; |
3474 |
rdRecordNumber := -1; |
3475 |
end; |
3476 |
end; |
3477 |
|
3478 |
procedure TIBCustomDataSet.InternalInsert; |
3479 |
begin |
3480 |
CursorPosChanged; |
3481 |
end; |
3482 |
|
3483 |
{ TIBDataSet IProviderSupport } |
3484 |
|
3485 |
procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean); |
3486 |
begin |
3487 |
if Commit then |
3488 |
Transaction.Commit else |
3489 |
Transaction.Rollback; |
3490 |
end; |
3491 |
|
3492 |
function TIBCustomDataSet.PSExecuteStatement(const ASQL: string; AParams: TParams; |
3493 |
ResultSet: Pointer = nil): Integer; |
3494 |
var |
3495 |
FQuery: TIBQuery; |
3496 |
begin |
3497 |
if Assigned(ResultSet) then |
3498 |
begin |
3499 |
TDataSet(ResultSet^) := TIBQuery.Create(nil); |
3500 |
with TIBQuery(ResultSet^) do |
3501 |
begin |
3502 |
SQL.Text := ASQL; |
3503 |
Params.Assign(AParams); |
3504 |
Open; |
3505 |
Result := RowsAffected; |
3506 |
end; |
3507 |
end |
3508 |
else |
3509 |
begin |
3510 |
FQuery := TIBQuery.Create(nil); |
3511 |
try |
3512 |
FQuery.Database := Database; |
3513 |
FQuery.Transaction := Transaction; |
3514 |
FQuery.GenerateParamNames := True; |
3515 |
FQuery.SQL.Text := ASQL; |
3516 |
FQuery.Params.Assign(AParams); |
3517 |
FQuery.ExecSQL; |
3518 |
Result := FQuery.RowsAffected; |
3519 |
finally |
3520 |
FQuery.Free; |
3521 |
end; |
3522 |
end; |
3523 |
end; |
3524 |
|
3525 |
function TIBCustomDataSet.PSGetQuoteChar: string; |
3526 |
begin |
3527 |
if Database.SQLDialect = 3 then |
3528 |
Result := '"' else |
3529 |
Result := ''; |
3530 |
end; |
3531 |
|
3532 |
function TIBCustomDataSet.PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; |
3533 |
var |
3534 |
PrevErr: Integer; |
3535 |
begin |
3536 |
if Prev <> nil then |
3537 |
PrevErr := Prev.ErrorCode else |
3538 |
PrevErr := 0; |
3539 |
if E is EIBError then |
3540 |
with EIBError(E) do |
3541 |
Result := EUpdateError.Create(E.Message, '', SQLCode, PrevErr, E) else |
3542 |
Result := inherited PSGetUpdateException(E, Prev); |
3543 |
end; |
3544 |
|
3545 |
function TIBCustomDataSet.PSInTransaction: Boolean; |
3546 |
begin |
3547 |
Result := Transaction.InTransaction; |
3548 |
end; |
3549 |
|
3550 |
function TIBCustomDataSet.PSIsSQLBased: Boolean; |
3551 |
begin |
3552 |
Result := True; |
3553 |
end; |
3554 |
|
3555 |
function TIBCustomDataSet.PSIsSQLSupported: Boolean; |
3556 |
begin |
3557 |
Result := True; |
3558 |
end; |
3559 |
|
3560 |
procedure TIBCustomDataSet.PSReset; |
3561 |
begin |
3562 |
inherited PSReset; |
3563 |
if Active then |
3564 |
begin |
3565 |
Close; |
3566 |
Open; |
3567 |
end; |
3568 |
end; |
3569 |
|
3570 |
function TIBCustomDataSet.PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; |
3571 |
var |
3572 |
UpdateAction: TIBUpdateAction; |
3573 |
SQL: string; |
3574 |
Params: TParams; |
3575 |
|
3576 |
procedure AssignParams(DataSet: TDataSet; Params: TParams); |
3577 |
var |
3578 |
I: Integer; |
3579 |
Old: Boolean; |
3580 |
Param: TParam; |
3581 |
PName: string; |
3582 |
Field: TField; |
3583 |
Value: Variant; |
3584 |
begin |
3585 |
for I := 0 to Params.Count - 1 do |
3586 |
begin |
3587 |
Param := Params[I]; |
3588 |
PName := Param.Name; |
3589 |
Old := CompareText(Copy(PName, 1, 4), 'OLD_') = 0; {do not localize} |
3590 |
if Old then System.Delete(PName, 1, 4); |
3591 |
Field := DataSet.FindField(PName); |
3592 |
if not Assigned(Field) then Continue; |
3593 |
if Old then Param.AssignFieldValue(Field, Field.OldValue) else |
3594 |
begin |
3595 |
Value := Field.NewValue; |
3596 |
if VarIsEmpty(Value) then Value := Field.OldValue; |
3597 |
Param.AssignFieldValue(Field, Value); |
3598 |
end; |
3599 |
end; |
3600 |
end; |
3601 |
|
3602 |
begin |
3603 |
Result := False; |
3604 |
if Assigned(OnUpdateRecord) then |
3605 |
begin |
3606 |
UpdateAction := uaFail; |
3607 |
if Assigned(FOnUpdateRecord) then |
3608 |
begin |
3609 |
FOnUpdateRecord(Delta, UpdateKind, UpdateAction); |
3610 |
Result := UpdateAction = uaApplied; |
3611 |
end; |
3612 |
end |
3613 |
else if Assigned(FUpdateObject) then |
3614 |
begin |
3615 |
SQL := FUpdateObject.GetSQL(UpdateKind).Text; |
3616 |
if SQL <> '' then |
3617 |
begin |
3618 |
Params := TParams.Create; |
3619 |
try |
3620 |
Params.ParseSQL(SQL, True); |
3621 |
AssignParams(Delta, Params); |
3622 |
if PSExecuteStatement(SQL, Params) = 0 then |
3623 |
IBError(ibxeNoRecordsAffected, [nil]); |
3624 |
Result := True; |
3625 |
finally |
3626 |
Params.Free; |
3627 |
end; |
3628 |
end; |
3629 |
end; |
3630 |
end; |
3631 |
|
3632 |
procedure TIBCustomDataSet.PSStartTransaction; |
3633 |
begin |
3634 |
ActivateConnection; |
3635 |
Transaction.StartTransaction; |
3636 |
end; |
3637 |
|
3638 |
function TIBCustomDataSet.PSGetTableName: string; |
3639 |
begin |
3640 |
// if not FInternalPrepared then |
3641 |
// InternalPrepare; |
3642 |
{ It is possible for the FQSelectSQL to be unprepared |
3643 |
with FInternalPreprepared being true (see DoBeforeTransactionEnd). |
3644 |
So check the Prepared of the SelectSQL instead } |
3645 |
if not FQSelect.Prepared then |
3646 |
FQSelect.Prepare; |
3647 |
Result := FQSelect.UniqueRelationName; |
3648 |
end; |
3649 |
|
3650 |
procedure TIBDataSet.BatchInput(InputObject: TIBBatchInput); |
3651 |
begin |
3652 |
InternalBatchInput(InputObject); |
3653 |
end; |
3654 |
|
3655 |
procedure TIBDataSet.BatchOutput(OutputObject: TIBBatchOutput); |
3656 |
begin |
3657 |
InternalBatchOutput(OutputObject); |
3658 |
end; |
3659 |
|
3660 |
procedure TIBDataSet.ExecSQL; |
3661 |
begin |
3662 |
InternalExecQuery; |
3663 |
end; |
3664 |
|
3665 |
procedure TIBDataSet.Prepare; |
3666 |
begin |
3667 |
InternalPrepare; |
3668 |
end; |
3669 |
|
3670 |
procedure TIBDataSet.UnPrepare; |
3671 |
begin |
3672 |
InternalUnPrepare; |
3673 |
end; |
3674 |
|
3675 |
function TIBDataSet.GetPrepared: Boolean; |
3676 |
begin |
3677 |
Result := InternalPrepared; |
3678 |
end; |
3679 |
|
3680 |
procedure TIBDataSet.InternalOpen; |
3681 |
begin |
3682 |
ActivateConnection; |
3683 |
ActivateTransaction; |
3684 |
InternalSetParamsFromCursor; |
3685 |
Inherited; |
3686 |
end; |
3687 |
|
3688 |
procedure TIBDataSet.SetFiltered(Value: Boolean); |
3689 |
begin |
3690 |
if(Filtered <> Value) then |
3691 |
begin |
3692 |
inherited SetFiltered(value); |
3693 |
if Active then |
3694 |
begin |
3695 |
Close; |
3696 |
Open; |
3697 |
end; |
3698 |
end |
3699 |
else |
3700 |
inherited SetFiltered(value); |
3701 |
end; |
3702 |
|
3703 |
function TIBCustomDataSet.BookmarkValid(Bookmark: TBookmark): Boolean; |
3704 |
begin |
3705 |
Result := false; |
3706 |
if not Assigned(Bookmark) then |
3707 |
exit; |
3708 |
Result := PInteger(Bookmark)^ < FRecordCount; |
3709 |
end; |
3710 |
|
3711 |
function TIBCustomDataSet.GetFieldData(Field: TField; |
3712 |
Buffer: Pointer): Boolean; |
3713 |
var |
3714 |
lTempCurr : System.Currency; |
3715 |
begin |
3716 |
if (Field.DataType = ftBCD) and (Buffer <> nil) then |
3717 |
begin |
3718 |
Result := InternalGetFieldData(Field, @lTempCurr); |
3719 |
if Result then |
3720 |
CurrToBCD(lTempCurr, TBCD(Buffer^), 32, Field.Size); |
3721 |
end |
3722 |
else |
3723 |
Result := InternalGetFieldData(Field, Buffer); |
3724 |
end; |
3725 |
|
3726 |
function TIBCustomDataSet.GetFieldData(Field: TField; Buffer: Pointer; |
3727 |
NativeFormat: Boolean): Boolean; |
3728 |
begin |
3729 |
if (Field.DataType = ftBCD) and not NativeFormat then |
3730 |
Result := InternalGetFieldData(Field, Buffer) |
3731 |
else |
3732 |
Result := inherited GetFieldData(Field, Buffer, NativeFormat); |
3733 |
end; |
3734 |
|
3735 |
procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer); |
3736 |
var |
3737 |
lTempCurr : System.Currency; |
3738 |
begin |
3739 |
if Field.DataType = ftBCD then |
3740 |
begin |
3741 |
BCDToCurr(TBCD(Buffer^), lTempCurr); |
3742 |
InternalSetFieldData(Field, @lTempCurr); |
3743 |
end |
3744 |
else |
3745 |
InternalSetFieldData(Field, Buffer); |
3746 |
end; |
3747 |
|
3748 |
procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer; |
3749 |
NativeFormat: Boolean); |
3750 |
begin |
3751 |
if (not NativeFormat) and (Field.DataType = ftBCD) then |
3752 |
InternalSetfieldData(Field, Buffer) |
3753 |
else |
3754 |
inherited SetFieldData(Field, buffer, NativeFormat); |
3755 |
end; |
3756 |
|
3757 |
{ TIBDataSetUpdateObject } |
3758 |
|
3759 |
constructor TIBDataSetUpdateObject.Create(AOwner: TComponent); |
3760 |
begin |
3761 |
inherited Create(AOwner); |
3762 |
FRefreshSQL := TStringList.Create; |
3763 |
end; |
3764 |
|
3765 |
destructor TIBDataSetUpdateObject.Destroy; |
3766 |
begin |
3767 |
FRefreshSQL.Free; |
3768 |
inherited destroy; |
3769 |
end; |
3770 |
|
3771 |
procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings); |
3772 |
begin |
3773 |
FRefreshSQL.Assign(Value); |
3774 |
end; |
3775 |
|
3776 |
{ TIBDSBlobStream } |
3777 |
constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream; |
3778 |
Mode: TBlobStreamMode); |
3779 |
begin |
3780 |
FField := AField; |
3781 |
FBlobStream := ABlobStream; |
3782 |
FBlobStream.Seek(0, soFromBeginning); |
3783 |
if (Mode = bmWrite) then |
3784 |
FBlobStream.Truncate; |
3785 |
end; |
3786 |
|
3787 |
function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint; |
3788 |
begin |
3789 |
result := FBlobStream.Read(Buffer, Count); |
3790 |
end; |
3791 |
|
3792 |
function TIBDSBlobStream.Seek(Offset: Longint; Origin: Word): Longint; |
3793 |
begin |
3794 |
result := FBlobStream.Seek(Offset, Origin); |
3795 |
end; |
3796 |
|
3797 |
procedure TIBDSBlobStream.SetSize(NewSize: Longint); |
3798 |
begin |
3799 |
FBlobStream.SetSize(NewSize); |
3800 |
end; |
3801 |
|
3802 |
function TIBDSBlobStream.Write(const Buffer; Count: Longint): Longint; |
3803 |
begin |
3804 |
if not (FField.DataSet.State in [dsEdit, dsInsert]) then |
3805 |
IBError(ibxeNotEditing, [nil]); |
3806 |
TIBCustomDataSet(FField.DataSet).RecordModified(True); |
3807 |
result := FBlobStream.Write(Buffer, Count); |
3808 |
TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, Longint(FField)); |
3809 |
end; |
3810 |
|
3811 |
end. |