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 |
< |
{ IBX For Lazarus (Firebird Express) } |
28 |
< |
{ Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk } |
29 |
< |
{ Portions created by MWA Software are copyright McCallum Whyman } |
30 |
< |
{ Associates Ltd 2011 - 2015 } |
31 |
< |
{ } |
32 |
< |
{************************************************************************} |
33 |
< |
|
34 |
< |
unit IBCustomDataSet; |
35 |
< |
|
36 |
< |
{$R-} |
37 |
< |
|
38 |
< |
{$Mode Delphi} |
39 |
< |
|
40 |
< |
{$IFDEF DELPHI} |
41 |
< |
{$DEFINE TDBDFIELD_IS_BCD} |
42 |
< |
{$ENDIF} |
43 |
< |
|
44 |
< |
interface |
45 |
< |
|
46 |
< |
uses |
47 |
< |
{$IFDEF WINDOWS } |
48 |
< |
Windows, |
49 |
< |
{$ELSE} |
50 |
< |
unix, |
51 |
< |
{$ENDIF} |
52 |
< |
SysUtils, Classes, Forms, Controls, IBDatabase, |
53 |
< |
IBExternals, IB, IBHeader, IBSQL, Db, |
54 |
< |
IBUtils, IBBlob, IBSQLParser; |
55 |
< |
|
56 |
< |
const |
57 |
< |
BufferCacheSize = 1000; { Allocate cache in this many record chunks} |
58 |
< |
UniCache = 2; { Uni-directional cache is 2 records big } |
59 |
< |
|
60 |
< |
type |
61 |
< |
TIBCustomDataSet = class; |
62 |
< |
TIBDataSet = class; |
63 |
< |
|
64 |
< |
{ TIBDataSetUpdateObject } |
65 |
< |
|
66 |
< |
TIBDataSetUpdateObject = class(TComponent) |
67 |
< |
private |
68 |
< |
FRefreshSQL: TStrings; |
69 |
< |
procedure SetRefreshSQL(value: TStrings); |
70 |
< |
protected |
71 |
< |
function GetDataSet: TIBCustomDataSet; virtual; abstract; |
72 |
< |
procedure SetDataSet(ADataSet: TIBCustomDataSet); virtual; abstract; |
73 |
< |
procedure Apply(UpdateKind: TUpdateKind; buff: PChar); virtual; abstract; |
74 |
< |
function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract; |
75 |
< |
procedure InternalSetParams(Query: TIBSQL; buff: PChar); |
76 |
< |
property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet; |
77 |
< |
public |
78 |
< |
constructor Create(AOwner: TComponent); override; |
79 |
< |
destructor Destroy; override; |
80 |
< |
published |
81 |
< |
property RefreshSQL: TStrings read FRefreshSQL write SetRefreshSQL; |
82 |
< |
end; |
83 |
< |
|
84 |
< |
TBlobDataArray = array[0..0] of TIBBlobStream; |
85 |
< |
PBlobDataArray = ^TBlobDataArray; |
86 |
< |
|
87 |
< |
{ TIBCustomDataSet } |
88 |
< |
TFieldData = record |
89 |
< |
fdDataType: Short; |
90 |
< |
fdDataScale: Short; |
91 |
< |
fdNullable: Boolean; |
92 |
< |
fdIsNull: Boolean; |
93 |
< |
fdDataSize: Short; |
94 |
< |
fdDataLength: Short; |
95 |
< |
fdDataOfs: Integer; |
96 |
< |
end; |
97 |
< |
PFieldData = ^TFieldData; |
98 |
< |
|
99 |
< |
TCachedUpdateStatus = ( |
100 |
< |
cusUnmodified, cusModified, cusInserted, |
101 |
< |
cusDeleted, cusUninserted |
102 |
< |
); |
103 |
< |
TIBDBKey = record |
104 |
< |
DBKey: array[0..7] of Byte; |
105 |
< |
end; |
106 |
< |
PIBDBKey = ^TIBDBKey; |
107 |
< |
|
108 |
< |
TRecordData = record |
109 |
< |
rdBookmarkFlag: TBookmarkFlag; |
110 |
< |
rdFieldCount: Short; |
111 |
< |
rdRecordNumber: Integer; |
112 |
< |
rdCachedUpdateStatus: TCachedUpdateStatus; |
113 |
< |
rdUpdateStatus: TUpdateStatus; |
114 |
< |
rdSavedOffset: DWORD; |
115 |
< |
rdDBKey: TIBDBKey; |
116 |
< |
rdFields: array[1..1] of TFieldData; |
117 |
< |
end; |
118 |
< |
PRecordData = ^TRecordData; |
119 |
< |
|
120 |
< |
{ TIBStringField allows us to have strings longer than 8196 } |
121 |
< |
|
122 |
< |
TIBStringField = class(TStringField) |
123 |
< |
public |
124 |
< |
constructor create(AOwner: TComponent); override; |
125 |
< |
class procedure CheckTypeSize(Value: Integer); override; |
126 |
< |
function GetAsString: string; override; |
127 |
< |
function GetAsVariant: Variant; override; |
128 |
< |
function GetValue(var Value: string): Boolean; |
129 |
< |
procedure SetAsString(const Value: string); override; |
130 |
< |
end; |
131 |
< |
|
132 |
< |
{ TIBBCDField } |
133 |
< |
{ Actually, there is no BCD involved in this type, |
134 |
< |
instead it deals with currency types. |
135 |
< |
In IB, this is an encapsulation of Numeric (x, y) |
136 |
< |
where x < 18 and y <= 4. |
137 |
< |
Note: y > 4 will default to Floats |
138 |
< |
} |
139 |
< |
TIBBCDField = class(TBCDField) |
140 |
< |
protected |
141 |
< |
class procedure CheckTypeSize(Value: Integer); override; |
142 |
< |
function GetAsCurrency: Currency; override; |
143 |
< |
function GetAsString: string; override; |
144 |
< |
function GetAsVariant: Variant; override; |
145 |
< |
function GetDataSize: Integer; override; |
146 |
< |
public |
147 |
< |
constructor Create(AOwner: TComponent); override; |
148 |
< |
published |
149 |
< |
property Size default 8; |
150 |
< |
end; |
151 |
< |
|
152 |
< |
TIBDataLink = class(TDetailDataLink) |
153 |
< |
private |
154 |
< |
FDataSet: TIBCustomDataSet; |
155 |
< |
protected |
156 |
< |
procedure ActiveChanged; override; |
157 |
< |
procedure RecordChanged(Field: TField); override; |
158 |
< |
function GetDetailDataSet: TDataSet; override; |
159 |
< |
procedure CheckBrowseMode; override; |
160 |
< |
public |
161 |
< |
constructor Create(ADataSet: TIBCustomDataSet); |
162 |
< |
destructor Destroy; override; |
163 |
< |
end; |
164 |
< |
|
165 |
< |
TIBGeneratorApplyOnEvent = (gaeOnNewRecord,gaeOnPostRecord); |
166 |
< |
|
167 |
< |
{ TIBGenerator } |
168 |
< |
|
169 |
< |
TIBGenerator = class(TPersistent) |
170 |
< |
private |
171 |
< |
FOwner: TIBCustomDataSet; |
172 |
< |
FApplyOnEvent: TIBGeneratorApplyOnEvent; |
173 |
< |
FFieldName: string; |
174 |
< |
FGeneratorName: string; |
175 |
< |
FIncrement: integer; |
176 |
< |
procedure SetIncrement(const AValue: integer); |
177 |
< |
protected |
178 |
< |
function GetNextValue(ADatabase: TIBDatabase; ATransaction: TIBTransaction): integer; |
179 |
< |
public |
180 |
< |
constructor Create(Owner: TIBCustomDataSet); |
181 |
< |
procedure Apply; |
182 |
< |
property Owner: TIBCustomDataSet read FOwner; |
183 |
< |
published |
184 |
< |
property Generator: string read FGeneratorName write FGeneratorName; |
185 |
< |
property Field: string read FFieldName write FFieldName; |
186 |
< |
property Increment: integer read FIncrement write SetIncrement default 1; |
187 |
< |
property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent; |
188 |
< |
end; |
189 |
< |
|
190 |
< |
TIBAutoCommit = (acDisabled, acCommitRetaining); |
191 |
< |
|
192 |
< |
{ TIBCustomDataSet } |
193 |
< |
TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied); |
194 |
< |
|
195 |
< |
TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError; |
196 |
< |
UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction) |
197 |
< |
of object; |
198 |
< |
TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind; |
199 |
< |
var UpdateAction: TIBUpdateAction) of object; |
200 |
< |
|
201 |
< |
TIBUpdateRecordTypes = set of TCachedUpdateStatus; |
202 |
< |
|
203 |
< |
TIBCustomDataSet = class(TDataset) |
204 |
< |
private |
205 |
< |
FAutoCommit: TIBAutoCommit; |
206 |
< |
FGenerateParamNames: Boolean; |
207 |
< |
FGeneratorField: TIBGenerator; |
208 |
< |
FNeedsRefresh: Boolean; |
209 |
< |
FForcedRefresh: Boolean; |
210 |
< |
FDidActivate: Boolean; |
211 |
< |
FIBLoaded: Boolean; |
212 |
< |
FBase: TIBBase; |
213 |
< |
FBlobCacheOffset: Integer; |
214 |
< |
FBlobStreamList: TList; |
215 |
< |
FBufferChunks: Integer; |
216 |
< |
FBufferCache, |
217 |
< |
FOldBufferCache: PChar; |
218 |
< |
FBufferChunkSize, |
219 |
< |
FCacheSize, |
220 |
< |
FOldCacheSize: Integer; |
221 |
< |
FFilterBuffer: PChar; |
222 |
< |
FBPos, |
223 |
< |
FOBPos, |
224 |
< |
FBEnd, |
225 |
< |
FOBEnd: DWord; |
226 |
< |
FCachedUpdates: Boolean; |
227 |
< |
FCalcFieldsOffset: Integer; |
228 |
< |
FCurrentRecord: Long; |
229 |
< |
FDeletedRecords: Long; |
230 |
< |
FModelBuffer, |
231 |
< |
FOldBuffer: PChar; |
232 |
< |
FOpen: Boolean; |
233 |
< |
FInternalPrepared: Boolean; |
234 |
< |
FQDelete, |
235 |
< |
FQInsert, |
236 |
< |
FQRefresh, |
237 |
< |
FQSelect, |
238 |
< |
FQModify: TIBSQL; |
239 |
< |
FRecordBufferSize: Integer; |
240 |
< |
FRecordCount: Integer; |
241 |
< |
FRecordSize: Integer; |
242 |
< |
FUniDirectional: Boolean; |
243 |
< |
FUpdateMode: TUpdateMode; |
244 |
< |
FUpdateObject: TIBDataSetUpdateObject; |
245 |
< |
FParamCheck: Boolean; |
246 |
< |
FUpdatesPending: Boolean; |
247 |
< |
FUpdateRecordTypes: TIBUpdateRecordTypes; |
248 |
< |
FMappedFieldPosition: array of Integer; |
249 |
< |
FDataLink: TIBDataLink; |
250 |
< |
|
251 |
< |
FBeforeDatabaseDisconnect, |
252 |
< |
FAfterDatabaseDisconnect, |
253 |
< |
FDatabaseFree: TNotifyEvent; |
254 |
< |
FOnUpdateError: TIBUpdateErrorEvent; |
255 |
< |
FOnUpdateRecord: TIBUpdateRecordEvent; |
256 |
< |
FBeforeTransactionEnd, |
257 |
< |
FAfterTransactionEnd, |
258 |
< |
FTransactionFree: TNotifyEvent; |
259 |
< |
FAliasNameMap: array of string; |
260 |
< |
FAliasNameList: array of string; |
261 |
< |
FBaseSQLSelect: TStrings; |
262 |
< |
FParser: TSelectSQLParser; |
263 |
< |
function GetSelectStmtHandle: TISC_STMT_HANDLE; |
264 |
< |
procedure SetUpdateMode(const Value: TUpdateMode); |
265 |
< |
procedure SetUpdateObject(Value: TIBDataSetUpdateObject); |
266 |
< |
|
267 |
< |
function AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode): TGetResult; |
268 |
< |
procedure AdjustRecordOnInsert(Buffer: Pointer); |
269 |
< |
function CanEdit: Boolean; |
270 |
< |
function CanInsert: Boolean; |
271 |
< |
function CanDelete: Boolean; |
272 |
< |
function CanRefresh: Boolean; |
273 |
< |
procedure CheckEditState; |
274 |
< |
procedure ClearBlobCache; |
275 |
< |
procedure CopyRecordBuffer(Source, Dest: Pointer); |
276 |
< |
procedure DoBeforeDatabaseDisconnect(Sender: TObject); |
277 |
< |
procedure DoAfterDatabaseDisconnect(Sender: TObject); |
278 |
< |
procedure DoDatabaseFree(Sender: TObject); |
279 |
< |
procedure DoBeforeTransactionEnd(Sender: TObject); |
280 |
< |
procedure DoAfterTransactionEnd(Sender: TObject); |
281 |
< |
procedure DoTransactionFree(Sender: TObject); |
282 |
< |
procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer; |
283 |
< |
Buffer: PChar); |
284 |
< |
function GetDatabase: TIBDatabase; |
285 |
< |
function GetDBHandle: PISC_DB_HANDLE; |
286 |
< |
function GetDeleteSQL: TStrings; |
287 |
< |
function GetInsertSQL: TStrings; |
288 |
< |
function GetSQLParams: TIBXSQLDA; |
289 |
< |
function GetRefreshSQL: TStrings; |
290 |
< |
function GetSelectSQL: TStrings; |
291 |
< |
function GetStatementType: TIBSQLTypes; |
292 |
< |
function GetModifySQL: TStrings; |
293 |
< |
function GetTransaction: TIBTransaction; |
294 |
< |
function GetTRHandle: PISC_TR_HANDLE; |
295 |
< |
function GetParser: TSelectSQLParser; |
296 |
< |
procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual; |
297 |
< |
function InternalLocate(const KeyFields: string; const KeyValues: Variant; |
298 |
< |
Options: TLocateOptions): Boolean; virtual; |
299 |
< |
procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual; |
300 |
< |
procedure InternalRevertRecord(RecordNumber: Integer); virtual; |
301 |
< |
function IsVisible(Buffer: PChar): Boolean; |
302 |
< |
procedure SaveOldBuffer(Buffer: PChar); |
303 |
< |
procedure SetBufferChunks(Value: Integer); |
304 |
< |
procedure SetDatabase(Value: TIBDatabase); |
305 |
< |
procedure SetDeleteSQL(Value: TStrings); |
306 |
< |
procedure SetInsertSQL(Value: TStrings); |
307 |
< |
procedure SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer); |
308 |
< |
procedure SetRefreshSQL(Value: TStrings); |
309 |
< |
procedure SetSelectSQL(Value: TStrings); |
310 |
< |
procedure SetModifySQL(Value: TStrings); |
311 |
< |
procedure SetTransaction(Value: TIBTransaction); |
312 |
< |
procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes); |
313 |
< |
procedure SetUniDirectional(Value: Boolean); |
314 |
< |
procedure RefreshParams; |
315 |
< |
procedure SQLChanging(Sender: TObject); virtual; |
316 |
< |
function AdjustPosition(FCache: PChar; Offset: DWORD; |
317 |
< |
Origin: Integer): DWORD; |
318 |
< |
procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer; |
319 |
< |
Buffer: PChar); |
320 |
< |
procedure ReadRecordCache(RecordNumber: Integer; Buffer: PChar; |
321 |
< |
ReadOldBuffer: Boolean); |
322 |
< |
procedure WriteCache(FCache: PChar; Offset: DWORD; Origin: Integer; |
323 |
< |
Buffer: PChar); |
324 |
< |
procedure WriteRecordCache(RecordNumber: Integer; Buffer: PChar); |
325 |
< |
function InternalGetRecord(Buffer: PChar; GetMode: TGetMode; |
326 |
< |
DoCheck: Boolean): TGetResult; virtual; |
327 |
< |
|
328 |
< |
protected |
329 |
< |
procedure ActivateConnection; |
330 |
< |
function ActivateTransaction: Boolean; |
331 |
< |
procedure DeactivateTransaction; |
332 |
< |
procedure CheckDatasetClosed; |
333 |
< |
procedure CheckDatasetOpen; |
334 |
< |
function CreateParser: TSelectSQLParser; virtual; |
335 |
< |
procedure FieldDefsFromQuery(SourceQuery: TIBSQL); |
336 |
< |
function GetActiveBuf: PChar; |
337 |
< |
procedure InternalBatchInput(InputObject: TIBBatchInput); virtual; |
338 |
< |
procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual; |
339 |
< |
procedure InternalPrepare; virtual; |
340 |
< |
procedure InternalUnPrepare; virtual; |
341 |
< |
procedure InternalExecQuery; virtual; |
342 |
< |
procedure InternalRefreshRow; virtual; |
343 |
< |
procedure InternalSetParamsFromCursor; virtual; |
344 |
< |
procedure CheckNotUniDirectional; |
345 |
< |
|
346 |
< |
(* { IProviderSupport } |
347 |
< |
procedure PSEndTransaction(Commit: Boolean); override; |
348 |
< |
function PSExecuteStatement(const ASQL: string; AParams: TParams; |
349 |
< |
ResultSet: Pointer = nil): Integer; override; |
350 |
< |
function PsGetTableName: string; override; |
351 |
< |
function PSGetQuoteChar: string; override; |
352 |
< |
function PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; override; |
353 |
< |
function PSInTransaction: Boolean; override; |
354 |
< |
function PSIsSQLBased: Boolean; override; |
355 |
< |
function PSIsSQLSupported: Boolean; override; |
356 |
< |
procedure PSStartTransaction; override; |
357 |
< |
procedure PSReset; override; |
358 |
< |
function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override; |
359 |
< |
*) |
360 |
< |
{ TDataSet support } |
361 |
< |
procedure InternalInsert; override; |
362 |
< |
procedure InitRecord(Buffer: PChar); override; |
363 |
< |
procedure Disconnect; virtual; |
364 |
< |
function ConstraintsStored: Boolean; |
365 |
< |
procedure ClearCalcFields(Buffer: PChar); override; |
366 |
< |
function AllocRecordBuffer: PChar; override; |
367 |
< |
procedure DoBeforeDelete; override; |
368 |
< |
procedure DoAfterDelete; override; |
369 |
< |
procedure DoBeforeEdit; override; |
370 |
< |
procedure DoBeforeInsert; override; |
371 |
< |
procedure DoAfterInsert; override; |
372 |
< |
procedure DoBeforeOpen; override; |
373 |
< |
procedure DoBeforePost; override; |
374 |
< |
procedure DoAfterPost; override; |
375 |
< |
procedure FreeRecordBuffer(var Buffer: PChar); override; |
376 |
< |
procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override; |
377 |
< |
function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override; |
378 |
< |
function GetCanModify: Boolean; override; |
379 |
< |
function GetDataSource: TDataSource; override; |
380 |
< |
function GetDBAliasName(FieldNo: integer): string; |
381 |
< |
function GetFieldDefFromAlias(aliasName: string): TFieldDef; |
382 |
< |
function GetFieldClass(FieldType: TFieldType): TFieldClass; override; |
383 |
< |
function GetRecNo: Integer; override; |
384 |
< |
function GetRecord(Buffer: PChar; GetMode: TGetMode; |
385 |
< |
DoCheck: Boolean): TGetResult; override; |
386 |
< |
function GetRecordCount: Integer; override; |
387 |
< |
function GetRecordSize: Word; override; |
388 |
< |
procedure InternalAutoCommit; |
389 |
< |
procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override; |
390 |
< |
procedure InternalCancel; override; |
391 |
< |
procedure InternalClose; override; |
392 |
< |
procedure InternalDelete; override; |
393 |
< |
procedure InternalFirst; override; |
394 |
< |
function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual; |
395 |
< |
procedure InternalGotoBookmark(Bookmark: Pointer); override; |
396 |
< |
procedure InternalHandleException; override; |
397 |
< |
procedure InternalInitFieldDefs; override; |
398 |
< |
procedure InternalInitRecord(Buffer: PChar); override; |
399 |
< |
procedure InternalLast; override; |
400 |
< |
procedure InternalOpen; override; |
401 |
< |
procedure InternalPost; override; |
402 |
< |
procedure InternalRefresh; override; |
403 |
< |
procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual; |
404 |
< |
procedure InternalSetToRecord(Buffer: PChar); override; |
405 |
< |
function IsCursorOpen: Boolean; override; |
406 |
< |
procedure Loaded; override; |
407 |
< |
procedure ReQuery; |
408 |
< |
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override; |
409 |
< |
procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override; |
410 |
< |
procedure SetCachedUpdates(Value: Boolean); |
411 |
< |
procedure SetDataSource(Value: TDataSource); |
412 |
< |
procedure SetGenerateParamNames(AValue: Boolean); virtual; |
413 |
< |
procedure SetFieldData(Field : TField; Buffer : Pointer); override; |
414 |
< |
procedure SetFieldData(Field : TField; Buffer : Pointer; |
415 |
< |
NativeFormat : Boolean); overload; override; |
416 |
< |
procedure SetRecNo(Value: Integer); override; |
417 |
< |
|
418 |
< |
protected |
419 |
< |
{Likely to be made public by descendant classes} |
420 |
< |
property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled; |
421 |
< |
property SQLParams: TIBXSQLDA read GetSQLParams; |
422 |
< |
property Params: TIBXSQLDA read GetSQLParams; |
423 |
< |
property InternalPrepared: Boolean read FInternalPrepared; |
424 |
< |
property QDelete: TIBSQL read FQDelete; |
425 |
< |
property QInsert: TIBSQL read FQInsert; |
426 |
< |
property QRefresh: TIBSQL read FQRefresh; |
427 |
< |
property QSelect: TIBSQL read FQSelect; |
428 |
< |
property QModify: TIBSQL read FQModify; |
429 |
< |
property StatementType: TIBSQLTypes read GetStatementType; |
430 |
< |
property SelectStmtHandle: TISC_STMT_HANDLE read GetSelectStmtHandle; |
431 |
< |
|
432 |
< |
{Likely to be made published by descendant classes} |
433 |
< |
property BufferChunks: Integer read FBufferChunks write SetBufferChunks; |
434 |
< |
property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates; |
435 |
< |
property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False; |
436 |
< |
property GeneratorField: TIBGenerator read FGeneratorField write FGeneratorField; |
437 |
< |
property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL; |
438 |
< |
property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL; |
439 |
< |
property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL; |
440 |
< |
property SelectSQL: TStrings read GetSelectSQL write SetSelectSQL; |
441 |
< |
property ModifySQL: TStrings read GetModifySQL write SetModifySQL; |
442 |
< |
property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll; |
443 |
< |
property ParamCheck: Boolean read FParamCheck write FParamCheck default True; |
444 |
< |
property Parser: TSelectSQLParser read GetParser; |
445 |
< |
property BaseSQLSelect: TStrings read FBaseSQLSelect; |
446 |
< |
|
447 |
< |
property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect |
448 |
< |
write FBeforeDatabaseDisconnect; |
449 |
< |
property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect |
450 |
< |
write FAfterDatabaseDisconnect; |
451 |
< |
property DatabaseFree: TNotifyEvent read FDatabaseFree |
452 |
< |
write FDatabaseFree; |
453 |
< |
property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd |
454 |
< |
write FBeforeTransactionEnd; |
455 |
< |
property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd |
456 |
< |
write FAfterTransactionEnd; |
457 |
< |
property TransactionFree: TNotifyEvent read FTransactionFree |
458 |
< |
write FTransactionFree; |
459 |
< |
|
460 |
< |
public |
461 |
< |
constructor Create(AOwner: TComponent); override; |
462 |
< |
destructor Destroy; override; |
463 |
< |
procedure ApplyUpdates; |
464 |
< |
function CachedUpdateStatus: TCachedUpdateStatus; |
465 |
< |
procedure CancelUpdates; |
466 |
< |
function GetFieldPosition(AliasName: string): integer; |
467 |
< |
procedure FetchAll; |
468 |
< |
function LocateNext(const KeyFields: string; const KeyValues: Variant; |
469 |
< |
Options: TLocateOptions): Boolean; |
470 |
< |
procedure RecordModified(Value: Boolean); |
471 |
< |
procedure RevertRecord; |
472 |
< |
procedure Undelete; |
473 |
< |
procedure ResetParser; |
474 |
< |
function HasParser: boolean; |
475 |
< |
|
476 |
< |
{ TDataSet support methods } |
477 |
< |
function BookmarkValid(Bookmark: TBookmark): Boolean; override; |
478 |
< |
function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override; |
479 |
< |
function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override; |
480 |
< |
function GetCurrentRecord(Buffer: PChar): Boolean; override; |
481 |
< |
function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override; |
482 |
< |
function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*) |
483 |
< |
function GetFieldData(Field : TField; Buffer : Pointer; |
484 |
< |
NativeFormat : Boolean) : Boolean; overload; override; |
485 |
< |
property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames; |
486 |
< |
function Locate(const KeyFields: string; const KeyValues: Variant; |
487 |
< |
Options: TLocateOptions): Boolean; override; |
488 |
< |
function Lookup(const KeyFields: string; const KeyValues: Variant; |
489 |
< |
const ResultFields: string): Variant; override; |
490 |
< |
function UpdateStatus: TUpdateStatus; override; |
491 |
< |
function IsSequenced: Boolean; override; |
492 |
< |
function ParamByName(ParamName: String): TIBXSQLVAR; |
493 |
< |
property DBHandle: PISC_DB_HANDLE read GetDBHandle; |
494 |
< |
property TRHandle: PISC_TR_HANDLE read GetTRHandle; |
495 |
< |
property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject; |
496 |
< |
property UpdatesPending: Boolean read FUpdatesPending; |
497 |
< |
property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes |
498 |
< |
write SetUpdateRecordTypes; |
499 |
< |
|
500 |
< |
published |
501 |
< |
property Database: TIBDatabase read GetDatabase write SetDatabase; |
502 |
< |
property Transaction: TIBTransaction read GetTransaction |
503 |
< |
write SetTransaction; |
504 |
< |
property ForcedRefresh: Boolean read FForcedRefresh |
505 |
< |
write FForcedRefresh default False; |
506 |
< |
property AutoCalcFields; |
507 |
< |
|
508 |
< |
property AfterCancel; |
509 |
< |
property AfterClose; |
510 |
< |
property AfterDelete; |
511 |
< |
property AfterEdit; |
512 |
< |
property AfterInsert; |
513 |
< |
property AfterOpen; |
514 |
< |
property AfterPost; |
515 |
< |
property AfterRefresh; |
516 |
< |
property AfterScroll; |
517 |
< |
property BeforeCancel; |
518 |
< |
property BeforeClose; |
519 |
< |
property BeforeDelete; |
520 |
< |
property BeforeEdit; |
521 |
< |
property BeforeInsert; |
522 |
< |
property BeforeOpen; |
523 |
< |
property BeforePost; |
524 |
< |
property BeforeRefresh; |
525 |
< |
property BeforeScroll; |
526 |
< |
property OnCalcFields; |
527 |
< |
property OnDeleteError; |
528 |
< |
property OnEditError; |
529 |
< |
property OnNewRecord; |
530 |
< |
property OnPostError; |
531 |
< |
property OnUpdateError: TIBUpdateErrorEvent read FOnUpdateError |
532 |
< |
write FOnUpdateError; |
533 |
< |
property OnUpdateRecord: TIBUpdateRecordEvent read FOnUpdateRecord |
534 |
< |
write FOnUpdateRecord; |
535 |
< |
end; |
536 |
< |
|
537 |
< |
TIBParserDataSet = class(TIBCustomDataSet) |
538 |
< |
public |
539 |
< |
property Parser; |
540 |
< |
end; |
541 |
< |
|
542 |
< |
TIBDataSet = class(TIBParserDataSet) |
543 |
< |
private |
544 |
< |
function GetPrepared: Boolean; |
545 |
< |
|
546 |
< |
protected |
547 |
< |
procedure SetFiltered(Value: Boolean); override; |
548 |
< |
procedure InternalOpen; override; |
549 |
< |
|
550 |
< |
public |
551 |
< |
procedure Prepare; |
552 |
< |
procedure UnPrepare; |
553 |
< |
procedure BatchInput(InputObject: TIBBatchInput); |
554 |
< |
procedure BatchOutput(OutputObject: TIBBatchOutput); |
555 |
< |
procedure ExecSQL; |
556 |
< |
|
557 |
< |
public |
558 |
< |
property Params; |
559 |
< |
property Prepared : Boolean read GetPrepared; |
560 |
< |
property QDelete; |
561 |
< |
property QInsert; |
562 |
< |
property QRefresh; |
563 |
< |
property QSelect; |
564 |
< |
property QModify; |
565 |
< |
property StatementType; |
566 |
< |
property SelectStmtHandle; |
567 |
< |
property BaseSQLSelect; |
568 |
< |
|
569 |
< |
published |
570 |
< |
{ TIBCustomDataSet } |
571 |
< |
property AutoCommit; |
572 |
< |
property BufferChunks; |
573 |
< |
property CachedUpdates; |
574 |
< |
property DeleteSQL; |
575 |
< |
property InsertSQL; |
576 |
< |
property RefreshSQL; |
577 |
< |
property SelectSQL; |
578 |
< |
property ModifySQL; |
579 |
< |
property GeneratorField; |
580 |
< |
property GenerateParamNames; |
581 |
< |
property ParamCheck; |
582 |
< |
property UniDirectional; |
583 |
< |
property Filtered; |
584 |
< |
|
585 |
< |
property BeforeDatabaseDisconnect; |
586 |
< |
property AfterDatabaseDisconnect; |
587 |
< |
property DatabaseFree; |
588 |
< |
property BeforeTransactionEnd; |
589 |
< |
property AfterTransactionEnd; |
590 |
< |
property TransactionFree; |
591 |
< |
|
592 |
< |
{ TIBDataSet } |
593 |
< |
property Active; |
594 |
< |
property AutoCalcFields; |
595 |
< |
property DataSource read GetDataSource write SetDataSource; |
596 |
< |
|
597 |
< |
property AfterCancel; |
598 |
< |
property AfterClose; |
599 |
< |
property AfterDelete; |
600 |
< |
property AfterEdit; |
601 |
< |
property AfterInsert; |
602 |
< |
property AfterOpen; |
603 |
< |
property AfterPost; |
604 |
< |
property AfterScroll; |
605 |
< |
property BeforeCancel; |
606 |
< |
property BeforeClose; |
607 |
< |
property BeforeDelete; |
608 |
< |
property BeforeEdit; |
609 |
< |
property BeforeInsert; |
610 |
< |
property BeforeOpen; |
611 |
< |
property BeforePost; |
612 |
< |
property BeforeScroll; |
613 |
< |
property OnCalcFields; |
614 |
< |
property OnDeleteError; |
615 |
< |
property OnEditError; |
616 |
< |
property OnFilterRecord; |
617 |
< |
property OnNewRecord; |
618 |
< |
property OnPostError; |
619 |
< |
end; |
620 |
< |
|
621 |
< |
{ TIBDSBlobStream } |
622 |
< |
TIBDSBlobStream = class(TStream) |
623 |
< |
protected |
624 |
< |
FField: TField; |
625 |
< |
FBlobStream: TIBBlobStream; |
626 |
< |
public |
627 |
< |
constructor Create(AField: TField; ABlobStream: TIBBlobStream; |
628 |
< |
Mode: TBlobStreamMode); |
629 |
< |
function Read(var Buffer; Count: Longint): Longint; override; |
630 |
< |
function Seek(Offset: Longint; Origin: Word): Longint; override; |
631 |
< |
procedure SetSize(NewSize: Longint); override; |
632 |
< |
function Write(const Buffer; Count: Longint): Longint; override; |
633 |
< |
end; |
634 |
< |
|
635 |
< |
const |
636 |
< |
DefaultFieldClasses: array[TFieldType] of TFieldClass = ( |
637 |
< |
nil, { ftUnknown } |
638 |
< |
TIBStringField, { ftString } |
639 |
< |
TSmallintField, { ftSmallint } |
640 |
< |
TIntegerField, { ftInteger } |
641 |
< |
TWordField, { ftWord } |
642 |
< |
TBooleanField, { ftBoolean } |
643 |
< |
TFloatField, { ftFloat } |
644 |
< |
TCurrencyField, { ftCurrency } |
645 |
< |
TIBBCDField, { ftBCD } |
646 |
< |
TDateField, { ftDate } |
647 |
< |
TTimeField, { ftTime } |
648 |
< |
TDateTimeField, { ftDateTime } |
649 |
< |
TBytesField, { ftBytes } |
650 |
< |
TVarBytesField, { ftVarBytes } |
651 |
< |
TAutoIncField, { ftAutoInc } |
652 |
< |
TBlobField, { ftBlob } |
653 |
< |
TMemoField, { ftMemo } |
654 |
< |
TGraphicField, { ftGraphic } |
655 |
< |
TBlobField, { ftFmtMemo } |
656 |
< |
TBlobField, { ftParadoxOle } |
657 |
< |
TBlobField, { ftDBaseOle } |
658 |
< |
TBlobField, { ftTypedBinary } |
659 |
< |
nil, { ftCursor } |
660 |
< |
TStringField, { ftFixedChar } |
661 |
< |
TWideStringField, { ftWideString } |
662 |
< |
TLargeIntField, { ftLargeInt } |
663 |
< |
nil, { ftADT } |
664 |
< |
nil, { ftArray } |
665 |
< |
nil, { ftReference } |
666 |
< |
nil, { ftDataSet } |
667 |
< |
TBlobField, { ftOraBlob } |
668 |
< |
TMemoField, { ftOraClob } |
669 |
< |
TVariantField, { ftVariant } |
670 |
< |
nil, { ftInterface } |
671 |
< |
nil, { ftIDispatch } |
672 |
< |
TGuidField, { ftGuid } |
673 |
< |
TDateTimeField, {ftTimestamp} |
674 |
< |
TIBBCDField, {ftFMTBcd} |
675 |
< |
nil, {ftFixedWideChar} |
676 |
< |
TWideMemoField); {ftWideMemo} |
677 |
< |
(* |
678 |
< |
TADTField, { ftADT } |
679 |
< |
TArrayField, { ftArray } |
680 |
< |
TReferenceField, { ftReference } |
681 |
< |
TDataSetField, { ftDataSet } |
682 |
< |
TBlobField, { ftOraBlob } |
683 |
< |
TMemoField, { ftOraClob } |
684 |
< |
TVariantField, { ftVariant } |
685 |
< |
TInterfaceField, { ftInterface } |
686 |
< |
TIDispatchField, { ftIDispatch } |
687 |
< |
TGuidField); { ftGuid } *) |
688 |
< |
(*var |
689 |
< |
CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;*) |
690 |
< |
|
691 |
< |
implementation |
692 |
< |
|
693 |
< |
uses IBIntf, Variants, FmtBCD; |
694 |
< |
|
695 |
< |
const FILE_BEGIN = 0; |
696 |
< |
FILE_CURRENT = 1; |
697 |
< |
FILE_END = 2; |
698 |
< |
|
699 |
< |
type |
700 |
< |
|
701 |
< |
TFieldNode = class(TObject) |
702 |
< |
protected |
703 |
< |
FieldName : String; |
704 |
< |
COMPUTED_BLR : Boolean; |
705 |
< |
DEFAULT_VALUE : boolean; |
706 |
< |
NextField : TFieldNode; |
707 |
< |
end; |
708 |
< |
|
709 |
< |
TRelationNode = class(TObject) |
710 |
< |
protected |
711 |
< |
RelationName : String; |
712 |
< |
FieldNodes : TFieldNode; |
713 |
< |
NextRelation : TRelationNode; |
714 |
< |
end; |
715 |
< |
|
716 |
< |
|
717 |
< |
{ TIBStringField} |
718 |
< |
|
719 |
< |
constructor TIBStringField.Create(AOwner: TComponent); |
720 |
< |
begin |
721 |
< |
inherited Create(AOwner); |
722 |
< |
end; |
723 |
< |
|
724 |
< |
class procedure TIBStringField.CheckTypeSize(Value: Integer); |
725 |
< |
begin |
726 |
< |
{ don't check string size. all sizes valid } |
727 |
< |
end; |
728 |
< |
|
729 |
< |
function TIBStringField.GetAsString: string; |
730 |
< |
begin |
731 |
< |
if not GetValue(Result) then Result := ''; |
732 |
< |
end; |
733 |
< |
|
734 |
< |
function TIBStringField.GetAsVariant: Variant; |
735 |
< |
var |
736 |
< |
S: string; |
737 |
< |
begin |
738 |
< |
if GetValue(S) then Result := S else Result := Null; |
739 |
< |
end; |
740 |
< |
|
741 |
< |
function TIBStringField.GetValue(var Value: string): Boolean; |
742 |
< |
var |
743 |
< |
Buffer: PChar; |
744 |
< |
begin |
745 |
< |
Buffer := nil; |
746 |
< |
IBAlloc(Buffer, 0, Size + 1); |
747 |
< |
try |
748 |
< |
Result := GetData(Buffer); |
749 |
< |
if Result then |
750 |
< |
begin |
751 |
< |
Value := string(Buffer); |
752 |
< |
if Transliterate and (Value <> '') then |
753 |
< |
DataSet.Translate(PChar(Value), PChar(Value), False); |
754 |
< |
end |
755 |
< |
finally |
756 |
< |
FreeMem(Buffer); |
757 |
< |
end; |
758 |
< |
end; |
759 |
< |
|
760 |
< |
procedure TIBStringField.SetAsString(const Value: string); |
761 |
< |
var |
762 |
< |
Buffer: PChar; |
763 |
< |
begin |
764 |
< |
Buffer := nil; |
765 |
< |
IBAlloc(Buffer, 0, Size + 1); |
766 |
< |
try |
767 |
< |
StrLCopy(Buffer, PChar(Value), Size); |
768 |
< |
if Transliterate then |
769 |
< |
DataSet.Translate(Buffer, Buffer, True); |
770 |
< |
SetData(Buffer); |
771 |
< |
finally |
772 |
< |
FreeMem(Buffer); |
773 |
< |
end; |
774 |
< |
end; |
775 |
< |
|
776 |
< |
{ TIBBCDField } |
777 |
< |
|
778 |
< |
constructor TIBBCDField.Create(AOwner: TComponent); |
779 |
< |
begin |
780 |
< |
inherited Create(AOwner); |
781 |
< |
SetDataType(ftBCD); |
782 |
< |
Size := 8; |
783 |
< |
end; |
784 |
< |
|
785 |
< |
class procedure TIBBCDField.CheckTypeSize(Value: Integer); |
786 |
< |
begin |
787 |
< |
{ No need to check as the base type is currency, not BCD } |
788 |
< |
end; |
789 |
< |
|
790 |
< |
function TIBBCDField.GetAsCurrency: Currency; |
791 |
< |
begin |
792 |
< |
if not GetValue(Result) then |
793 |
< |
Result := 0; |
794 |
< |
end; |
795 |
< |
|
796 |
< |
function TIBBCDField.GetAsString: string; |
797 |
< |
var |
798 |
< |
C: System.Currency; |
799 |
< |
begin |
800 |
< |
if GetValue(C) then |
801 |
< |
Result := CurrToStr(C) |
802 |
< |
else |
803 |
< |
Result := ''; |
804 |
< |
end; |
805 |
< |
|
806 |
< |
function TIBBCDField.GetAsVariant: Variant; |
807 |
< |
var |
808 |
< |
C: System.Currency; |
809 |
< |
begin |
810 |
< |
if GetValue(C) then |
811 |
< |
Result := C |
812 |
< |
else |
813 |
< |
Result := Null; |
814 |
< |
end; |
815 |
< |
|
816 |
< |
function TIBBCDField.GetDataSize: Integer; |
817 |
< |
begin |
818 |
< |
{$IFDEF TBCDFIELD_IS_BCD} |
819 |
< |
Result := 8; |
820 |
< |
{$ELSE} |
821 |
< |
Result := inherited GetDataSize |
822 |
< |
{$ENDIF} |
823 |
< |
end; |
824 |
< |
|
825 |
< |
{ TIBDataLink } |
826 |
< |
|
827 |
< |
constructor TIBDataLink.Create(ADataSet: TIBCustomDataSet); |
828 |
< |
begin |
829 |
< |
inherited Create; |
830 |
< |
FDataSet := ADataSet; |
831 |
< |
end; |
832 |
< |
|
833 |
< |
destructor TIBDataLink.Destroy; |
834 |
< |
begin |
835 |
< |
FDataSet.FDataLink := nil; |
836 |
< |
inherited Destroy; |
837 |
< |
end; |
838 |
< |
|
839 |
< |
|
840 |
< |
procedure TIBDataLink.ActiveChanged; |
841 |
< |
begin |
842 |
< |
if FDataSet.Active then |
843 |
< |
FDataSet.RefreshParams; |
844 |
< |
end; |
845 |
< |
|
846 |
< |
|
847 |
< |
function TIBDataLink.GetDetailDataSet: TDataSet; |
848 |
< |
begin |
849 |
< |
Result := FDataSet; |
850 |
< |
end; |
851 |
< |
|
852 |
< |
procedure TIBDataLink.RecordChanged(Field: TField); |
853 |
< |
begin |
854 |
< |
if (Field = nil) and FDataSet.Active then |
855 |
< |
FDataSet.RefreshParams; |
856 |
< |
end; |
857 |
< |
|
858 |
< |
procedure TIBDataLink.CheckBrowseMode; |
859 |
< |
begin |
860 |
< |
if FDataSet.Active then |
861 |
< |
FDataSet.CheckBrowseMode; |
862 |
< |
end; |
863 |
< |
|
864 |
< |
{ TIBCustomDataSet } |
865 |
< |
|
866 |
< |
constructor TIBCustomDataSet.Create(AOwner: TComponent); |
867 |
< |
begin |
868 |
< |
inherited Create(AOwner); |
869 |
< |
FIBLoaded := False; |
870 |
< |
CheckIBLoaded; |
871 |
< |
FIBLoaded := True; |
872 |
< |
FBase := TIBBase.Create(Self); |
873 |
< |
FCurrentRecord := -1; |
874 |
< |
FDeletedRecords := 0; |
875 |
< |
FUniDirectional := False; |
876 |
< |
FBufferChunks := BufferCacheSize; |
877 |
< |
FBlobStreamList := TList.Create; |
878 |
< |
FGeneratorField := TIBGenerator.Create(self); |
879 |
< |
FDataLink := TIBDataLink.Create(Self); |
880 |
< |
FQDelete := TIBSQL.Create(Self); |
881 |
< |
FQDelete.OnSQLChanging := SQLChanging; |
882 |
< |
FQDelete.GoToFirstRecordOnExecute := False; |
883 |
< |
FQInsert := TIBSQL.Create(Self); |
884 |
< |
FQInsert.OnSQLChanging := SQLChanging; |
885 |
< |
FQInsert.GoToFirstRecordOnExecute := False; |
886 |
< |
FQRefresh := TIBSQL.Create(Self); |
887 |
< |
FQRefresh.OnSQLChanging := SQLChanging; |
888 |
< |
FQRefresh.GoToFirstRecordOnExecute := False; |
889 |
< |
FQSelect := TIBSQL.Create(Self); |
890 |
< |
FQSelect.OnSQLChanging := SQLChanging; |
891 |
< |
FQSelect.GoToFirstRecordOnExecute := False; |
892 |
< |
FQModify := TIBSQL.Create(Self); |
893 |
< |
FQModify.OnSQLChanging := SQLChanging; |
894 |
< |
FQModify.GoToFirstRecordOnExecute := False; |
895 |
< |
FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted]; |
896 |
< |
FParamCheck := True; |
897 |
< |
FGenerateParamNames := False; |
898 |
< |
FForcedRefresh := False; |
899 |
< |
FAutoCommit:= acDisabled; |
900 |
< |
{Bookmark Size is Integer for IBX} |
901 |
< |
BookmarkSize := SizeOf(Integer); |
902 |
< |
FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect; |
903 |
< |
FBase.AfterDatabaseDisconnect := DoAfterDatabaseDisconnect; |
904 |
< |
FBase.OnDatabaseFree := DoDatabaseFree; |
905 |
< |
FBase.BeforeTransactionEnd := DoBeforeTransactionEnd; |
906 |
< |
FBase.AfterTransactionEnd := DoAfterTransactionEnd; |
907 |
< |
FBase.OnTransactionFree := DoTransactionFree; |
908 |
< |
if AOwner is TIBDatabase then |
909 |
< |
Database := TIBDatabase(AOwner) |
910 |
< |
else |
911 |
< |
if AOwner is TIBTransaction then |
912 |
< |
Transaction := TIBTransaction(AOwner); |
913 |
< |
FBaseSQLSelect := TStringList.Create; |
914 |
< |
end; |
915 |
< |
|
916 |
< |
destructor TIBCustomDataSet.Destroy; |
917 |
< |
begin |
918 |
< |
if Active then Active := false; |
919 |
< |
if FIBLoaded then |
920 |
< |
begin |
921 |
< |
if assigned(FGeneratorField) then FGeneratorField.Free; |
922 |
< |
FDataLink.Free; |
923 |
< |
FBase.Free; |
924 |
< |
ClearBlobCache; |
925 |
< |
FBlobStreamList.Free; |
926 |
< |
FreeMem(FBufferCache); |
927 |
< |
FBufferCache := nil; |
928 |
< |
FreeMem(FOldBufferCache); |
929 |
< |
FOldBufferCache := nil; |
930 |
< |
FCacheSize := 0; |
931 |
< |
FOldCacheSize := 0; |
932 |
< |
FMappedFieldPosition := nil; |
933 |
< |
end; |
934 |
< |
if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free; |
935 |
< |
if assigned(FParser) then FParser.Free; |
936 |
< |
inherited Destroy; |
937 |
< |
end; |
938 |
< |
|
939 |
< |
function TIBCustomDataSet.AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode): |
940 |
< |
TGetResult; |
941 |
< |
begin |
942 |
< |
while not IsVisible(Buffer) do |
943 |
< |
begin |
944 |
< |
if GetMode = gmPrior then |
945 |
< |
begin |
946 |
< |
Dec(FCurrentRecord); |
947 |
< |
if FCurrentRecord = -1 then |
948 |
< |
begin |
949 |
< |
result := grBOF; |
950 |
< |
exit; |
951 |
< |
end; |
952 |
< |
ReadRecordCache(FCurrentRecord, Buffer, False); |
953 |
< |
end |
954 |
< |
else begin |
955 |
< |
Inc(FCurrentRecord); |
956 |
< |
if (FCurrentRecord = FRecordCount) then |
957 |
< |
begin |
958 |
< |
if (not FQSelect.EOF) and (FQSelect.Next <> nil) then |
959 |
< |
begin |
960 |
< |
FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer); |
961 |
< |
Inc(FRecordCount); |
962 |
< |
end |
963 |
< |
else begin |
964 |
< |
result := grEOF; |
965 |
< |
exit; |
966 |
< |
end; |
967 |
< |
end |
968 |
< |
else |
969 |
< |
ReadRecordCache(FCurrentRecord, Buffer, False); |
970 |
< |
end; |
971 |
< |
end; |
972 |
< |
result := grOK; |
973 |
< |
end; |
974 |
< |
|
975 |
< |
procedure TIBCustomDataSet.ApplyUpdates; |
976 |
< |
var |
977 |
< |
{$IF FPC_FULLVERSION >= 20700 } |
978 |
< |
CurBookmark: TBookmark; |
979 |
< |
{$ELSE} |
980 |
< |
CurBookmark: string; |
981 |
< |
{$ENDIF} |
982 |
< |
Buffer: PRecordData; |
983 |
< |
CurUpdateTypes: TIBUpdateRecordTypes; |
984 |
< |
UpdateAction: TIBUpdateAction; |
985 |
< |
UpdateKind: TUpdateKind; |
986 |
< |
bRecordsSkipped: Boolean; |
987 |
< |
|
988 |
< |
procedure GetUpdateKind; |
989 |
< |
begin |
990 |
< |
case Buffer^.rdCachedUpdateStatus of |
991 |
< |
cusModified: |
992 |
< |
UpdateKind := ukModify; |
993 |
< |
cusInserted: |
994 |
< |
UpdateKind := ukInsert; |
995 |
< |
else |
996 |
< |
UpdateKind := ukDelete; |
997 |
< |
end; |
998 |
< |
end; |
999 |
< |
|
1000 |
< |
procedure ResetBufferUpdateStatus; |
1001 |
< |
begin |
1002 |
< |
case Buffer^.rdCachedUpdateStatus of |
1003 |
< |
cusModified: |
1004 |
< |
begin |
1005 |
< |
PRecordData(Buffer)^.rdUpdateStatus := usUnmodified; |
1006 |
< |
PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified; |
1007 |
< |
end; |
1008 |
< |
cusInserted: |
1009 |
< |
begin |
1010 |
< |
PRecordData(Buffer)^.rdUpdateStatus := usUnmodified; |
1011 |
< |
PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified; |
1012 |
< |
end; |
1013 |
< |
cusDeleted: |
1014 |
< |
begin |
1015 |
< |
PRecordData(Buffer)^.rdUpdateStatus := usDeleted; |
1016 |
< |
PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified; |
1017 |
< |
end; |
1018 |
< |
end; |
1019 |
< |
WriteRecordCache(PRecordData(Buffer)^.rdRecordNumber, Pointer(Buffer)); |
1020 |
< |
end; |
1021 |
< |
|
1022 |
< |
procedure UpdateUsingOnUpdateRecord; |
1023 |
< |
begin |
1024 |
< |
UpdateAction := uaFail; |
1025 |
< |
try |
1026 |
< |
FOnUpdateRecord(Self, UpdateKind, UpdateAction); |
1027 |
< |
except |
1028 |
< |
on E: Exception do |
1029 |
< |
begin |
1030 |
< |
if (E is EDatabaseError) and Assigned(FOnUpdateError) then |
1031 |
< |
FOnUpdateError(Self, EIBError(E), UpdateKind, UpdateAction); |
1032 |
< |
if UpdateAction = uaFail then |
1033 |
< |
raise; |
1034 |
< |
end; |
1035 |
< |
end; |
1036 |
< |
end; |
1037 |
< |
|
1038 |
< |
procedure UpdateUsingUpdateObject; |
1039 |
< |
begin |
1040 |
< |
try |
1041 |
< |
FUpdateObject.Apply(UpdateKind,PChar(Buffer)); |
1042 |
< |
ResetBufferUpdateStatus; |
1043 |
< |
except |
1044 |
< |
on E: Exception do |
1045 |
< |
if (E is EDatabaseError) and Assigned(FOnUpdateError) then |
1046 |
< |
FOnUpdateError(Self, EIBError(E), UpdateKind, UpdateAction); |
1047 |
< |
end; |
1048 |
< |
end; |
1049 |
< |
|
1050 |
< |
procedure UpdateUsingInternalquery; |
1051 |
< |
begin |
1052 |
< |
try |
1053 |
< |
case Buffer^.rdCachedUpdateStatus of |
1054 |
< |
cusModified: |
1055 |
< |
InternalPostRecord(FQModify, Buffer); |
1056 |
< |
cusInserted: |
1057 |
< |
InternalPostRecord(FQInsert, Buffer); |
1058 |
< |
cusDeleted: |
1059 |
< |
InternalDeleteRecord(FQDelete, Buffer); |
1060 |
< |
end; |
1061 |
< |
except |
1062 |
< |
on E: EIBError do begin |
1063 |
< |
UpdateAction := uaFail; |
1064 |
< |
if Assigned(FOnUpdateError) then |
1065 |
< |
FOnUpdateError(Self, E, UpdateKind, UpdateAction); |
1066 |
< |
case UpdateAction of |
1067 |
< |
uaFail: raise; |
1068 |
< |
uaAbort: SysUtils.Abort; |
1069 |
< |
uaSkip: bRecordsSkipped := True; |
1070 |
< |
end; |
1071 |
< |
end; |
1072 |
< |
end; |
1073 |
< |
end; |
1074 |
< |
|
1075 |
< |
begin |
1076 |
< |
if State in [dsEdit, dsInsert] then |
1077 |
< |
Post; |
1078 |
< |
FBase.CheckDatabase; |
1079 |
< |
FBase.CheckTransaction; |
1080 |
< |
DisableControls; |
1081 |
< |
CurBookmark := Bookmark; |
1082 |
< |
CurUpdateTypes := FUpdateRecordTypes; |
1083 |
< |
FUpdateRecordTypes := [cusModified, cusInserted, cusDeleted]; |
1084 |
< |
try |
1085 |
< |
First; |
1086 |
< |
bRecordsSkipped := False; |
1087 |
< |
while not EOF do |
1088 |
< |
begin |
1089 |
< |
Buffer := PRecordData(GetActiveBuf); |
1090 |
< |
GetUpdateKind; |
1091 |
< |
UpdateAction := uaApply; |
1092 |
< |
if Assigned(FUpdateObject) or Assigned(FOnUpdateRecord) then |
1093 |
< |
begin |
1094 |
< |
if (Assigned(FOnUpdateRecord)) then |
1095 |
< |
UpdateUsingOnUpdateRecord |
1096 |
< |
else |
1097 |
< |
if Assigned(FUpdateObject) then |
1098 |
< |
UpdateUsingUpdateObject; |
1099 |
< |
case UpdateAction of |
1100 |
< |
uaFail: |
1101 |
< |
IBError(ibxeUserAbort, [nil]); |
1102 |
< |
uaAbort: |
1103 |
< |
SysUtils.Abort; |
1104 |
< |
uaApplied: |
1105 |
< |
ResetBufferUpdateStatus; |
1106 |
< |
uaSkip: |
1107 |
< |
bRecordsSkipped := True; |
1108 |
< |
uaRetry: |
1109 |
< |
Continue; |
1110 |
< |
end; |
1111 |
< |
end; |
1112 |
< |
if (not Assigned(FUpdateObject)) and (UpdateAction = UaApply) then |
1113 |
< |
begin |
1114 |
< |
UpdateUsingInternalquery; |
1115 |
< |
UpdateAction := uaApplied; |
1116 |
< |
end; |
1117 |
< |
Next; |
1118 |
< |
end; |
1119 |
< |
FUpdatesPending := bRecordsSkipped; |
1120 |
< |
finally |
1121 |
< |
FUpdateRecordTypes := CurUpdateTypes; |
1122 |
< |
Bookmark := CurBookmark; |
1123 |
< |
EnableControls; |
1124 |
< |
end; |
1125 |
< |
end; |
1126 |
< |
|
1127 |
< |
procedure TIBCustomDataSet.InternalBatchInput(InputObject: TIBBatchInput); |
1128 |
< |
begin |
1129 |
< |
FQSelect.BatchInput(InputObject); |
1130 |
< |
end; |
1131 |
< |
|
1132 |
< |
procedure TIBCustomDataSet.InternalBatchOutput(OutputObject: TIBBatchOutput); |
1133 |
< |
var |
1134 |
< |
Qry: TIBSQL; |
1135 |
< |
begin |
1136 |
< |
Qry := TIBSQL.Create(Self); |
1137 |
< |
try |
1138 |
< |
Qry.Database := FBase.Database; |
1139 |
< |
Qry.Transaction := FBase.Transaction; |
1140 |
< |
Qry.SQL.Assign(FQSelect.SQL); |
1141 |
< |
Qry.BatchOutput(OutputObject); |
1142 |
< |
finally |
1143 |
< |
Qry.Free; |
1144 |
< |
end; |
1145 |
< |
end; |
1146 |
< |
|
1147 |
< |
procedure TIBCustomDataSet.CancelUpdates; |
1148 |
< |
var |
1149 |
< |
CurUpdateTypes: TIBUpdateRecordTypes; |
1150 |
< |
begin |
1151 |
< |
if State in [dsEdit, dsInsert] then |
1152 |
< |
Post; |
1153 |
< |
if FCachedUpdates and FUpdatesPending then |
1154 |
< |
begin |
1155 |
< |
DisableControls; |
1156 |
< |
CurUpdateTypes := UpdateRecordTypes; |
1157 |
< |
UpdateRecordTypes := [cusModified, cusInserted, cusDeleted]; |
1158 |
< |
try |
1159 |
< |
First; |
1160 |
< |
while not EOF do |
1161 |
< |
begin |
1162 |
< |
if UpdateStatus = usInserted then |
1163 |
< |
RevertRecord |
1164 |
< |
else |
1165 |
< |
begin |
1166 |
< |
RevertRecord; |
1167 |
< |
Next; |
1168 |
< |
end; |
1169 |
< |
end; |
1170 |
< |
finally |
1171 |
< |
UpdateRecordTypes := CurUpdateTypes; |
1172 |
< |
First; |
1173 |
< |
FUpdatesPending := False; |
1174 |
< |
EnableControls; |
1175 |
< |
end; |
1176 |
< |
end; |
1177 |
< |
end; |
1178 |
< |
|
1179 |
< |
function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer; |
1180 |
< |
var i: integer; |
1181 |
< |
Prepared: boolean; |
1182 |
< |
begin |
1183 |
< |
Result := 0; |
1184 |
< |
Prepared := FInternalPrepared; |
1185 |
< |
if not Prepared then |
1186 |
< |
InternalPrepare; |
1187 |
< |
try |
1188 |
< |
for i := 0 to Length(FAliasNameList) - 1 do |
1189 |
< |
if FAliasNameList[i] = AliasName then |
1190 |
< |
begin |
1191 |
< |
Result := i + 1; |
1192 |
< |
Exit |
1193 |
< |
end; |
1194 |
< |
finally |
1195 |
< |
if not Prepared then |
1196 |
< |
InternalUnPrepare; |
1197 |
< |
end; |
1198 |
< |
end; |
1199 |
< |
|
1200 |
< |
procedure TIBCustomDataSet.ActivateConnection; |
1201 |
< |
begin |
1202 |
< |
if not Assigned(Database) then |
1203 |
< |
IBError(ibxeDatabaseNotAssigned, [nil]); |
1204 |
< |
if not Assigned(Transaction) then |
1205 |
< |
IBError(ibxeTransactionNotAssigned, [nil]); |
1206 |
< |
if not Database.Connected then Database.Open; |
1207 |
< |
end; |
1208 |
< |
|
1209 |
< |
function TIBCustomDataSet.ActivateTransaction: Boolean; |
1210 |
< |
begin |
1211 |
< |
Result := False; |
1212 |
< |
if not Assigned(Transaction) then |
1213 |
< |
IBError(ibxeTransactionNotAssigned, [nil]); |
1214 |
< |
if not Transaction.Active then |
1215 |
< |
begin |
1216 |
< |
Result := True; |
1217 |
< |
Transaction.StartTransaction; |
1218 |
< |
FDidActivate := True; |
1219 |
< |
end; |
1220 |
< |
end; |
1221 |
< |
|
1222 |
< |
procedure TIBCustomDataSet.DeactivateTransaction; |
1223 |
< |
var |
1224 |
< |
i: Integer; |
1225 |
< |
begin |
1226 |
< |
if not Assigned(Transaction) then |
1227 |
< |
IBError(ibxeTransactionNotAssigned, [nil]); |
1228 |
< |
with Transaction do |
1229 |
< |
begin |
1230 |
< |
for i := 0 to SQLObjectCount - 1 do |
1231 |
< |
begin |
1232 |
< |
if (SQLObjects[i] <> nil) and ((SQLObjects[i]).owner is TDataSet) then |
1233 |
< |
begin |
1234 |
< |
if TDataSet(SQLObjects[i].owner).Active then |
1235 |
< |
begin |
1236 |
< |
FDidActivate := False; |
1237 |
< |
exit; |
1238 |
< |
end; |
1239 |
< |
end; |
1240 |
< |
end; |
1241 |
< |
end; |
1242 |
< |
FInternalPrepared := False; |
1243 |
< |
if Transaction.InTransaction then |
1244 |
< |
Transaction.Commit; |
1245 |
< |
FDidActivate := False; |
1246 |
< |
end; |
1247 |
< |
|
1248 |
< |
procedure TIBCustomDataSet.CheckDatasetClosed; |
1249 |
< |
begin |
1250 |
< |
if FOpen then |
1251 |
< |
IBError(ibxeDatasetOpen, [nil]); |
1252 |
< |
end; |
1253 |
< |
|
1254 |
< |
procedure TIBCustomDataSet.CheckDatasetOpen; |
1255 |
< |
begin |
1256 |
< |
if not FOpen then |
1257 |
< |
IBError(ibxeDatasetClosed, [nil]); |
1258 |
< |
end; |
1259 |
< |
|
1260 |
< |
function TIBCustomDataSet.CreateParser: TSelectSQLParser; |
1261 |
< |
begin |
1262 |
< |
Result := TSelectSQLParser.Create(self,FBaseSQLSelect); |
1263 |
< |
Result.OnSQLChanging := SQLChanging |
1264 |
< |
end; |
1265 |
< |
|
1266 |
< |
procedure TIBCustomDataSet.CheckNotUniDirectional; |
1267 |
< |
begin |
1268 |
< |
if UniDirectional then |
1269 |
< |
IBError(ibxeDataSetUniDirectional, [nil]); |
1270 |
< |
end; |
1271 |
< |
|
1272 |
< |
procedure TIBCustomDataSet.AdjustRecordOnInsert(Buffer: Pointer); |
1273 |
< |
begin |
1274 |
< |
with PRecordData(Buffer)^ do |
1275 |
< |
if (State = dsInsert) and (not Modified) then |
1276 |
< |
begin |
1277 |
< |
rdRecordNumber := FRecordCount; |
1278 |
< |
FCurrentRecord := FRecordCount; |
1279 |
< |
end; |
1280 |
< |
end; |
1281 |
< |
|
1282 |
< |
function TIBCustomDataSet.CanEdit: Boolean; |
1283 |
< |
var |
1284 |
< |
Buff: PRecordData; |
1285 |
< |
begin |
1286 |
< |
Buff := PRecordData(GetActiveBuf); |
1287 |
< |
result := (FQModify.SQL.Text <> '') or |
1288 |
< |
(Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukModify).Text <> '')) or |
1289 |
< |
((Buff <> nil) and (Buff^.rdCachedUpdateStatus = cusInserted) and |
1290 |
< |
(FCachedUpdates)); |
1291 |
< |
end; |
1292 |
< |
|
1293 |
< |
function TIBCustomDataSet.CanInsert: Boolean; |
1294 |
< |
begin |
1295 |
< |
result := (FQInsert.SQL.Text <> '') or |
1296 |
< |
(Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukInsert).Text <> '')); |
1297 |
< |
end; |
1298 |
< |
|
1299 |
< |
function TIBCustomDataSet.CanDelete: Boolean; |
1300 |
< |
begin |
1301 |
< |
if (FQDelete.SQL.Text <> '') or |
1302 |
< |
(Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then |
1303 |
< |
result := True |
1304 |
< |
else |
1305 |
< |
result := False; |
1306 |
< |
end; |
1307 |
< |
|
1308 |
< |
function TIBCustomDataSet.CanRefresh: Boolean; |
1309 |
< |
begin |
1310 |
< |
result := (FQRefresh.SQL.Text <> '') or |
1311 |
< |
(Assigned(FUpdateObject) and (FUpdateObject.RefreshSQL.Text <> '')); |
1312 |
< |
end; |
1313 |
< |
|
1314 |
< |
procedure TIBCustomDataSet.CheckEditState; |
1315 |
< |
begin |
1316 |
< |
case State of |
1317 |
< |
{ Check all the wsEditMode types } |
1318 |
< |
dsEdit, dsInsert, dsSetKey, dsCalcFields, dsFilter, |
1319 |
< |
dsNewValue, dsInternalCalc : |
1320 |
< |
begin |
1321 |
< |
if (State in [dsEdit]) and (not CanEdit) then |
1322 |
< |
IBError(ibxeCannotUpdate, [nil]); |
1323 |
< |
if (State in [dsInsert]) and (not CanInsert) then |
1324 |
< |
IBError(ibxeCannotInsert, [nil]); |
1325 |
< |
end; |
1326 |
< |
else |
1327 |
< |
IBError(ibxeNotEditing, []) |
1328 |
< |
end; |
1329 |
< |
end; |
1330 |
< |
|
1331 |
< |
procedure TIBCustomDataSet.ClearBlobCache; |
1332 |
< |
var |
1333 |
< |
i: Integer; |
1334 |
< |
begin |
1335 |
< |
for i := 0 to FBlobStreamList.Count - 1 do |
1336 |
< |
begin |
1337 |
< |
TIBBlobStream(FBlobStreamList[i]).Free; |
1338 |
< |
FBlobStreamList[i] := nil; |
1339 |
< |
end; |
1340 |
< |
FBlobStreamList.Pack; |
1341 |
< |
end; |
1342 |
< |
|
1343 |
< |
procedure TIBCustomDataSet.CopyRecordBuffer(Source, Dest: Pointer); |
1344 |
< |
begin |
1345 |
< |
Move(Source^, Dest^, FRecordBufferSize); |
1346 |
< |
end; |
1347 |
< |
|
1348 |
< |
procedure TIBCustomDataSet.DoBeforeDatabaseDisconnect(Sender: TObject); |
1349 |
< |
begin |
1350 |
< |
if Active then |
1351 |
< |
Active := False; |
1352 |
< |
FInternalPrepared := False; |
1353 |
< |
if Assigned(FBeforeDatabaseDisconnect) then |
1354 |
< |
FBeforeDatabaseDisconnect(Sender); |
1355 |
< |
end; |
1356 |
< |
|
1357 |
< |
procedure TIBCustomDataSet.DoAfterDatabaseDisconnect(Sender: TObject); |
1358 |
< |
begin |
1359 |
< |
if Assigned(FAfterDatabaseDisconnect) then |
1360 |
< |
FAfterDatabaseDisconnect(Sender); |
1361 |
< |
end; |
1362 |
< |
|
1363 |
< |
procedure TIBCustomDataSet.DoDatabaseFree(Sender: TObject); |
1364 |
< |
begin |
1365 |
< |
if Assigned(FDatabaseFree) then |
1366 |
< |
FDatabaseFree(Sender); |
1367 |
< |
end; |
1368 |
< |
|
1369 |
< |
procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject); |
1370 |
< |
begin |
1371 |
< |
if Active then |
1372 |
< |
Active := False; |
1373 |
< |
if FQSelect <> nil then |
1374 |
< |
FQSelect.FreeHandle; |
1375 |
< |
if FQDelete <> nil then |
1376 |
< |
FQDelete.FreeHandle; |
1377 |
< |
if FQInsert <> nil then |
1378 |
< |
FQInsert.FreeHandle; |
1379 |
< |
if FQModify <> nil then |
1380 |
< |
FQModify.FreeHandle; |
1381 |
< |
if FQRefresh <> nil then |
1382 |
< |
FQRefresh.FreeHandle; |
1383 |
< |
if Assigned(FBeforeTransactionEnd) then |
1384 |
< |
FBeforeTransactionEnd(Sender); |
1385 |
< |
end; |
1386 |
< |
|
1387 |
< |
procedure TIBCustomDataSet.DoAfterTransactionEnd(Sender: TObject); |
1388 |
< |
begin |
1389 |
< |
if Assigned(FAfterTransactionEnd) then |
1390 |
< |
FAfterTransactionEnd(Sender); |
1391 |
< |
end; |
1392 |
< |
|
1393 |
< |
procedure TIBCustomDataSet.DoTransactionFree(Sender: TObject); |
1394 |
< |
begin |
1395 |
< |
if Assigned(FTransactionFree) then |
1396 |
< |
FTransactionFree(Sender); |
1397 |
< |
end; |
1398 |
< |
|
1399 |
< |
{ Read the record from FQSelect.Current into the record buffer |
1400 |
< |
Then write the buffer to in memory cache } |
1401 |
< |
procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL; |
1402 |
< |
RecordNumber: Integer; Buffer: PChar); |
1403 |
< |
var |
1404 |
< |
p: PRecordData; |
1405 |
< |
pbd: PBlobDataArray; |
1406 |
< |
i, j: Integer; |
1407 |
< |
LocalData: Pointer; |
1408 |
< |
LocalDate, LocalDouble: Double; |
1409 |
< |
LocalInt: Integer; |
1410 |
< |
LocalBool: wordBool; |
1411 |
< |
LocalInt64: Int64; |
1412 |
< |
LocalCurrency: Currency; |
1413 |
< |
FieldsLoaded: Integer; |
1414 |
< |
temp: TIBXSQLVAR; |
1415 |
< |
begin |
1416 |
< |
p := PRecordData(Buffer); |
1417 |
< |
{ Make sure blob cache is empty } |
1418 |
< |
pbd := PBlobDataArray(Buffer + FBlobCacheOffset); |
1419 |
< |
if RecordNumber > -1 then |
1420 |
< |
for i := 0 to BlobFieldCount - 1 do |
1421 |
< |
pbd^[i] := nil; |
1422 |
< |
{ Get record information } |
1423 |
< |
p^.rdBookmarkFlag := bfCurrent; |
1424 |
< |
p^.rdFieldCount := Qry.Current.Count; |
1425 |
< |
p^.rdRecordNumber := RecordNumber; |
1426 |
< |
p^.rdUpdateStatus := usUnmodified; |
1427 |
< |
p^.rdCachedUpdateStatus := cusUnmodified; |
1428 |
< |
p^.rdSavedOffset := $FFFFFFFF; |
1429 |
< |
|
1430 |
< |
{ Load up the fields } |
1431 |
< |
FieldsLoaded := FQSelect.Current.Count; |
1432 |
< |
j := 1; |
1433 |
< |
for i := 0 to Qry.Current.Count - 1 do |
1434 |
< |
begin |
1435 |
< |
if (Qry = FQSelect) then |
1436 |
< |
j := i + 1 |
1437 |
< |
else begin |
1438 |
< |
if FieldsLoaded = 0 then |
1439 |
< |
break; |
1440 |
< |
j := FQSelect.FieldIndex[Qry.Current[i].Name] + 1; |
1441 |
< |
if j < 1 then |
1442 |
< |
continue |
1443 |
< |
else |
1444 |
< |
Dec(FieldsLoaded); |
1445 |
< |
end; |
1446 |
< |
with FQSelect.Current[j - 1].Data^ do |
1447 |
< |
if aliasname = 'IBX_INTERNAL_DBKEY' then {do not localize} |
1448 |
< |
begin |
1449 |
< |
if sqllen <= 8 then |
1450 |
< |
p^.rdDBKey := PIBDBKEY(Qry.Current[i].AsPointer)^; |
1451 |
< |
continue; |
1452 |
< |
end; |
1453 |
< |
if j > 0 then with p^ do |
1454 |
< |
begin |
1455 |
< |
rdFields[j].fdDataType := |
1456 |
< |
Qry.Current[i].Data^.sqltype and (not 1); |
1457 |
< |
rdFields[j].fdDataScale := |
1458 |
< |
Qry.Current[i].Data^.sqlscale; |
1459 |
< |
rdFields[j].fdNullable := |
1460 |
< |
(Qry.Current[i].Data^.sqltype and 1 = 1); |
1461 |
< |
rdFields[j].fdIsNull := |
1462 |
< |
(rdFields[j].fdNullable and (Qry.Current[i].Data^.sqlind^ = -1)); |
1463 |
< |
LocalData := Qry.Current[i].Data^.sqldata; |
1464 |
< |
case rdFields[j].fdDataType of |
1465 |
< |
SQL_TIMESTAMP: |
1466 |
< |
begin |
1467 |
< |
rdFields[j].fdDataSize := SizeOf(TDateTime); |
1468 |
< |
if RecordNumber >= 0 then |
1469 |
< |
LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry.Current[i].AsDateTime)); |
1470 |
< |
LocalData := PChar(@LocalDate); |
1471 |
< |
end; |
1472 |
< |
SQL_TYPE_DATE: |
1473 |
< |
begin |
1474 |
< |
rdFields[j].fdDataSize := SizeOf(TDateTime); |
1475 |
< |
if RecordNumber >= 0 then |
1476 |
< |
LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Date; |
1477 |
< |
LocalData := PChar(@LocalInt); |
1478 |
< |
end; |
1479 |
< |
SQL_TYPE_TIME: |
1480 |
< |
begin |
1481 |
< |
rdFields[j].fdDataSize := SizeOf(TDateTime); |
1482 |
< |
if RecordNumber >= 0 then |
1483 |
< |
LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Time; |
1484 |
< |
LocalData := PChar(@LocalInt); |
1485 |
< |
end; |
1486 |
< |
SQL_SHORT, SQL_LONG: |
1487 |
< |
begin |
1488 |
< |
if (rdFields[j].fdDataScale = 0) then |
1489 |
< |
begin |
1490 |
< |
rdFields[j].fdDataSize := SizeOf(Integer); |
1491 |
< |
if RecordNumber >= 0 then |
1492 |
< |
LocalInt := Qry.Current[i].AsLong; |
1493 |
< |
LocalData := PChar(@LocalInt); |
1494 |
< |
end |
1495 |
< |
else if (rdFields[j].fdDataScale >= (-4)) then |
1496 |
< |
begin |
1497 |
< |
rdFields[j].fdDataSize := SizeOf(Currency); |
1498 |
< |
if RecordNumber >= 0 then |
1499 |
< |
LocalCurrency := Qry.Current[i].AsCurrency; |
1500 |
< |
LocalData := PChar(@LocalCurrency); |
1501 |
< |
end |
1502 |
< |
else begin |
1503 |
< |
rdFields[j].fdDataSize := SizeOf(Double); |
1504 |
< |
if RecordNumber >= 0 then |
1505 |
< |
LocalDouble := Qry.Current[i].AsDouble; |
1506 |
< |
LocalData := PChar(@LocalDouble); |
1507 |
< |
end; |
1508 |
< |
end; |
1509 |
< |
SQL_INT64: |
1510 |
< |
begin |
1511 |
< |
if (rdFields[j].fdDataScale = 0) then |
1512 |
< |
begin |
1513 |
< |
rdFields[j].fdDataSize := SizeOf(Int64); |
1514 |
< |
if RecordNumber >= 0 then |
1515 |
< |
LocalInt64 := Qry.Current[i].AsInt64; |
1516 |
< |
LocalData := PChar(@LocalInt64); |
1517 |
< |
end |
1518 |
< |
else if (rdFields[j].fdDataScale >= (-4)) then |
1519 |
< |
begin |
1520 |
< |
rdFields[j].fdDataSize := SizeOf(Currency); |
1521 |
< |
if RecordNumber >= 0 then |
1522 |
< |
LocalCurrency := Qry.Current[i].AsCurrency; |
1523 |
< |
LocalData := PChar(@LocalCurrency); |
1524 |
< |
end |
1525 |
< |
else begin |
1526 |
< |
rdFields[j].fdDataSize := SizeOf(Double); |
1527 |
< |
if RecordNumber >= 0 then |
1528 |
< |
LocalDouble := Qry.Current[i].AsDouble; |
1529 |
< |
LocalData := PChar(@LocalDouble); |
1530 |
< |
end |
1531 |
< |
end; |
1532 |
< |
SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: |
1533 |
< |
begin |
1534 |
< |
rdFields[j].fdDataSize := SizeOf(Double); |
1535 |
< |
if RecordNumber >= 0 then |
1536 |
< |
LocalDouble := Qry.Current[i].AsDouble; |
1537 |
< |
LocalData := PChar(@LocalDouble); |
1538 |
< |
end; |
1539 |
< |
SQL_VARYING: |
1540 |
< |
begin |
1541 |
< |
rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen; |
1542 |
< |
rdFields[j].fdDataLength := isc_vax_integer(Qry.Current[i].Data^.sqldata, 2); |
1543 |
< |
if RecordNumber >= 0 then |
1544 |
< |
begin |
1545 |
< |
if (rdFields[j].fdDataLength = 0) then |
1546 |
< |
LocalData := nil |
1547 |
< |
else |
1548 |
< |
begin |
1549 |
< |
temp := Qry.Current[i]; |
1550 |
< |
LocalData := @temp.Data^.sqldata[2]; |
1551 |
< |
(* LocalData := @Qry.Current[i].Data^.sqldata[2];*) |
1552 |
< |
end; |
1553 |
< |
end; |
1554 |
< |
end; |
1555 |
< |
SQL_BOOLEAN: |
1556 |
< |
begin |
1557 |
< |
LocalBool:= false; |
1558 |
< |
rdFields[j].fdDataSize := SizeOf(wordBool); |
1559 |
< |
if RecordNumber >= 0 then |
1560 |
< |
LocalBool := Qry.Current[i].AsBoolean; |
1561 |
< |
LocalData := PChar(@LocalBool); |
1562 |
< |
end; |
1563 |
< |
else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD } |
1564 |
< |
begin |
1565 |
< |
rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen; |
1566 |
< |
if (rdFields[j].fdDataType = SQL_TEXT) then |
1567 |
< |
rdFields[j].fdDataLength := rdFields[j].fdDataSize; |
1568 |
< |
end; |
1569 |
< |
end; |
1570 |
< |
if RecordNumber < 0 then |
1571 |
< |
begin |
1572 |
< |
rdFields[j].fdIsNull := True; |
1573 |
< |
rdFields[j].fdDataOfs := FRecordSize; |
1574 |
< |
Inc(FRecordSize, rdFields[j].fdDataSize); |
1575 |
< |
end |
1576 |
< |
else begin |
1577 |
< |
if rdFields[j].fdDataType = SQL_VARYING then |
1578 |
< |
begin |
1579 |
< |
if LocalData <> nil then |
1580 |
< |
Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataLength) |
1581 |
< |
end |
1582 |
< |
else |
1583 |
< |
Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataSize) |
1584 |
< |
end; |
1585 |
< |
end; |
1586 |
< |
end; |
1587 |
< |
WriteRecordCache(RecordNumber, PChar(p)); |
1588 |
< |
end; |
1589 |
< |
|
1590 |
< |
function TIBCustomDataSet.GetActiveBuf: PChar; |
1591 |
< |
begin |
1592 |
< |
case State of |
1593 |
< |
dsBrowse: |
1594 |
< |
if IsEmpty then |
1595 |
< |
result := nil |
1596 |
< |
else |
1597 |
< |
result := ActiveBuffer; |
1598 |
< |
dsEdit, dsInsert: |
1599 |
< |
result := ActiveBuffer; |
1600 |
< |
dsCalcFields: |
1601 |
< |
result := CalcBuffer; |
1602 |
< |
dsFilter: |
1603 |
< |
result := FFilterBuffer; |
1604 |
< |
dsNewValue: |
1605 |
< |
result := ActiveBuffer; |
1606 |
< |
dsOldValue: |
1607 |
< |
if (PRecordData(ActiveBuffer)^.rdRecordNumber = |
1608 |
< |
PRecordData(FOldBuffer)^.rdRecordNumber) then |
1609 |
< |
result := FOldBuffer |
1610 |
< |
else |
1611 |
< |
result := ActiveBuffer; |
1612 |
< |
else if not FOpen then |
1613 |
< |
result := nil |
1614 |
< |
else |
1615 |
< |
result := ActiveBuffer; |
1616 |
< |
end; |
1617 |
< |
end; |
1618 |
< |
|
1619 |
< |
function TIBCustomDataSet.CachedUpdateStatus: TCachedUpdateStatus; |
1620 |
< |
begin |
1621 |
< |
if Active then |
1622 |
< |
result := PRecordData(GetActiveBuf)^.rdCachedUpdateStatus |
1623 |
< |
else |
1624 |
< |
result := cusUnmodified; |
1625 |
< |
end; |
1626 |
< |
|
1627 |
< |
function TIBCustomDataSet.GetDatabase: TIBDatabase; |
1628 |
< |
begin |
1629 |
< |
result := FBase.Database; |
1630 |
< |
end; |
1631 |
< |
|
1632 |
< |
function TIBCustomDataSet.GetDBHandle: PISC_DB_HANDLE; |
1633 |
< |
begin |
1634 |
< |
result := FBase.DBHandle; |
1635 |
< |
end; |
1636 |
< |
|
1637 |
< |
function TIBCustomDataSet.GetDeleteSQL: TStrings; |
1638 |
< |
begin |
1639 |
< |
result := FQDelete.SQL; |
1640 |
< |
end; |
1641 |
< |
|
1642 |
< |
function TIBCustomDataSet.GetInsertSQL: TStrings; |
1643 |
< |
begin |
1644 |
< |
result := FQInsert.SQL; |
1645 |
< |
end; |
1646 |
< |
|
1647 |
< |
function TIBCustomDataSet.GetSQLParams: TIBXSQLDA; |
1648 |
< |
begin |
1649 |
< |
if not FInternalPrepared then |
1650 |
< |
InternalPrepare; |
1651 |
< |
result := FQSelect.Params; |
1652 |
< |
end; |
1653 |
< |
|
1654 |
< |
function TIBCustomDataSet.GetRefreshSQL: TStrings; |
1655 |
< |
begin |
1656 |
< |
result := FQRefresh.SQL; |
1657 |
< |
end; |
1658 |
< |
|
1659 |
< |
function TIBCustomDataSet.GetSelectSQL: TStrings; |
1660 |
< |
begin |
1661 |
< |
result := FQSelect.SQL; |
1662 |
< |
end; |
1663 |
< |
|
1664 |
< |
function TIBCustomDataSet.GetStatementType: TIBSQLTypes; |
1665 |
< |
begin |
1666 |
< |
result := FQSelect.SQLType; |
1667 |
< |
end; |
1668 |
< |
|
1669 |
< |
function TIBCustomDataSet.GetModifySQL: TStrings; |
1670 |
< |
begin |
1671 |
< |
result := FQModify.SQL; |
1672 |
< |
end; |
1673 |
< |
|
1674 |
< |
function TIBCustomDataSet.GetTransaction: TIBTransaction; |
1675 |
< |
begin |
1676 |
< |
result := FBase.Transaction; |
1677 |
< |
end; |
1678 |
< |
|
1679 |
< |
function TIBCustomDataSet.GetTRHandle: PISC_TR_HANDLE; |
1680 |
< |
begin |
1681 |
< |
result := FBase.TRHandle; |
1682 |
< |
end; |
1683 |
< |
|
1684 |
< |
procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); |
1685 |
< |
begin |
1686 |
< |
if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then |
1687 |
< |
FUpdateObject.Apply(ukDelete,Buff) |
1688 |
< |
else |
1689 |
< |
begin |
1690 |
< |
SetInternalSQLParams(FQDelete, Buff); |
1691 |
< |
FQDelete.ExecQuery; |
1692 |
< |
end; |
1693 |
< |
with PRecordData(Buff)^ do |
1694 |
< |
begin |
1695 |
< |
rdUpdateStatus := usDeleted; |
1696 |
< |
rdCachedUpdateStatus := cusUnmodified; |
1697 |
< |
end; |
1698 |
< |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff); |
1699 |
< |
end; |
1700 |
< |
|
1701 |
< |
function TIBCustomDataSet.InternalLocate(const KeyFields: string; |
1702 |
< |
const KeyValues: Variant; Options: TLocateOptions): Boolean; |
1703 |
< |
var |
1704 |
< |
keyFieldList: TList; |
1705 |
< |
{$IF FPC_FULLVERSION >= 20700 } |
1706 |
< |
CurBookmark: TBookmark; |
1707 |
< |
{$ELSE} |
1708 |
< |
CurBookmark: string; |
1709 |
< |
{$ENDIF} |
1710 |
< |
fieldValue: Variant; |
1711 |
< |
lookupValues: array of variant; |
1712 |
< |
i, fieldCount: Integer; |
1713 |
< |
fieldValueAsString: string; |
1714 |
< |
lookupValueAsString: string; |
1715 |
< |
begin |
1716 |
< |
keyFieldList := TList.Create; |
1717 |
< |
try |
1718 |
< |
GetFieldList(keyFieldList, KeyFields); |
1719 |
< |
fieldCount := keyFieldList.Count; |
1720 |
< |
CurBookmark := Bookmark; |
1721 |
< |
result := false; |
1722 |
< |
SetLength(lookupValues, fieldCount); |
1723 |
< |
if not EOF then |
1724 |
< |
begin |
1725 |
< |
for i := 0 to fieldCount - 1 do {expand key values into lookupValues array} |
1726 |
< |
begin |
1727 |
< |
if VarIsArray(KeyValues) then |
1728 |
< |
lookupValues[i] := KeyValues[i] |
1729 |
< |
else |
1730 |
< |
if i > 0 then |
1731 |
< |
lookupValues[i] := NULL |
1732 |
< |
else |
1733 |
< |
lookupValues[0] := KeyValues; |
1734 |
< |
|
1735 |
< |
{convert to upper case is case insensitive search} |
1736 |
< |
if (TField(keyFieldList[i]).DataType = ftString) and |
1737 |
< |
not VarIsNull(lookupValues[i]) and (loCaseInsensitive in Options) then |
1738 |
< |
lookupValues[i] := UpperCase(lookupValues[i]); |
1739 |
< |
end; |
1740 |
< |
end; |
1741 |
< |
while not result and not EOF do {search for a matching record} |
1742 |
< |
begin |
1743 |
< |
i := 0; |
1744 |
< |
result := true; |
1745 |
< |
while result and (i < fieldCount) do |
1746 |
< |
{see if all of the key fields matches} |
1747 |
< |
begin |
1748 |
< |
fieldValue := TField(keyFieldList[i]).Value; |
1749 |
< |
result := not (VarIsNull(fieldValue) xor VarIsNull(lookupValues[i])); |
1750 |
< |
if result and not VarIsNull(fieldValue) then |
1751 |
< |
begin |
1752 |
< |
try |
1753 |
< |
if TField(keyFieldList[i]).DataType = ftString then |
1754 |
< |
begin |
1755 |
< |
{strings need special handling because of the locate options that |
1756 |
< |
apply to them} |
1757 |
< |
fieldValueAsString := TField(keyFieldList[i]).AsString; |
1758 |
< |
lookupValueAsString := lookupValues[i]; |
1759 |
< |
if (loCaseInsensitive in Options) then |
1760 |
< |
fieldValueAsString := UpperCase(fieldValueAsString); |
1761 |
< |
|
1762 |
< |
if (loPartialKey in Options) then |
1763 |
< |
result := result and (Pos(lookupValueAsString, fieldValueAsString) = 1) |
1764 |
< |
else |
1765 |
< |
result := result and (fieldValueAsString = lookupValueAsString); |
1766 |
< |
end |
1767 |
< |
else |
1768 |
< |
result := result and (lookupValues[i] = |
1769 |
< |
VarAsType(fieldValue, VarType(lookupValues[i]))); |
1770 |
< |
except on EVariantError do |
1771 |
< |
result := False; |
1772 |
< |
end; |
1773 |
< |
end; |
1774 |
< |
Inc(i); |
1775 |
< |
end; |
1776 |
< |
if not result then |
1777 |
< |
Next; |
1778 |
< |
end; |
1779 |
< |
if not result then |
1780 |
< |
Bookmark := CurBookmark |
1781 |
< |
else |
1782 |
< |
CursorPosChanged; |
1783 |
< |
finally |
1784 |
< |
keyFieldList.Free; |
1785 |
< |
SetLength(lookupValues,0) |
1786 |
< |
end; |
1787 |
< |
end; |
1788 |
< |
|
1789 |
< |
procedure TIBCustomDataSet.InternalPostRecord(Qry: TIBSQL; Buff: Pointer); |
1790 |
< |
var |
1791 |
< |
i, j, k: Integer; |
1792 |
< |
pbd: PBlobDataArray; |
1793 |
< |
begin |
1794 |
< |
pbd := PBlobDataArray(PChar(Buff) + FBlobCacheOffset); |
1795 |
< |
j := 0; |
1796 |
< |
for i := 0 to FieldCount - 1 do |
1797 |
< |
if Fields[i].IsBlob then |
1798 |
< |
begin |
1799 |
< |
k := FMappedFieldPosition[Fields[i].FieldNo -1]; |
1800 |
< |
if pbd^[j] <> nil then |
1801 |
< |
begin |
1802 |
< |
pbd^[j].Finalize; |
1803 |
< |
PISC_QUAD( |
1804 |
< |
PChar(Buff) + PRecordData(Buff)^.rdFields[k].fdDataOfs)^ := |
1805 |
< |
pbd^[j].BlobID; |
1806 |
< |
PRecordData(Buff)^.rdFields[k].fdIsNull := pbd^[j].Size = 0; |
1807 |
< |
end; |
1808 |
< |
Inc(j); |
1809 |
< |
end; |
1810 |
< |
if Assigned(FUpdateObject) then |
1811 |
< |
begin |
1812 |
< |
if (Qry = FQDelete) then |
1813 |
< |
FUpdateObject.Apply(ukDelete,Buff) |
1814 |
< |
else if (Qry = FQInsert) then |
1815 |
< |
FUpdateObject.Apply(ukInsert,Buff) |
1816 |
< |
else |
1817 |
< |
FUpdateObject.Apply(ukModify,Buff); |
1818 |
< |
end |
1819 |
< |
else begin |
1820 |
< |
SetInternalSQLParams(Qry, Buff); |
1821 |
< |
Qry.ExecQuery; |
1822 |
< |
end; |
1823 |
< |
PRecordData(Buff)^.rdUpdateStatus := usUnmodified; |
1824 |
< |
PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified; |
1825 |
< |
SetModified(False); |
1826 |
< |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff); |
1827 |
< |
if (FForcedRefresh or FNeedsRefresh) and CanRefresh then |
1828 |
< |
InternalRefreshRow; |
1829 |
< |
end; |
1830 |
< |
|
1831 |
< |
procedure TIBCustomDataSet.InternalRefreshRow; |
1832 |
< |
var |
1833 |
< |
Buff: PChar; |
1834 |
< |
SetCursor: Boolean; |
1835 |
< |
ofs: DWORD; |
1836 |
< |
Qry: TIBSQL; |
1837 |
< |
begin |
1838 |
< |
if Assigned(Database) and not Database.SQLHourGlass then |
1839 |
< |
SetCursor := False |
1840 |
< |
else |
1841 |
< |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
1842 |
< |
if SetCursor then |
1843 |
< |
Screen.Cursor := crHourGlass; |
1844 |
< |
try |
1845 |
< |
Buff := GetActiveBuf; |
1846 |
< |
if CanRefresh then |
1847 |
< |
begin |
1848 |
< |
if Buff <> nil then |
1849 |
< |
begin |
1850 |
< |
if (Assigned(FUpdateObject) and (FUpdateObject.RefreshSQL.Text <> '')) then |
1851 |
< |
begin |
1852 |
< |
Qry := TIBSQL.Create(self); |
1853 |
< |
Qry.Database := Database; |
1854 |
< |
Qry.Transaction := Transaction; |
1855 |
< |
Qry.GoToFirstRecordOnExecute := False; |
1856 |
< |
Qry.SQL.Text := FUpdateObject.RefreshSQL.Text; |
1857 |
< |
end |
1858 |
< |
else |
1859 |
< |
Qry := FQRefresh; |
1860 |
< |
SetInternalSQLParams(Qry, Buff); |
1861 |
< |
Qry.ExecQuery; |
1862 |
< |
try |
1863 |
< |
if (Qry.SQLType = SQLExecProcedure) or |
1864 |
< |
(Qry.Next <> nil) then |
1865 |
< |
begin |
1866 |
< |
ofs := PRecordData(Buff)^.rdSavedOffset; |
1867 |
< |
FetchCurrentRecordToBuffer(Qry, |
1868 |
< |
PRecordData(Buff)^.rdRecordNumber, |
1869 |
< |
Buff); |
1870 |
< |
if FCachedUpdates and (ofs <> $FFFFFFFF) then |
1871 |
< |
begin |
1872 |
< |
PRecordData(Buff)^.rdSavedOffset := ofs; |
1873 |
< |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff); |
1874 |
< |
SaveOldBuffer(Buff); |
1875 |
< |
end; |
1876 |
< |
end; |
1877 |
< |
finally |
1878 |
< |
Qry.Close; |
1879 |
< |
end; |
1880 |
< |
if Qry <> FQRefresh then |
1881 |
< |
Qry.Free; |
1882 |
< |
end |
1883 |
< |
end |
1884 |
< |
else |
1885 |
< |
IBError(ibxeCannotRefresh, [nil]); |
1886 |
< |
finally |
1887 |
< |
if SetCursor and (Screen.Cursor = crHourGlass) then |
1888 |
< |
Screen.Cursor := crDefault; |
1889 |
< |
end; |
1890 |
< |
end; |
1891 |
< |
|
1892 |
< |
procedure TIBCustomDataSet.InternalRevertRecord(RecordNumber: Integer); |
1893 |
< |
var |
1894 |
< |
NewBuffer, OldBuffer: PRecordData; |
1895 |
< |
|
1896 |
< |
begin |
1897 |
< |
NewBuffer := nil; |
1898 |
< |
OldBuffer := nil; |
1899 |
< |
NewBuffer := PRecordData(AllocRecordBuffer); |
1900 |
< |
OldBuffer := PRecordData(AllocRecordBuffer); |
1901 |
< |
try |
1902 |
< |
ReadRecordCache(RecordNumber, PChar(NewBuffer), False); |
1903 |
< |
ReadRecordCache(RecordNumber, PChar(OldBuffer), True); |
1904 |
< |
case NewBuffer^.rdCachedUpdateStatus of |
1905 |
< |
cusInserted: |
1906 |
< |
begin |
1907 |
< |
NewBuffer^.rdCachedUpdateStatus := cusUninserted; |
1908 |
< |
Inc(FDeletedRecords); |
1909 |
< |
end; |
1910 |
< |
cusModified, |
1911 |
< |
cusDeleted: |
1912 |
< |
begin |
1913 |
< |
if (NewBuffer^.rdCachedUpdateStatus = cusDeleted) then |
1914 |
< |
Dec(FDeletedRecords); |
1915 |
< |
CopyRecordBuffer(OldBuffer, NewBuffer); |
1916 |
< |
end; |
1917 |
< |
end; |
1918 |
< |
|
1919 |
< |
if State in dsEditModes then |
1920 |
< |
Cancel; |
1921 |
< |
|
1922 |
< |
WriteRecordCache(RecordNumber, PChar(NewBuffer)); |
1923 |
< |
|
1924 |
< |
if (NewBuffer^.rdCachedUpdateStatus = cusUninserted ) then |
1925 |
< |
ReSync([]); |
1926 |
< |
finally |
1927 |
< |
FreeRecordBuffer(PChar(NewBuffer)); |
1928 |
< |
FreeRecordBuffer(PChar(OldBuffer)); |
1929 |
< |
end; |
1930 |
< |
end; |
1931 |
< |
|
1932 |
< |
{ A visible record is one that is not truly deleted, |
1933 |
< |
and it is also listed in the FUpdateRecordTypes set } |
1934 |
< |
|
1935 |
< |
function TIBCustomDataSet.IsVisible(Buffer: PChar): Boolean; |
1936 |
< |
begin |
1937 |
< |
result := True; |
1938 |
< |
if not (State = dsOldValue) then |
1939 |
< |
result := |
1940 |
< |
(PRecordData(Buffer)^.rdCachedUpdateStatus in FUpdateRecordTypes) and |
1941 |
< |
(not ((PRecordData(Buffer)^.rdCachedUpdateStatus = cusUnmodified) and |
1942 |
< |
(PRecordData(Buffer)^.rdUpdateStatus = usDeleted))); |
1943 |
< |
end; |
1944 |
< |
|
1945 |
< |
|
1946 |
< |
function TIBCustomDataSet.LocateNext(const KeyFields: string; |
1947 |
< |
const KeyValues: Variant; Options: TLocateOptions): Boolean; |
1948 |
< |
begin |
1949 |
< |
DisableControls; |
1950 |
< |
try |
1951 |
< |
result := InternalLocate(KeyFields, KeyValues, Options); |
1952 |
< |
finally |
1953 |
< |
EnableControls; |
1954 |
< |
end; |
1955 |
< |
end; |
1956 |
< |
|
1957 |
< |
procedure TIBCustomDataSet.InternalPrepare; |
1958 |
< |
var |
1959 |
< |
SetCursor: Boolean; |
1960 |
< |
DidActivate: Boolean; |
1961 |
< |
begin |
1962 |
< |
if FInternalPrepared then |
1963 |
< |
Exit; |
1964 |
< |
DidActivate := False; |
1965 |
< |
if Assigned(Database) and not Database.SQLHourGlass then |
1966 |
< |
SetCursor := False |
1967 |
< |
else |
1968 |
< |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
1969 |
< |
if SetCursor then |
1970 |
< |
Screen.Cursor := crHourGlass; |
1971 |
< |
try |
1972 |
< |
ActivateConnection; |
1973 |
< |
DidActivate := ActivateTransaction; |
1974 |
< |
FBase.CheckDatabase; |
1975 |
< |
FBase.CheckTransaction; |
1976 |
< |
if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then |
1977 |
< |
FQSelect.SQL.Text := FParser.SQLText; |
1978 |
< |
// writeln( FQSelect.SQL.Text); |
1979 |
< |
if FQSelect.SQL.Text <> '' then |
1980 |
< |
begin |
1981 |
< |
if not FQSelect.Prepared then |
1982 |
< |
begin |
1983 |
< |
FQSelect.GenerateParamNames := FGenerateParamNames; |
1984 |
< |
FQSelect.ParamCheck := ParamCheck; |
1985 |
< |
FQSelect.Prepare; |
1986 |
< |
end; |
1987 |
< |
FQDelete.GenerateParamNames := FGenerateParamNames; |
1988 |
< |
if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then |
1989 |
< |
FQDelete.Prepare; |
1990 |
< |
FQInsert.GenerateParamNames := FGenerateParamNames; |
1991 |
< |
if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then |
1992 |
< |
FQInsert.Prepare; |
1993 |
< |
FQRefresh.GenerateParamNames := FGenerateParamNames; |
1994 |
< |
if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then |
1995 |
< |
FQRefresh.Prepare; |
1996 |
< |
FQModify.GenerateParamNames := FGenerateParamNames; |
1997 |
< |
if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then |
1998 |
< |
FQModify.Prepare; |
1999 |
< |
FInternalPrepared := True; |
2000 |
< |
InternalInitFieldDefs; |
2001 |
< |
end else |
2002 |
< |
IBError(ibxeEmptyQuery, [nil]); |
2003 |
< |
finally |
2004 |
< |
if DidActivate then |
2005 |
< |
DeactivateTransaction; |
2006 |
< |
if SetCursor and (Screen.Cursor = crHourGlass) then |
2007 |
< |
Screen.Cursor := crDefault; |
2008 |
< |
end; |
2009 |
< |
end; |
2010 |
< |
|
2011 |
< |
procedure TIBCustomDataSet.RecordModified(Value: Boolean); |
2012 |
< |
begin |
2013 |
< |
SetModified(Value); |
2014 |
< |
end; |
2015 |
< |
|
2016 |
< |
procedure TIBCustomDataSet.RevertRecord; |
2017 |
< |
var |
2018 |
< |
Buff: PRecordData; |
2019 |
< |
begin |
2020 |
< |
if FCachedUpdates and FUpdatesPending then |
2021 |
< |
begin |
2022 |
< |
Buff := PRecordData(GetActiveBuf); |
2023 |
< |
InternalRevertRecord(Buff^.rdRecordNumber); |
2024 |
< |
ReadRecordCache(Buff^.rdRecordNumber, PChar(Buff), False); |
2025 |
< |
DataEvent(deRecordChange, 0); |
2026 |
< |
end; |
2027 |
< |
end; |
2028 |
< |
|
2029 |
< |
procedure TIBCustomDataSet.SaveOldBuffer(Buffer: PChar); |
2030 |
< |
var |
2031 |
< |
OldBuffer: Pointer; |
2032 |
< |
procedure CopyOldBuffer; |
2033 |
< |
begin |
2034 |
< |
CopyRecordBuffer(Buffer, OldBuffer); |
2035 |
< |
if BlobFieldCount > 0 then |
2036 |
< |
FillChar(PChar(OldBuffer)[FBlobCacheOffset], BlobFieldCount * SizeOf(TIBBlobStream), |
2037 |
< |
0); |
2038 |
< |
end; |
2039 |
< |
|
2040 |
< |
begin |
2041 |
< |
if (Buffer <> nil) and (PRecordData(Buffer)^.rdRecordNumber >= 0) then |
2042 |
< |
begin |
2043 |
< |
OldBuffer := AllocRecordBuffer; |
2044 |
< |
try |
2045 |
< |
if (PRecordData(Buffer)^.rdSavedOffset = $FFFFFFFF) then |
2046 |
< |
begin |
2047 |
< |
PRecordData(Buffer)^.rdSavedOffset := AdjustPosition(FOldBufferCache, 0, |
2048 |
< |
FILE_END); |
2049 |
< |
CopyOldBuffer; |
2050 |
< |
WriteCache(FOldBufferCache, 0, FILE_CURRENT, OldBuffer); |
2051 |
< |
WriteCache(FBufferCache, PRecordData(Buffer)^.rdRecordNumber * FRecordBufferSize, |
2052 |
< |
FILE_BEGIN, Buffer); |
2053 |
< |
end |
2054 |
< |
else begin |
2055 |
< |
CopyOldBuffer; |
2056 |
< |
WriteCache(FOldBufferCache, PRecordData(Buffer)^.rdSavedOffset, FILE_BEGIN, |
2057 |
< |
OldBuffer); |
2058 |
< |
end; |
2059 |
< |
finally |
2060 |
< |
FreeRecordBuffer(PChar(OldBuffer)); |
2061 |
< |
end; |
2062 |
< |
end; |
2063 |
< |
end; |
2064 |
< |
|
2065 |
< |
procedure TIBCustomDataSet.SetBufferChunks(Value: Integer); |
2066 |
< |
begin |
2067 |
< |
if (Value <= 0) then |
2068 |
< |
FBufferChunks := BufferCacheSize |
2069 |
< |
else |
2070 |
< |
FBufferChunks := Value; |
2071 |
< |
end; |
2072 |
< |
|
2073 |
< |
procedure TIBCustomDataSet.SetDatabase(Value: TIBDatabase); |
2074 |
< |
begin |
2075 |
< |
if (FBase.Database <> Value) then |
2076 |
< |
begin |
2077 |
< |
CheckDatasetClosed; |
2078 |
< |
FBase.Database := Value; |
2079 |
< |
FQDelete.Database := Value; |
2080 |
< |
FQInsert.Database := Value; |
2081 |
< |
FQRefresh.Database := Value; |
2082 |
< |
FQSelect.Database := Value; |
2083 |
< |
FQModify.Database := Value; |
2084 |
< |
end; |
2085 |
< |
end; |
2086 |
< |
|
2087 |
< |
procedure TIBCustomDataSet.SetDeleteSQL(Value: TStrings); |
2088 |
< |
begin |
2089 |
< |
if FQDelete.SQL.Text <> Value.Text then |
2090 |
< |
begin |
2091 |
< |
Disconnect; |
2092 |
< |
FQDelete.SQL.Assign(Value); |
2093 |
< |
end; |
2094 |
< |
end; |
2095 |
< |
|
2096 |
< |
procedure TIBCustomDataSet.SetInsertSQL(Value: TStrings); |
2097 |
< |
begin |
2098 |
< |
if FQInsert.SQL.Text <> Value.Text then |
2099 |
< |
begin |
2100 |
< |
Disconnect; |
2101 |
< |
FQInsert.SQL.Assign(Value); |
2102 |
< |
end; |
2103 |
< |
end; |
2104 |
< |
|
2105 |
< |
procedure TIBCustomDataSet.SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer); |
2106 |
< |
var |
2107 |
< |
i, j: Integer; |
2108 |
< |
cr, data: PChar; |
2109 |
< |
fn, st: string; |
2110 |
< |
OldBuffer: Pointer; |
2111 |
< |
ts: TTimeStamp; |
2112 |
< |
begin |
2113 |
< |
if (Buffer = nil) then |
2114 |
< |
IBError(ibxeBufferNotSet, [nil]); |
2115 |
< |
if (not FInternalPrepared) then |
2116 |
< |
InternalPrepare; |
2117 |
< |
OldBuffer := nil; |
2118 |
< |
try |
2119 |
< |
for i := 0 to Qry.Params.Count - 1 do |
2120 |
< |
begin |
2121 |
< |
fn := Qry.Params[i].Name; |
2122 |
< |
if (Pos('OLD_', fn) = 1) then {mbcs ok} |
2123 |
< |
begin |
2124 |
< |
fn := Copy(fn, 5, Length(fn)); |
2125 |
< |
if not Assigned(OldBuffer) then |
2126 |
< |
begin |
2127 |
< |
OldBuffer := AllocRecordBuffer; |
2128 |
< |
ReadRecordCache(PRecordData(Buffer)^.rdRecordNumber, OldBuffer, True); |
2129 |
< |
end; |
2130 |
< |
cr := OldBuffer; |
2131 |
< |
end |
2132 |
< |
else if (Pos('NEW_', fn) = 1) then {mbcs ok} |
2133 |
< |
begin |
2134 |
< |
fn := Copy(fn, 5, Length(fn)); |
2135 |
< |
cr := Buffer; |
2136 |
< |
end |
2137 |
< |
else |
2138 |
< |
cr := Buffer; |
2139 |
< |
j := FQSelect.FieldIndex[fn] + 1; |
2140 |
< |
if (j > 0) then |
2141 |
< |
with PRecordData(cr)^ do |
2142 |
< |
begin |
2143 |
< |
if Qry.Params[i].name = 'IBX_INTERNAL_DBKEY' then {do not localize} |
2144 |
< |
begin |
2145 |
< |
PIBDBKey(Qry.Params[i].AsPointer)^ := rdDBKey; |
2146 |
< |
continue; |
2147 |
< |
end; |
2148 |
< |
if rdFields[j].fdIsNull then |
2149 |
< |
Qry.Params[i].IsNull := True |
2150 |
< |
else begin |
2151 |
< |
Qry.Params[i].IsNull := False; |
2152 |
< |
data := cr + rdFields[j].fdDataOfs; |
2153 |
< |
case rdFields[j].fdDataType of |
2154 |
< |
SQL_TEXT, SQL_VARYING: |
2155 |
< |
begin |
2156 |
< |
SetString(st, data, rdFields[j].fdDataLength); |
2157 |
< |
Qry.Params[i].AsString := st; |
2158 |
< |
end; |
2159 |
< |
SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT: |
2160 |
< |
Qry.Params[i].AsDouble := PDouble(data)^; |
2161 |
< |
SQL_SHORT, SQL_LONG: |
2162 |
< |
begin |
2163 |
< |
if rdFields[j].fdDataScale = 0 then |
2164 |
< |
Qry.Params[i].AsLong := PLong(data)^ |
2165 |
< |
else if rdFields[j].fdDataScale >= (-4) then |
2166 |
< |
Qry.Params[i].AsCurrency := PCurrency(data)^ |
2167 |
< |
else |
2168 |
< |
Qry.Params[i].AsDouble := PDouble(data)^; |
2169 |
< |
end; |
2170 |
< |
SQL_INT64: |
2171 |
< |
begin |
2172 |
< |
if rdFields[j].fdDataScale = 0 then |
2173 |
< |
Qry.Params[i].AsInt64 := PInt64(data)^ |
2174 |
< |
else if rdFields[j].fdDataScale >= (-4) then |
2175 |
< |
Qry.Params[i].AsCurrency := PCurrency(data)^ |
2176 |
< |
else |
2177 |
< |
Qry.Params[i].AsDouble := PDouble(data)^; |
2178 |
< |
end; |
2179 |
< |
SQL_BLOB, SQL_ARRAY, SQL_QUAD: |
2180 |
< |
Qry.Params[i].AsQuad := PISC_QUAD(data)^; |
2181 |
< |
SQL_TYPE_DATE: |
2182 |
< |
begin |
2183 |
< |
ts.Date := PInt(data)^; |
2184 |
< |
ts.Time := 0; |
2185 |
< |
Qry.Params[i].AsDate := |
2186 |
< |
TimeStampToDateTime(ts); |
2187 |
< |
end; |
2188 |
< |
SQL_TYPE_TIME: |
2189 |
< |
begin |
2190 |
< |
ts.Date := 0; |
2191 |
< |
ts.Time := PInt(data)^; |
2192 |
< |
Qry.Params[i].AsTime := |
2193 |
< |
TimeStampToDateTime(ts); |
2194 |
< |
end; |
2195 |
< |
SQL_TIMESTAMP: |
2196 |
< |
Qry.Params[i].AsDateTime := |
2197 |
< |
TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^))); |
2198 |
< |
SQL_BOOLEAN: |
2199 |
< |
Qry.Params[i].AsBoolean := PWordBool(data)^; |
2200 |
< |
end; |
2201 |
< |
end; |
2202 |
< |
end; |
2203 |
< |
end; |
2204 |
< |
finally |
2205 |
< |
if (OldBuffer <> nil) then |
2206 |
< |
FreeRecordBuffer(PChar(OldBuffer)); |
2207 |
< |
end; |
2208 |
< |
end; |
2209 |
< |
|
2210 |
< |
procedure TIBCustomDataSet.SetRefreshSQL(Value: TStrings); |
2211 |
< |
begin |
2212 |
< |
if FQRefresh.SQL.Text <> Value.Text then |
2213 |
< |
begin |
2214 |
< |
Disconnect; |
2215 |
< |
FQRefresh.SQL.Assign(Value); |
2216 |
< |
end; |
2217 |
< |
end; |
2218 |
< |
|
2219 |
< |
procedure TIBCustomDataSet.SetSelectSQL(Value: TStrings); |
2220 |
< |
begin |
2221 |
< |
if FQSelect.SQL.Text <> Value.Text then |
2222 |
< |
begin |
2223 |
< |
Disconnect; |
2224 |
< |
FQSelect.SQL.Assign(Value); |
2225 |
< |
FBaseSQLSelect.assign(Value); |
2226 |
< |
end; |
2227 |
< |
end; |
2228 |
< |
|
2229 |
< |
procedure TIBCustomDataSet.SetModifySQL(Value: TStrings); |
2230 |
< |
begin |
2231 |
< |
if FQModify.SQL.Text <> Value.Text then |
2232 |
< |
begin |
2233 |
< |
Disconnect; |
2234 |
< |
FQModify.SQL.Assign(Value); |
2235 |
< |
end; |
2236 |
< |
end; |
2237 |
< |
|
2238 |
< |
procedure TIBCustomDataSet.SetTransaction(Value: TIBTransaction); |
2239 |
< |
begin |
2240 |
< |
if (FBase.Transaction <> Value) then |
2241 |
< |
begin |
2242 |
< |
CheckDatasetClosed; |
2243 |
< |
FBase.Transaction := Value; |
2244 |
< |
FQDelete.Transaction := Value; |
2245 |
< |
FQInsert.Transaction := Value; |
2246 |
< |
FQRefresh.Transaction := Value; |
2247 |
< |
FQSelect.Transaction := Value; |
2248 |
< |
FQModify.Transaction := Value; |
2249 |
< |
end; |
2250 |
< |
end; |
2251 |
< |
|
2252 |
< |
procedure TIBCustomDataSet.SetUniDirectional(Value: Boolean); |
2253 |
< |
begin |
2254 |
< |
CheckDatasetClosed; |
2255 |
< |
FUniDirectional := Value; |
2256 |
< |
end; |
2257 |
< |
|
2258 |
< |
procedure TIBCustomDataSet.SetUpdateRecordTypes(Value: TIBUpdateRecordTypes); |
2259 |
< |
begin |
2260 |
< |
FUpdateRecordTypes := Value; |
2261 |
< |
if Active then |
2262 |
< |
First; |
2263 |
< |
end; |
2264 |
< |
|
2265 |
< |
procedure TIBCustomDataSet.RefreshParams; |
2266 |
< |
var |
2267 |
< |
DataSet: TDataSet; |
2268 |
< |
begin |
2269 |
< |
DisableControls; |
2270 |
< |
try |
2271 |
< |
if FDataLink.DataSource <> nil then |
2272 |
< |
begin |
2273 |
< |
DataSet := FDataLink.DataSource.DataSet; |
2274 |
< |
if DataSet <> nil then |
2275 |
< |
if DataSet.Active and (DataSet.State <> dsSetKey) then |
2276 |
< |
begin |
2277 |
< |
Close; |
2278 |
< |
Open; |
2279 |
< |
end; |
2280 |
< |
end; |
2281 |
< |
finally |
2282 |
< |
EnableControls; |
2283 |
< |
end; |
2284 |
< |
end; |
2285 |
< |
|
2286 |
< |
|
2287 |
< |
procedure TIBCustomDataSet.SQLChanging(Sender: TObject); |
2288 |
< |
begin |
2289 |
< |
Active := false; |
2290 |
< |
{ if FOpen then |
2291 |
< |
InternalClose;} |
2292 |
< |
if FInternalPrepared then |
2293 |
< |
InternalUnPrepare; |
2294 |
< |
FieldDefs.Clear; |
2295 |
< |
FieldDefs.Updated := false; |
2296 |
< |
end; |
2297 |
< |
|
2298 |
< |
{ I can "undelete" uninserted records (make them "inserted" again). |
2299 |
< |
I can "undelete" cached deleted (the deletion hasn't yet occurred) } |
2300 |
< |
procedure TIBCustomDataSet.Undelete; |
2301 |
< |
var |
2302 |
< |
Buff: PRecordData; |
2303 |
< |
begin |
2304 |
< |
CheckActive; |
2305 |
< |
Buff := PRecordData(GetActiveBuf); |
2306 |
< |
with Buff^ do |
2307 |
< |
begin |
2308 |
< |
if rdCachedUpdateStatus = cusUninserted then |
2309 |
< |
begin |
2310 |
< |
rdCachedUpdateStatus := cusInserted; |
2311 |
< |
Dec(FDeletedRecords); |
2312 |
< |
end |
2313 |
< |
else if (rdUpdateStatus = usDeleted) and |
2314 |
< |
(rdCachedUpdateStatus = cusDeleted) then |
2315 |
< |
begin |
2316 |
< |
rdCachedUpdateStatus := cusUnmodified; |
2317 |
< |
rdUpdateStatus := usUnmodified; |
2318 |
< |
Dec(FDeletedRecords); |
2319 |
< |
end; |
2320 |
< |
WriteRecordCache(rdRecordNumber, PChar(Buff)); |
2321 |
< |
end; |
2322 |
< |
end; |
2323 |
< |
|
2324 |
< |
function TIBCustomDataSet.UpdateStatus: TUpdateStatus; |
2325 |
< |
begin |
2326 |
< |
if Active then |
2327 |
< |
if GetActiveBuf <> nil then |
2328 |
< |
result := PRecordData(GetActiveBuf)^.rdUpdateStatus |
2329 |
< |
else |
2330 |
< |
result := usUnmodified |
2331 |
< |
else |
2332 |
< |
result := usUnmodified; |
2333 |
< |
end; |
2334 |
< |
|
2335 |
< |
function TIBCustomDataSet.IsSequenced: Boolean; |
2336 |
< |
begin |
2337 |
< |
Result := Assigned( FQSelect ) and FQSelect.EOF; |
2338 |
< |
end; |
2339 |
< |
|
2340 |
< |
function TIBCustomDataSet.ParamByName(ParamName: String): TIBXSQLVAR; |
2341 |
< |
begin |
2342 |
< |
ActivateConnection; |
2343 |
< |
ActivateTransaction; |
2344 |
< |
if not FInternalPrepared then |
2345 |
< |
InternalPrepare; |
2346 |
< |
Result := Params.ByName(ParamName); |
2347 |
< |
end; |
2348 |
< |
|
2349 |
< |
{Beware: the parameter FCache is used as an identifier to determine which |
2350 |
< |
cache is being operated on and is not referenced in the computation. |
2351 |
< |
The result is an adjusted offset into the identified cache, either the |
2352 |
< |
Buffer Cache or the old Buffer Cache.} |
2353 |
< |
|
2354 |
< |
function TIBCustomDataSet.AdjustPosition(FCache: PChar; Offset: DWORD; |
2355 |
< |
Origin: Integer): DWORD; |
2356 |
< |
var |
2357 |
< |
OldCacheSize: Integer; |
2358 |
< |
begin |
2359 |
< |
if (FCache = FBufferCache) then |
2360 |
< |
begin |
2361 |
< |
case Origin of |
2362 |
< |
FILE_BEGIN: FBPos := Offset; |
2363 |
< |
FILE_CURRENT: FBPos := FBPos + Offset; |
2364 |
< |
FILE_END: FBPos := DWORD(FBEnd) + Offset; |
2365 |
< |
end; |
2366 |
< |
OldCacheSize := FCacheSize; |
2367 |
< |
while (FBPos >= DWORD(FCacheSize)) do |
2368 |
< |
Inc(FCacheSize, FBufferChunkSize); |
2369 |
< |
if FCacheSize > OldCacheSize then |
2370 |
< |
IBAlloc(FBufferCache, FCacheSize, FCacheSize); |
2371 |
< |
result := FBPos; |
2372 |
< |
end |
2373 |
< |
else begin |
2374 |
< |
case Origin of |
2375 |
< |
FILE_BEGIN: FOBPos := Offset; |
2376 |
< |
FILE_CURRENT: FOBPos := FOBPos + Offset; |
2377 |
< |
FILE_END: FOBPos := DWORD(FOBEnd) + Offset; |
2378 |
< |
end; |
2379 |
< |
OldCacheSize := FOldCacheSize; |
2380 |
< |
while (FBPos >= DWORD(FOldCacheSize)) do |
2381 |
< |
Inc(FOldCacheSize, FBufferChunkSize); |
2382 |
< |
if FOldCacheSize > OldCacheSize then |
2383 |
< |
IBAlloc(FOldBufferCache, FOldCacheSize, FOldCacheSize); |
2384 |
< |
result := FOBPos; |
2385 |
< |
end; |
2386 |
< |
end; |
2387 |
< |
|
2388 |
< |
procedure TIBCustomDataSet.ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer; |
2389 |
< |
Buffer: PChar); |
2390 |
< |
var |
2391 |
< |
pCache: PChar; |
2392 |
< |
AdjustedOffset: DWORD; |
2393 |
< |
bOld: Boolean; |
2394 |
< |
begin |
2395 |
< |
bOld := (FCache = FOldBufferCache); |
2396 |
< |
AdjustedOffset := AdjustPosition(FCache, Offset, Origin); |
2397 |
< |
if not bOld then |
2398 |
< |
pCache := FBufferCache + AdjustedOffset |
2399 |
< |
else |
2400 |
< |
pCache := FOldBufferCache + AdjustedOffset; |
2401 |
< |
Move(pCache^, Buffer^, DWORD(FRecordBufferSize)); |
2402 |
< |
AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT); |
2403 |
< |
end; |
2404 |
< |
|
2405 |
< |
procedure TIBCustomDataSet.ReadRecordCache(RecordNumber: Integer; Buffer: PChar; |
2406 |
< |
ReadOldBuffer: Boolean); |
2407 |
< |
begin |
2408 |
< |
if FUniDirectional then |
2409 |
< |
RecordNumber := RecordNumber mod UniCache; |
2410 |
< |
if (ReadOldBuffer) then |
2411 |
< |
begin |
2412 |
< |
ReadRecordCache(RecordNumber, Buffer, False); |
2413 |
< |
if FCachedUpdates and |
2414 |
< |
(PRecordData(Buffer)^.rdSavedOffset <> $FFFFFFFF) then |
2415 |
< |
ReadCache(FOldBufferCache, PRecordData(Buffer)^.rdSavedOffset, FILE_BEGIN, |
2416 |
< |
Buffer) |
2417 |
< |
else |
2418 |
< |
if ReadOldBuffer and |
2419 |
< |
(PRecordData(FOldBuffer)^.rdRecordNumber = RecordNumber) then |
2420 |
< |
CopyRecordBuffer( FOldBuffer, Buffer ) |
2421 |
< |
end |
2422 |
< |
else |
2423 |
< |
ReadCache(FBufferCache, RecordNumber * FRecordBufferSize, FILE_BEGIN, Buffer); |
2424 |
< |
end; |
2425 |
< |
|
2426 |
< |
procedure TIBCustomDataSet.WriteCache(FCache: PChar; Offset: DWORD; Origin: Integer; |
2427 |
< |
Buffer: PChar); |
2428 |
< |
var |
2429 |
< |
pCache: PChar; |
2430 |
< |
AdjustedOffset: DWORD; |
2431 |
< |
bOld: Boolean; |
2432 |
< |
dwEnd: DWORD; |
2433 |
< |
begin |
2434 |
< |
bOld := (FCache = FOldBufferCache); |
2435 |
< |
AdjustedOffset := AdjustPosition(FCache, Offset, Origin); |
2436 |
< |
if not bOld then |
2437 |
< |
pCache := FBufferCache + AdjustedOffset |
2438 |
< |
else |
2439 |
< |
pCache := FOldBufferCache + AdjustedOffset; |
2440 |
< |
Move(Buffer^, pCache^, FRecordBufferSize); |
2441 |
< |
dwEnd := AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT); |
2442 |
< |
if not bOld then |
2443 |
< |
begin |
2444 |
< |
if (dwEnd > FBEnd) then |
2445 |
< |
FBEnd := dwEnd; |
2446 |
< |
end |
2447 |
< |
else begin |
2448 |
< |
if (dwEnd > FOBEnd) then |
2449 |
< |
FOBEnd := dwEnd; |
2450 |
< |
end; |
2451 |
< |
end; |
2452 |
< |
|
2453 |
< |
procedure TIBCustomDataSet.WriteRecordCache(RecordNumber: Integer; Buffer: PChar); |
2454 |
< |
begin |
2455 |
< |
if RecordNumber >= 0 then |
2456 |
< |
begin |
2457 |
< |
if FUniDirectional then |
2458 |
< |
RecordNumber := RecordNumber mod UniCache; |
2459 |
< |
WriteCache(FBufferCache, RecordNumber * FRecordBufferSize, FILE_BEGIN, Buffer); |
2460 |
< |
end; |
2461 |
< |
end; |
2462 |
< |
|
2463 |
< |
function TIBCustomDataSet.AllocRecordBuffer: PChar; |
2464 |
< |
begin |
2465 |
< |
result := nil; |
2466 |
< |
IBAlloc(result, FRecordBufferSize, FRecordBufferSize); |
2467 |
< |
Move(FModelBuffer^, result^, FRecordBufferSize); |
2468 |
< |
end; |
2469 |
< |
|
2470 |
< |
function TIBCustomDataSet.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; |
2471 |
< |
var |
2472 |
< |
pb: PBlobDataArray; |
2473 |
< |
fs: TIBBlobStream; |
2474 |
< |
Buff: PChar; |
2475 |
< |
bTr, bDB: Boolean; |
2476 |
< |
begin |
2477 |
< |
Buff := GetActiveBuf; |
2478 |
< |
if Buff = nil then |
2479 |
< |
begin |
2480 |
< |
fs := TIBBlobStream.Create; |
2481 |
< |
fs.Mode := bmReadWrite; |
2482 |
< |
FBlobStreamList.Add(Pointer(fs)); |
2483 |
< |
result := TIBDSBlobStream.Create(Field, fs, Mode); |
2484 |
< |
exit; |
2485 |
< |
end; |
2486 |
< |
pb := PBlobDataArray(Buff + FBlobCacheOffset); |
2487 |
< |
if pb^[Field.Offset] = nil then |
2488 |
< |
begin |
2489 |
< |
AdjustRecordOnInsert(Buff); |
2490 |
< |
pb^[Field.Offset] := TIBBlobStream.Create; |
2491 |
< |
fs := pb^[Field.Offset]; |
2492 |
< |
FBlobStreamList.Add(Pointer(fs)); |
2493 |
< |
fs.Mode := bmReadWrite; |
2494 |
< |
fs.Database := Database; |
2495 |
< |
fs.Transaction := Transaction; |
2496 |
< |
fs.BlobID := |
2497 |
< |
PISC_QUAD(@Buff[PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^; |
2498 |
< |
if (CachedUpdates) then |
2499 |
< |
begin |
2500 |
< |
bTr := not Transaction.InTransaction; |
2501 |
< |
bDB := not Database.Connected; |
2502 |
< |
if bDB then |
2503 |
< |
Database.Open; |
2504 |
< |
if bTr then |
2505 |
< |
Transaction.StartTransaction; |
2506 |
< |
fs.Seek(0, soFromBeginning); |
2507 |
< |
if bTr then |
2508 |
< |
Transaction.Commit; |
2509 |
< |
if bDB then |
2510 |
< |
Database.Close; |
2511 |
< |
end; |
2512 |
< |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff)); |
2513 |
< |
end else |
2514 |
< |
fs := pb^[Field.Offset]; |
2515 |
< |
result := TIBDSBlobStream.Create(Field, fs, Mode); |
2516 |
< |
end; |
2517 |
< |
|
2518 |
< |
function TIBCustomDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; |
2519 |
< |
const |
2520 |
< |
CMPLess = -1; |
2521 |
< |
CMPEql = 0; |
2522 |
< |
CMPGtr = 1; |
2523 |
< |
RetCodes: array[Boolean, Boolean] of ShortInt = ((2, CMPLess), |
2524 |
< |
(CMPGtr, CMPEql)); |
2525 |
< |
begin |
2526 |
< |
result := RetCodes[Bookmark1 = nil, Bookmark2 = nil]; |
2527 |
< |
|
2528 |
< |
if Result = 2 then |
2529 |
< |
begin |
2530 |
< |
if PInteger(Bookmark1)^ < PInteger(Bookmark2)^ then |
2531 |
< |
Result := CMPLess |
2532 |
< |
else |
2533 |
< |
if PInteger(Bookmark1)^ > PInteger(Bookmark2)^ then |
2534 |
< |
Result := CMPGtr |
2535 |
< |
else |
2536 |
< |
Result := CMPEql; |
2537 |
< |
end; |
2538 |
< |
end; |
2539 |
< |
|
2540 |
< |
procedure TIBCustomDataSet.DoBeforeDelete; |
2541 |
< |
var |
2542 |
< |
Buff: PRecordData; |
2543 |
< |
begin |
2544 |
< |
if not CanDelete then |
2545 |
< |
IBError(ibxeCannotDelete, [nil]); |
2546 |
< |
Buff := PRecordData(GetActiveBuf); |
2547 |
< |
if FCachedUpdates and |
2548 |
< |
(Buff^.rdCachedUpdateStatus in [cusUnmodified]) then |
2549 |
< |
SaveOldBuffer(PChar(Buff)); |
2550 |
< |
inherited DoBeforeDelete; |
2551 |
< |
end; |
2552 |
< |
|
2553 |
< |
procedure TIBCustomDataSet.DoAfterDelete; |
2554 |
< |
begin |
2555 |
< |
inherited DoAfterDelete; |
2556 |
< |
InternalAutoCommit; |
2557 |
< |
end; |
2558 |
< |
|
2559 |
< |
procedure TIBCustomDataSet.DoBeforeEdit; |
2560 |
< |
var |
2561 |
< |
Buff: PRecordData; |
2562 |
< |
begin |
2563 |
< |
Buff := PRecordData(GetActiveBuf); |
2564 |
< |
if not(CanEdit or (FQModify.SQL.Count <> 0) or |
2565 |
< |
(FCachedUpdates and Assigned(FOnUpdateRecord))) then |
2566 |
< |
IBError(ibxeCannotUpdate, [nil]); |
2567 |
< |
if FCachedUpdates and (Buff^.rdCachedUpdateStatus in [cusUnmodified, cusInserted]) then |
2568 |
< |
SaveOldBuffer(PChar(Buff)); |
2569 |
< |
CopyRecordBuffer(GetActiveBuf, FOldBuffer); |
2570 |
< |
inherited DoBeforeEdit; |
2571 |
< |
end; |
2572 |
< |
|
2573 |
< |
procedure TIBCustomDataSet.DoBeforeInsert; |
2574 |
< |
begin |
2575 |
< |
if not CanInsert then |
2576 |
< |
IBError(ibxeCannotInsert, [nil]); |
2577 |
< |
inherited DoBeforeInsert; |
2578 |
< |
end; |
2579 |
< |
|
2580 |
< |
procedure TIBCustomDataSet.DoAfterInsert; |
2581 |
< |
begin |
2582 |
< |
if GeneratorField.ApplyOnEvent = gaeOnNewRecord then |
2583 |
< |
GeneratorField.Apply; |
2584 |
< |
inherited DoAfterInsert; |
2585 |
< |
end; |
2586 |
< |
|
2587 |
< |
procedure TIBCustomDataSet.DoBeforeOpen; |
2588 |
< |
begin |
2589 |
< |
if assigned(FParser) then |
2590 |
< |
FParser.Reset; |
2591 |
< |
DataEvent(deCheckBrowseMode,1); {Conventional use to report getting ready to prepare} |
2592 |
< |
inherited DoBeforeOpen; |
2593 |
< |
DataEvent(deCheckBrowseMode,2); {Conventional use to report the right time to set parameters} |
2594 |
< |
end; |
2595 |
< |
|
2596 |
< |
procedure TIBCustomDataSet.DoBeforePost; |
2597 |
< |
begin |
2598 |
< |
inherited DoBeforePost; |
2599 |
< |
if (State = dsInsert) and |
2600 |
< |
(GeneratorField.ApplyOnEvent = gaeOnPostRecord) then |
2601 |
< |
GeneratorField.Apply |
2602 |
< |
end; |
2603 |
< |
|
2604 |
< |
procedure TIBCustomDataSet.DoAfterPost; |
2605 |
< |
begin |
2606 |
< |
inherited DoAfterPost; |
2607 |
< |
InternalAutoCommit; |
2608 |
< |
end; |
2609 |
< |
|
2610 |
< |
procedure TIBCustomDataSet.FetchAll; |
2611 |
< |
var |
2612 |
< |
SetCursor: Boolean; |
2613 |
< |
{$IF FPC_FULLVERSION >= 20700 } |
2614 |
< |
CurBookmark: TBookmark; |
2615 |
< |
{$ELSE} |
2616 |
< |
CurBookmark: string; |
2617 |
< |
{$ENDIF} |
2618 |
< |
begin |
2619 |
< |
if Assigned(Database) and not Database.SQLHourGlass then |
2620 |
< |
SetCursor := False |
2621 |
< |
else |
2622 |
< |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
2623 |
< |
if SetCursor then |
2624 |
< |
Screen.Cursor := crHourGlass; |
2625 |
< |
try |
2626 |
< |
if FQSelect.EOF or not FQSelect.Open then |
2627 |
< |
exit; |
2628 |
< |
DisableControls; |
2629 |
< |
try |
2630 |
< |
CurBookmark := Bookmark; |
2631 |
< |
Last; |
2632 |
< |
Bookmark := CurBookmark; |
2633 |
< |
finally |
2634 |
< |
EnableControls; |
2635 |
< |
end; |
2636 |
< |
finally |
2637 |
< |
if SetCursor and (Screen.Cursor = crHourGlass) then |
2638 |
< |
Screen.Cursor := crDefault; |
2639 |
< |
end; |
2640 |
< |
end; |
2641 |
< |
|
2642 |
< |
procedure TIBCustomDataSet.FreeRecordBuffer(var Buffer: PChar); |
2643 |
< |
begin |
2644 |
< |
FreeMem(Buffer); |
2645 |
< |
Buffer := nil; |
2646 |
< |
end; |
2647 |
< |
|
2648 |
< |
procedure TIBCustomDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer); |
2649 |
< |
begin |
2650 |
< |
Move(PRecordData(Buffer)^.rdRecordNumber, Data^, BookmarkSize); |
2651 |
< |
end; |
2652 |
< |
|
2653 |
< |
function TIBCustomDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; |
2654 |
< |
begin |
2655 |
< |
result := PRecordData(Buffer)^.rdBookmarkFlag; |
2656 |
< |
end; |
2657 |
< |
|
2658 |
< |
function TIBCustomDataSet.GetCanModify: Boolean; |
2659 |
< |
begin |
2660 |
< |
result := (FQInsert.SQL.Text <> '') or |
2661 |
< |
(FQModify.SQL.Text <> '') or |
2662 |
< |
(FQDelete.SQL.Text <> '') or |
2663 |
< |
(Assigned(FUpdateObject)); |
2664 |
< |
end; |
2665 |
< |
|
2666 |
< |
function TIBCustomDataSet.GetCurrentRecord(Buffer: PChar): Boolean; |
2667 |
< |
begin |
2668 |
< |
if not IsEmpty and (GetBookmarkFlag(ActiveBuffer) = bfCurrent) then |
2669 |
< |
begin |
2670 |
< |
UpdateCursorPos; |
2671 |
< |
ReadRecordCache(PRecordData(ActiveBuffer)^.rdRecordNumber, Buffer, False); |
2672 |
< |
result := True; |
2673 |
< |
end |
2674 |
< |
else |
2675 |
< |
result := False; |
2676 |
< |
end; |
2677 |
< |
|
2678 |
< |
function TIBCustomDataSet.GetDataSource: TDataSource; |
2679 |
< |
begin |
2680 |
< |
if FDataLink = nil then |
2681 |
< |
result := nil |
2682 |
< |
else |
2683 |
< |
result := FDataLink.DataSource; |
2684 |
< |
end; |
2685 |
< |
|
2686 |
< |
function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string; |
2687 |
< |
begin |
2688 |
< |
Result := FAliasNameMap[FieldNo-1] |
2689 |
< |
end; |
2690 |
< |
|
2691 |
< |
function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef; |
2692 |
< |
var |
2693 |
< |
i: integer; |
2694 |
< |
begin |
2695 |
< |
Result := nil; |
2696 |
< |
for i := 0 to Length(FAliasNameMap) - 1 do |
2697 |
< |
if FAliasNameMap[i] = aliasName then |
2698 |
< |
begin |
2699 |
< |
Result := FieldDefs[i+1]; |
2700 |
< |
Exit |
2701 |
< |
end; |
2702 |
< |
end; |
2703 |
< |
|
2704 |
< |
function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass; |
2705 |
< |
begin |
2706 |
< |
Result := DefaultFieldClasses[FieldType]; |
2707 |
< |
end; |
2708 |
< |
|
2709 |
< |
function TIBCustomDataSet.GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; |
2710 |
< |
begin |
2711 |
< |
result := GetFieldData(FieldByNumber(FieldNo), buffer); |
2712 |
< |
end; |
2713 |
< |
|
2714 |
< |
function TIBCustomDataSet.InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean; |
2715 |
< |
var |
2716 |
< |
Buff, Data: PChar; |
2717 |
< |
CurrentRecord: PRecordData; |
2718 |
< |
begin |
2719 |
< |
result := False; |
2720 |
< |
Buff := GetActiveBuf; |
2721 |
< |
if (Buff = nil) or |
2722 |
< |
(not IsVisible(Buff)) or not assigned(Field.DataSet) then |
2723 |
< |
exit; |
2724 |
< |
{ The intention here is to stuff the buffer with the data for the |
2725 |
< |
referenced field for the current record } |
2726 |
< |
CurrentRecord := PRecordData(Buff); |
2727 |
< |
if (Field.FieldNo < 0) then |
2728 |
< |
begin |
2729 |
< |
Inc(Buff, FRecordSize + Field.Offset); |
2730 |
< |
result := Boolean(Buff[0]); |
2731 |
< |
if result and (Buffer <> nil) then |
2732 |
< |
Move(Buff[1], Buffer^, Field.DataSize); |
2733 |
< |
end |
2734 |
< |
else if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and |
2735 |
< |
(FMappedFieldPosition[Field.FieldNo - 1] <= CurrentRecord^.rdFieldCount) then |
2736 |
< |
begin |
2737 |
< |
result := not CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull; |
2738 |
< |
if result and (Buffer <> nil) then |
2739 |
< |
with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]] do |
2740 |
< |
begin |
2741 |
< |
Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs; |
2742 |
< |
if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then |
2743 |
< |
begin |
2744 |
< |
if fdDataLength <= Field.Size then |
2745 |
< |
begin |
2746 |
< |
Move(Data^, Buffer^, fdDataLength); |
2747 |
< |
PChar(Buffer)[fdDataLength] := #0; |
2748 |
< |
end |
2749 |
< |
else |
2750 |
< |
IBError(ibxeFieldSizeError,[Field.FieldName]) |
2751 |
< |
end |
2752 |
< |
else |
2753 |
< |
Move(Data^, Buffer^, Field.DataSize); |
2754 |
< |
end; |
2755 |
< |
end; |
2756 |
< |
end; |
2757 |
< |
|
2758 |
< |
{ GetRecNo and SetRecNo both operate off of 1-based indexes as |
2759 |
< |
opposed to 0-based indexes. |
2760 |
< |
This is because we want LastRecordNumber/RecordCount = 1 } |
2761 |
< |
|
2762 |
< |
function TIBCustomDataSet.GetRecNo: Integer; |
2763 |
< |
begin |
2764 |
< |
if GetActiveBuf = nil then |
2765 |
< |
result := 0 |
2766 |
< |
else |
2767 |
< |
result := PRecordData(GetActiveBuf)^.rdRecordNumber + 1; |
2768 |
< |
end; |
2769 |
< |
|
2770 |
< |
function TIBCustomDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode; |
2771 |
< |
DoCheck: Boolean): TGetResult; |
2772 |
< |
var |
2773 |
< |
Accept: Boolean; |
2774 |
< |
SaveState: TDataSetState; |
2775 |
< |
begin |
2776 |
< |
Result := grOK; |
2777 |
< |
if Filtered and Assigned(OnFilterRecord) then |
2778 |
< |
begin |
2779 |
< |
Accept := False; |
2780 |
< |
SaveState := SetTempState(dsFilter); |
2781 |
< |
while not Accept do |
2782 |
< |
begin |
2783 |
< |
Result := InternalGetRecord(Buffer, GetMode, DoCheck); |
2784 |
< |
if Result <> grOK then |
2785 |
< |
break; |
2786 |
< |
FFilterBuffer := Buffer; |
2787 |
< |
try |
2788 |
< |
Accept := True; |
2789 |
< |
OnFilterRecord(Self, Accept); |
2790 |
< |
if not Accept and (GetMode = gmCurrent) then |
2791 |
< |
GetMode := gmPrior; |
2792 |
< |
except |
2793 |
< |
// Application.HandleException(Self); |
2794 |
< |
end; |
2795 |
< |
end; |
2796 |
< |
RestoreState(SaveState); |
2797 |
< |
end |
2798 |
< |
else |
2799 |
< |
Result := InternalGetRecord(Buffer, GetMode, DoCheck); |
2800 |
< |
end; |
2801 |
< |
|
2802 |
< |
function TIBCustomDataSet.InternalGetRecord(Buffer: PChar; GetMode: TGetMode; |
2803 |
< |
DoCheck: Boolean): TGetResult; |
2804 |
< |
begin |
2805 |
< |
result := grError; |
2806 |
< |
case GetMode of |
2807 |
< |
gmCurrent: begin |
2808 |
< |
if (FCurrentRecord >= 0) then begin |
2809 |
< |
if FCurrentRecord < FRecordCount then |
2810 |
< |
ReadRecordCache(FCurrentRecord, Buffer, False) |
2811 |
< |
else begin |
2812 |
< |
while (not FQSelect.EOF) and |
2813 |
< |
(FQSelect.Next <> nil) and |
2814 |
< |
(FCurrentRecord >= FRecordCount) do begin |
2815 |
< |
FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer); |
2816 |
< |
Inc(FRecordCount); |
2817 |
< |
end; |
2818 |
< |
FCurrentRecord := FRecordCount - 1; |
2819 |
< |
if (FCurrentRecord >= 0) then |
2820 |
< |
ReadRecordCache(FCurrentRecord, Buffer, False); |
2821 |
< |
end; |
2822 |
< |
result := grOk; |
2823 |
< |
end else |
2824 |
< |
result := grBOF; |
2825 |
< |
end; |
2826 |
< |
gmNext: begin |
2827 |
< |
result := grOk; |
2828 |
< |
if FCurrentRecord = FRecordCount then |
2829 |
< |
result := grEOF |
2830 |
< |
else if FCurrentRecord = FRecordCount - 1 then begin |
2831 |
< |
if (not FQSelect.EOF) then begin |
2832 |
< |
FQSelect.Next; |
2833 |
< |
Inc(FCurrentRecord); |
2834 |
< |
end; |
2835 |
< |
if (FQSelect.EOF) then begin |
2836 |
< |
result := grEOF; |
2837 |
< |
end else begin |
2838 |
< |
Inc(FRecordCount); |
2839 |
< |
FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer); |
2840 |
< |
end; |
2841 |
< |
end else if (FCurrentRecord < FRecordCount) then begin |
2842 |
< |
Inc(FCurrentRecord); |
2843 |
< |
ReadRecordCache(FCurrentRecord, Buffer, False); |
2844 |
< |
end; |
2845 |
< |
end; |
2846 |
< |
else { gmPrior } |
2847 |
< |
begin |
2848 |
< |
if (FCurrentRecord = 0) then begin |
2849 |
< |
Dec(FCurrentRecord); |
2850 |
< |
result := grBOF; |
2851 |
< |
end else if (FCurrentRecord > 0) and |
2852 |
< |
(FCurrentRecord <= FRecordCount) then begin |
2853 |
< |
Dec(FCurrentRecord); |
2854 |
< |
ReadRecordCache(FCurrentRecord, Buffer, False); |
2855 |
< |
result := grOk; |
2856 |
< |
end else if (FCurrentRecord = -1) then |
2857 |
< |
result := grBOF; |
2858 |
< |
end; |
2859 |
< |
end; |
2860 |
< |
if result = grOk then |
2861 |
< |
result := AdjustCurrentRecord(Buffer, GetMode); |
2862 |
< |
if result = grOk then with PRecordData(Buffer)^ do begin |
2863 |
< |
rdBookmarkFlag := bfCurrent; |
2864 |
< |
GetCalcFields(Buffer); |
2865 |
< |
end else if (result = grEOF) then begin |
2866 |
< |
CopyRecordBuffer(FModelBuffer, Buffer); |
2867 |
< |
PRecordData(Buffer)^.rdBookmarkFlag := bfEOF; |
2868 |
< |
end else if (result = grBOF) then begin |
2869 |
< |
CopyRecordBuffer(FModelBuffer, Buffer); |
2870 |
< |
PRecordData(Buffer)^.rdBookmarkFlag := bfBOF; |
2871 |
< |
end else if (result = grError) then begin |
2872 |
< |
CopyRecordBuffer(FModelBuffer, Buffer); |
2873 |
< |
PRecordData(Buffer)^.rdBookmarkFlag := bfEOF; |
2874 |
< |
end;; |
2875 |
< |
end; |
2876 |
< |
|
2877 |
< |
function TIBCustomDataSet.GetRecordCount: Integer; |
2878 |
< |
begin |
2879 |
< |
result := FRecordCount - FDeletedRecords; |
2880 |
< |
end; |
2881 |
< |
|
2882 |
< |
function TIBCustomDataSet.GetRecordSize: Word; |
2883 |
< |
begin |
2884 |
< |
result := FRecordBufferSize; |
2885 |
< |
end; |
2886 |
< |
|
2887 |
< |
procedure TIBCustomDataSet.InternalAutoCommit; |
2888 |
< |
begin |
2889 |
< |
with Transaction do |
2890 |
< |
if InTransaction and (FAutoCommit = acCommitRetaining) then |
2891 |
< |
begin |
2892 |
< |
if CachedUpdates then ApplyUpdates; |
2893 |
< |
CommitRetaining; |
2894 |
< |
end; |
2895 |
< |
end; |
2896 |
< |
|
2897 |
< |
procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean); |
2898 |
< |
begin |
2899 |
< |
CheckEditState; |
2900 |
< |
begin |
2901 |
< |
{ When adding records, we *always* append. |
2902 |
< |
Insertion is just too costly } |
2903 |
< |
AdjustRecordOnInsert(Buffer); |
2904 |
< |
with PRecordData(Buffer)^ do |
2905 |
< |
begin |
2906 |
< |
rdUpdateStatus := usInserted; |
2907 |
< |
rdCachedUpdateStatus := cusInserted; |
2908 |
< |
end; |
2909 |
< |
if not CachedUpdates then |
2910 |
< |
InternalPostRecord(FQInsert, Buffer) |
2911 |
< |
else begin |
2912 |
< |
WriteRecordCache(FCurrentRecord, Buffer); |
2913 |
< |
FUpdatesPending := True; |
2914 |
< |
end; |
2915 |
< |
Inc(FRecordCount); |
2916 |
< |
InternalSetToRecord(Buffer); |
2917 |
< |
end |
2918 |
< |
end; |
2919 |
< |
|
2920 |
< |
procedure TIBCustomDataSet.InternalCancel; |
2921 |
< |
var |
2922 |
< |
Buff: PChar; |
2923 |
< |
CurRec: Integer; |
2924 |
< |
begin |
2925 |
< |
inherited InternalCancel; |
2926 |
< |
Buff := GetActiveBuf; |
2927 |
< |
if Buff <> nil then begin |
2928 |
< |
CurRec := FCurrentRecord; |
2929 |
< |
AdjustRecordOnInsert(Buff); |
2930 |
< |
if (State = dsEdit) then begin |
2931 |
< |
CopyRecordBuffer(FOldBuffer, Buff); |
2932 |
< |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff); |
2933 |
< |
end else begin |
2934 |
< |
CopyRecordBuffer(FModelBuffer, Buff); |
2935 |
< |
PRecordData(Buff)^.rdUpdateStatus := usDeleted; |
2936 |
< |
PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified; |
2937 |
< |
PRecordData(Buff)^.rdBookmarkFlag := bfEOF; |
2938 |
< |
FCurrentRecord := CurRec; |
2939 |
< |
end; |
2940 |
< |
end; |
2941 |
< |
end; |
2942 |
< |
|
2943 |
< |
|
2944 |
< |
procedure TIBCustomDataSet.InternalClose; |
2945 |
< |
begin |
2946 |
< |
if FDidActivate then |
2947 |
< |
DeactivateTransaction; |
2948 |
< |
FQSelect.Close; |
2949 |
< |
ClearBlobCache; |
2950 |
< |
FreeRecordBuffer(FModelBuffer); |
2951 |
< |
FreeRecordBuffer(FOldBuffer); |
2952 |
< |
FCurrentRecord := -1; |
2953 |
< |
FOpen := False; |
2954 |
< |
FRecordCount := 0; |
2955 |
< |
FDeletedRecords := 0; |
2956 |
< |
FRecordSize := 0; |
2957 |
< |
FBPos := 0; |
2958 |
< |
FOBPos := 0; |
2959 |
< |
FCacheSize := 0; |
2960 |
< |
FOldCacheSize := 0; |
2961 |
< |
FBEnd := 0; |
2962 |
< |
FOBEnd := 0; |
2963 |
< |
FreeMem(FBufferCache); |
2964 |
< |
FBufferCache := nil; |
2965 |
< |
FreeMem(FOldBufferCache); |
2966 |
< |
FOldBufferCache := nil; |
2967 |
< |
BindFields(False); |
2968 |
< |
if DefaultFields then DestroyFields; |
2969 |
< |
end; |
2970 |
< |
|
2971 |
< |
procedure TIBCustomDataSet.InternalDelete; |
2972 |
< |
var |
2973 |
< |
Buff: PChar; |
2974 |
< |
SetCursor: Boolean; |
2975 |
< |
begin |
2976 |
< |
if Assigned(Database) and not Database.SQLHourGlass then |
2977 |
< |
SetCursor := False |
2978 |
< |
else |
2979 |
< |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
2980 |
< |
if SetCursor then |
2981 |
< |
Screen.Cursor := crHourGlass; |
2982 |
< |
try |
2983 |
< |
Buff := GetActiveBuf; |
2984 |
< |
if CanDelete then |
2985 |
< |
begin |
2986 |
< |
if not CachedUpdates then |
2987 |
< |
InternalDeleteRecord(FQDelete, Buff) |
2988 |
< |
else |
2989 |
< |
begin |
2990 |
< |
with PRecordData(Buff)^ do |
2991 |
< |
begin |
2992 |
< |
if rdCachedUpdateStatus = cusInserted then |
2993 |
< |
rdCachedUpdateStatus := cusUninserted |
2994 |
< |
else begin |
2995 |
< |
rdUpdateStatus := usDeleted; |
2996 |
< |
rdCachedUpdateStatus := cusDeleted; |
2997 |
< |
end; |
2998 |
< |
end; |
2999 |
< |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff); |
3000 |
< |
end; |
3001 |
< |
Inc(FDeletedRecords); |
3002 |
< |
FUpdatesPending := True; |
3003 |
< |
end else |
3004 |
< |
IBError(ibxeCannotDelete, [nil]); |
3005 |
< |
finally |
3006 |
< |
if SetCursor and (Screen.Cursor = crHourGlass) then |
3007 |
< |
Screen.Cursor := crDefault; |
3008 |
< |
end; |
3009 |
< |
end; |
3010 |
< |
|
3011 |
< |
procedure TIBCustomDataSet.InternalFirst; |
3012 |
< |
begin |
3013 |
< |
FCurrentRecord := -1; |
3014 |
< |
end; |
3015 |
< |
|
3016 |
< |
procedure TIBCustomDataSet.InternalGotoBookmark(Bookmark: Pointer); |
3017 |
< |
begin |
3018 |
< |
FCurrentRecord := PInteger(Bookmark)^; |
3019 |
< |
end; |
3020 |
< |
|
3021 |
< |
procedure TIBCustomDataSet.InternalHandleException; |
3022 |
< |
begin |
3023 |
< |
Application.HandleException(Self) |
3024 |
< |
end; |
3025 |
< |
|
3026 |
< |
procedure TIBCustomDataSet.InternalInitFieldDefs; |
3027 |
< |
begin |
3028 |
< |
if not InternalPrepared then |
3029 |
< |
begin |
3030 |
< |
InternalPrepare; |
3031 |
< |
exit; |
3032 |
< |
end; |
3033 |
< |
FieldDefsFromQuery(FQSelect); |
3034 |
< |
end; |
3035 |
< |
|
3036 |
< |
procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL); |
3037 |
< |
const |
3038 |
< |
DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize} |
3039 |
< |
'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize} |
3040 |
< |
'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize} |
3041 |
< |
'where R.RDB$RELATION_NAME = :RELATION ' + {do not localize} |
3042 |
< |
'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize} |
3043 |
< |
'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize} |
3044 |
< |
' (not F.RDB$DEFAULT_VALUE is NULL)) '; {do not localize} |
3045 |
< |
var |
3046 |
< |
FieldType: TFieldType; |
3047 |
< |
FieldSize: Word; |
3048 |
< |
FieldNullable : Boolean; |
3049 |
< |
i, FieldPosition, FieldPrecision: Integer; |
3050 |
< |
FieldAliasName, DBAliasName: string; |
3051 |
< |
RelationName, FieldName: string; |
3052 |
< |
Query : TIBSQL; |
3053 |
< |
FieldIndex: Integer; |
3054 |
< |
FRelationNodes : TRelationNode; |
3055 |
< |
|
3056 |
< |
function Add_Node(Relation, Field : String) : TRelationNode; |
3057 |
< |
var |
3058 |
< |
FField : TFieldNode; |
3059 |
< |
begin |
3060 |
< |
if FRelationNodes.RelationName = '' then |
3061 |
< |
Result := FRelationNodes |
3062 |
< |
else |
3063 |
< |
begin |
3064 |
< |
Result := TRelationNode.Create; |
3065 |
< |
Result.NextRelation := FRelationNodes; |
3066 |
< |
end; |
3067 |
< |
Result.RelationName := Relation; |
3068 |
< |
FRelationNodes := Result; |
3069 |
< |
Query.Params[0].AsString := Relation; |
3070 |
< |
Query.ExecQuery; |
3071 |
< |
while not Query.Eof do |
3072 |
< |
begin |
3073 |
< |
FField := TFieldNode.Create; |
3074 |
< |
FField.FieldName := Query.Fields[2].AsString; |
3075 |
< |
FField.DEFAULT_VALUE := not Query.Fields[1].IsNull; |
3076 |
< |
FField.COMPUTED_BLR := not Query.Fields[0].IsNull; |
3077 |
< |
FField.NextField := Result.FieldNodes; |
3078 |
< |
Result.FieldNodes := FField; |
3079 |
< |
Query.Next; |
3080 |
< |
end; |
3081 |
< |
Query.Close; |
3082 |
< |
end; |
3083 |
< |
|
3084 |
< |
function Has_COMPUTED_BLR(Relation, Field : String) : Boolean; |
3085 |
< |
var |
3086 |
< |
FRelation : TRelationNode; |
3087 |
< |
FField : TFieldNode; |
3088 |
< |
begin |
3089 |
< |
FRelation := FRelationNodes; |
3090 |
< |
while Assigned(FRelation) and |
3091 |
< |
(FRelation.RelationName <> Relation) do |
3092 |
< |
FRelation := FRelation.NextRelation; |
3093 |
< |
if not Assigned(FRelation) then |
3094 |
< |
FRelation := Add_Node(Relation, Field); |
3095 |
< |
Result := false; |
3096 |
< |
FField := FRelation.FieldNodes; |
3097 |
< |
while Assigned(FField) do |
3098 |
< |
if FField.FieldName = Field then |
3099 |
< |
begin |
3100 |
< |
Result := Ffield.COMPUTED_BLR; |
3101 |
< |
Exit; |
3102 |
< |
end |
3103 |
< |
else |
3104 |
< |
FField := Ffield.NextField; |
3105 |
< |
end; |
3106 |
< |
|
3107 |
< |
function Has_DEFAULT_VALUE(Relation, Field : String) : Boolean; |
3108 |
< |
var |
3109 |
< |
FRelation : TRelationNode; |
3110 |
< |
FField : TFieldNode; |
3111 |
< |
begin |
3112 |
< |
FRelation := FRelationNodes; |
3113 |
< |
while Assigned(FRelation) and |
3114 |
< |
(FRelation.RelationName <> Relation) do |
3115 |
< |
FRelation := FRelation.NextRelation; |
3116 |
< |
if not Assigned(FRelation) then |
3117 |
< |
FRelation := Add_Node(Relation, Field); |
3118 |
< |
Result := false; |
3119 |
< |
FField := FRelation.FieldNodes; |
3120 |
< |
while Assigned(FField) do |
3121 |
< |
if FField.FieldName = Field then |
3122 |
< |
begin |
3123 |
< |
Result := Ffield.DEFAULT_VALUE; |
3124 |
< |
Exit; |
3125 |
< |
end |
3126 |
< |
else |
3127 |
< |
FField := Ffield.NextField; |
3128 |
< |
end; |
3129 |
< |
|
3130 |
< |
Procedure FreeNodes; |
3131 |
< |
var |
3132 |
< |
FRelation : TRelationNode; |
3133 |
< |
FField : TFieldNode; |
3134 |
< |
begin |
3135 |
< |
while Assigned(FRelationNodes) do |
3136 |
< |
begin |
3137 |
< |
While Assigned(FRelationNodes.FieldNodes) do |
3138 |
< |
begin |
3139 |
< |
FField := FRelationNodes.FieldNodes.NextField; |
3140 |
< |
FRelationNodes.FieldNodes.Free; |
3141 |
< |
FRelationNodes.FieldNodes := FField; |
3142 |
< |
end; |
3143 |
< |
FRelation := FRelationNodes.NextRelation; |
3144 |
< |
FRelationNodes.Free; |
3145 |
< |
FRelationNodes := FRelation; |
3146 |
< |
end; |
3147 |
< |
end; |
3148 |
< |
|
3149 |
< |
begin |
3150 |
< |
FRelationNodes := TRelationNode.Create; |
3151 |
< |
FNeedsRefresh := False; |
3152 |
< |
Database.InternalTransaction.StartTransaction; |
3153 |
< |
Query := TIBSQL.Create(self); |
3154 |
< |
try |
3155 |
< |
Query.Database := DataBase; |
3156 |
< |
Query.Transaction := Database.InternalTransaction; |
3157 |
< |
FieldDefs.BeginUpdate; |
3158 |
< |
FieldDefs.Clear; |
3159 |
< |
FieldIndex := 0; |
3160 |
< |
if (Length(FMappedFieldPosition) < SourceQuery.Current.Count) then |
3161 |
< |
SetLength(FMappedFieldPosition, SourceQuery.Current.Count); |
3162 |
< |
Query.SQL.Text := DefaultSQL; |
3163 |
< |
Query.Prepare; |
3164 |
< |
SetLength(FAliasNameMap, SourceQuery.Current.Count); |
3165 |
< |
SetLength(FAliasNameList, SourceQuery.Current.Count); |
3166 |
< |
for i := 0 to SourceQuery.Current.Count - 1 do |
3167 |
< |
with SourceQuery.Current[i].Data^ do |
3168 |
< |
begin |
3169 |
< |
{ Get the field name } |
3170 |
< |
FieldAliasName := SourceQuery.Current[i].Name; |
3171 |
< |
SetString(DBAliasName, aliasname, aliasname_length); |
3172 |
< |
SetString(RelationName, relname, relname_length); |
3173 |
< |
SetString(FieldName, sqlname, sqlname_length); |
3174 |
< |
FAliasNameList[i] := DBAliasName; |
3175 |
< |
FieldSize := 0; |
3176 |
< |
FieldPrecision := 0; |
3177 |
< |
FieldNullable := SourceQuery.Current[i].IsNullable; |
3178 |
< |
case sqltype and not 1 of |
3179 |
< |
{ All VARCHAR's must be converted to strings before recording |
3180 |
< |
their values } |
3181 |
< |
SQL_VARYING, SQL_TEXT: |
3182 |
< |
begin |
3183 |
< |
FieldSize := sqllen; |
3184 |
< |
FieldType := ftString; |
3185 |
< |
end; |
3186 |
< |
{ All Doubles/Floats should be cast to doubles } |
3187 |
< |
SQL_DOUBLE, SQL_FLOAT: |
3188 |
< |
FieldType := ftFloat; |
3189 |
< |
SQL_SHORT: |
3190 |
< |
begin |
3191 |
< |
if (sqlscale = 0) then |
3192 |
< |
FieldType := ftSmallInt |
3193 |
< |
else begin |
3194 |
< |
FieldType := ftBCD; |
3195 |
< |
FieldPrecision := 4; |
3196 |
< |
FieldSize := -sqlscale; |
3197 |
< |
end; |
3198 |
< |
end; |
3199 |
< |
SQL_LONG: |
3200 |
< |
begin |
3201 |
< |
if (sqlscale = 0) then |
3202 |
< |
FieldType := ftInteger |
3203 |
< |
else if (sqlscale >= (-4)) then |
3204 |
< |
begin |
3205 |
< |
FieldType := ftBCD; |
3206 |
< |
FieldPrecision := 9; |
3207 |
< |
FieldSize := -sqlscale; |
3208 |
< |
end |
3209 |
< |
else |
3210 |
< |
if Database.SQLDialect = 1 then |
3211 |
< |
FieldType := ftFloat |
3212 |
< |
else |
3213 |
< |
if (FieldCount > i) and (Fields[i] is TFloatField) then |
3214 |
< |
FieldType := ftFloat |
3215 |
< |
else |
3216 |
< |
begin |
3217 |
< |
FieldType := ftFMTBCD; |
3218 |
< |
FieldPrecision := 9; |
3219 |
< |
FieldSize := -sqlscale; |
3220 |
< |
end; |
3221 |
< |
end; |
3222 |
< |
|
3223 |
< |
SQL_INT64: |
3224 |
< |
begin |
3225 |
< |
if (sqlscale = 0) then |
3226 |
< |
FieldType := ftLargeInt |
3227 |
< |
else if (sqlscale >= (-4)) then |
3228 |
< |
begin |
3229 |
< |
FieldType := ftBCD; |
3230 |
< |
FieldPrecision := 18; |
3231 |
< |
FieldSize := -sqlscale; |
3232 |
< |
end |
3233 |
< |
else |
3234 |
< |
FieldType := ftFloat |
3235 |
< |
end; |
3236 |
< |
SQL_TIMESTAMP: FieldType := ftDateTime; |
3237 |
< |
SQL_TYPE_TIME: FieldType := ftTime; |
3238 |
< |
SQL_TYPE_DATE: FieldType := ftDate; |
3239 |
< |
SQL_BLOB: |
3240 |
< |
begin |
3241 |
< |
FieldSize := sizeof (TISC_QUAD); |
3242 |
< |
if (sqlsubtype = 1) then |
3243 |
< |
FieldType := ftmemo |
3244 |
< |
else |
3245 |
< |
FieldType := ftBlob; |
3246 |
< |
end; |
3247 |
< |
SQL_ARRAY: |
3248 |
< |
begin |
3249 |
< |
FieldSize := sizeof (TISC_QUAD); |
3250 |
< |
FieldType := ftUnknown; |
3251 |
< |
end; |
3252 |
< |
SQL_BOOLEAN: |
3253 |
< |
FieldType:= ftBoolean; |
3254 |
< |
else |
3255 |
< |
FieldType := ftUnknown; |
3256 |
< |
end; |
3257 |
< |
FieldPosition := i + 1; |
3258 |
< |
if (FieldType <> ftUnknown) and (FieldAliasName <> 'IBX_INTERNAL_DBKEY') then {do not localize} |
3259 |
< |
begin |
3260 |
< |
FMappedFieldPosition[FieldIndex] := FieldPosition; |
3261 |
< |
Inc(FieldIndex); |
3262 |
< |
with FieldDefs.AddFieldDef do |
3263 |
< |
begin |
3264 |
< |
Name := FieldAliasName; |
3265 |
< |
FAliasNameMap[FieldNo-1] := DBAliasName; |
3266 |
< |
DataType := FieldType; |
3267 |
< |
Size := FieldSize; |
3268 |
< |
Precision := FieldPrecision; |
3269 |
< |
Required := not FieldNullable; |
3270 |
< |
InternalCalcField := False; |
3271 |
< |
if (FieldName <> '') and (RelationName <> '') then |
3272 |
< |
begin |
3273 |
< |
if Has_COMPUTED_BLR(RelationName, FieldName) then |
3274 |
< |
begin |
3275 |
< |
Attributes := [faReadOnly]; |
3276 |
< |
InternalCalcField := True; |
3277 |
< |
FNeedsRefresh := True; |
3278 |
< |
end |
3279 |
< |
else |
3280 |
< |
begin |
3281 |
< |
if Has_DEFAULT_VALUE(RelationName, FieldName) then |
3282 |
< |
begin |
3283 |
< |
if not FieldNullable then |
3284 |
< |
Attributes := [faRequired]; |
3285 |
< |
end |
3286 |
< |
else |
3287 |
< |
FNeedsRefresh := True; |
3288 |
< |
end; |
3289 |
< |
end; |
3290 |
< |
end; |
3291 |
< |
end; |
3292 |
< |
end; |
3293 |
< |
finally |
3294 |
< |
Query.free; |
3295 |
< |
FreeNodes; |
3296 |
< |
Database.InternalTransaction.Commit; |
3297 |
< |
FieldDefs.EndUpdate; |
3298 |
< |
end; |
3299 |
< |
end; |
3300 |
< |
|
3301 |
< |
procedure TIBCustomDataSet.InternalInitRecord(Buffer: PChar); |
3302 |
< |
begin |
3303 |
< |
CopyRecordBuffer(FModelBuffer, Buffer); |
3304 |
< |
end; |
3305 |
< |
|
3306 |
< |
procedure TIBCustomDataSet.InternalLast; |
3307 |
< |
var |
3308 |
< |
Buffer: PChar; |
3309 |
< |
begin |
3310 |
< |
if (FQSelect.EOF) then |
3311 |
< |
FCurrentRecord := FRecordCount |
3312 |
< |
else begin |
3313 |
< |
Buffer := AllocRecordBuffer; |
3314 |
< |
try |
3315 |
< |
while FQSelect.Next <> nil do |
3316 |
< |
begin |
3317 |
< |
FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer); |
3318 |
< |
Inc(FRecordCount); |
3319 |
< |
end; |
3320 |
< |
FCurrentRecord := FRecordCount; |
3321 |
< |
finally |
3322 |
< |
FreeRecordBuffer(Buffer); |
3323 |
< |
end; |
3324 |
< |
end; |
3325 |
< |
end; |
3326 |
< |
|
3327 |
< |
procedure TIBCustomDataSet.InternalSetParamsFromCursor; |
3328 |
< |
var |
3329 |
< |
i: Integer; |
3330 |
< |
cur_param: TIBXSQLVAR; |
3331 |
< |
cur_field: TField; |
3332 |
< |
s: TStream; |
3333 |
< |
begin |
3334 |
< |
if FQSelect.SQL.Text = '' then |
3335 |
< |
IBError(ibxeEmptyQuery, [nil]); |
3336 |
< |
if not FInternalPrepared then |
3337 |
< |
InternalPrepare; |
3338 |
< |
if (SQLParams.Count > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then |
3339 |
< |
begin |
3340 |
< |
for i := 0 to SQLParams.Count - 1 do |
3341 |
< |
begin |
3342 |
< |
cur_field := DataSource.DataSet.FindField(SQLParams[i].Name); |
3343 |
< |
cur_param := SQLParams[i]; |
3344 |
< |
if (cur_field <> nil) then begin |
3345 |
< |
if (cur_field.IsNull) then |
3346 |
< |
cur_param.IsNull := True |
3347 |
< |
else case cur_field.DataType of |
3348 |
< |
ftString: |
3349 |
< |
cur_param.AsString := cur_field.AsString; |
3350 |
< |
ftBoolean: |
3351 |
< |
cur_param.AsBoolean := cur_field.AsBoolean; |
3352 |
< |
ftSmallint, ftWord: |
3353 |
< |
cur_param.AsShort := cur_field.AsInteger; |
3354 |
< |
ftInteger: |
3355 |
< |
cur_param.AsLong := cur_field.AsInteger; |
3356 |
< |
ftLargeInt: |
3357 |
< |
cur_param.AsInt64 := TLargeIntField(cur_field).AsLargeInt; |
3358 |
< |
ftFloat, ftCurrency: |
3359 |
< |
cur_param.AsDouble := cur_field.AsFloat; |
3360 |
< |
ftBCD: |
3361 |
< |
cur_param.AsCurrency := cur_field.AsCurrency; |
3362 |
< |
ftDate: |
3363 |
< |
cur_param.AsDate := cur_field.AsDateTime; |
3364 |
< |
ftTime: |
3365 |
< |
cur_param.AsTime := cur_field.AsDateTime; |
3366 |
< |
ftDateTime: |
3367 |
< |
cur_param.AsDateTime := cur_field.AsDateTime; |
3368 |
< |
ftBlob, ftMemo: |
3369 |
< |
begin |
3370 |
< |
s := nil; |
3371 |
< |
try |
3372 |
< |
s := DataSource.DataSet. |
3373 |
< |
CreateBlobStream(cur_field, bmRead); |
3374 |
< |
cur_param.LoadFromStream(s); |
3375 |
< |
finally |
3376 |
< |
s.free; |
3377 |
< |
end; |
3378 |
< |
end; |
3379 |
< |
else |
3380 |
< |
IBError(ibxeNotSupported, [nil]); |
3381 |
< |
end; |
3382 |
< |
end; |
3383 |
< |
end; |
3384 |
< |
end; |
3385 |
< |
end; |
3386 |
< |
|
3387 |
< |
procedure TIBCustomDataSet.ReQuery; |
3388 |
< |
begin |
3389 |
< |
FQSelect.Close; |
3390 |
< |
ClearBlobCache; |
3391 |
< |
FCurrentRecord := -1; |
3392 |
< |
FRecordCount := 0; |
3393 |
< |
FDeletedRecords := 0; |
3394 |
< |
FBPos := 0; |
3395 |
< |
FOBPos := 0; |
3396 |
< |
FBEnd := 0; |
3397 |
< |
FOBEnd := 0; |
3398 |
< |
FQSelect.Close; |
3399 |
< |
FQSelect.ExecQuery; |
3400 |
< |
FOpen := FQSelect.Open; |
3401 |
< |
First; |
3402 |
< |
end; |
3403 |
< |
|
3404 |
< |
procedure TIBCustomDataSet.InternalOpen; |
3405 |
< |
var |
3406 |
< |
SetCursor: Boolean; |
3407 |
< |
|
3408 |
< |
function RecordDataLength(n: Integer): Long; |
3409 |
< |
begin |
3410 |
< |
result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData)); |
3411 |
< |
end; |
3412 |
< |
|
3413 |
< |
begin |
3414 |
< |
if Assigned(Database) and not Database.SQLHourGlass then |
3415 |
< |
SetCursor := False |
3416 |
< |
else |
3417 |
< |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
3418 |
< |
if SetCursor then |
3419 |
< |
Screen.Cursor := crHourGlass; |
3420 |
< |
try |
3421 |
< |
ActivateConnection; |
3422 |
< |
ActivateTransaction; |
3423 |
< |
if FQSelect.SQL.Text = '' then |
3424 |
< |
IBError(ibxeEmptyQuery, [nil]); |
3425 |
< |
if not FInternalPrepared then |
3426 |
< |
InternalPrepare; |
3427 |
< |
if FQSelect.SQLType = SQLSelect then |
3428 |
< |
begin |
3429 |
< |
if DefaultFields then |
3430 |
< |
CreateFields; |
3431 |
< |
BindFields(True); |
3432 |
< |
FCurrentRecord := -1; |
3433 |
< |
FQSelect.ExecQuery; |
3434 |
< |
FOpen := FQSelect.Open; |
3435 |
< |
|
3436 |
< |
{ Initialize offsets, buffer sizes, etc... |
3437 |
< |
1. Initially FRecordSize is just the "RecordDataLength". |
3438 |
< |
2. Allocate a "model" buffer and do a dummy fetch |
3439 |
< |
3. After the dummy fetch, FRecordSize will be appropriately |
3440 |
< |
adjusted to reflect the additional "weight" of the field |
3441 |
< |
data. |
3442 |
< |
4. Set up the FCalcFieldsOffset, FBlobCacheOffset and FRecordBufferSize. |
3443 |
< |
5. Now, with the BufferSize available, allocate memory for chunks of records |
3444 |
< |
6. Re-allocate the model buffer, accounting for the new |
3445 |
< |
FRecordBufferSize. |
3446 |
< |
7. Finally, calls to AllocRecordBuffer will work!. |
3447 |
< |
} |
3448 |
< |
{Step 1} |
3449 |
< |
FRecordSize := RecordDataLength(FQSelect.Current.Count); |
3450 |
< |
{Step 2, 3} |
3451 |
< |
IBAlloc(FModelBuffer, 0, FRecordSize); |
3452 |
< |
FetchCurrentRecordToBuffer(FQSelect, -1, FModelBuffer); |
3453 |
< |
{Step 4} |
3454 |
< |
FCalcFieldsOffset := FRecordSize; |
3455 |
< |
FBlobCacheOffset := FCalcFieldsOffset + CalcFieldsSize; |
3456 |
< |
FRecordBufferSize := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream))); |
3457 |
< |
{Step 5} |
3458 |
< |
if UniDirectional then |
3459 |
< |
FBufferChunkSize := FRecordBufferSize * UniCache |
3460 |
< |
else |
3461 |
< |
FBufferChunkSize := FRecordBufferSize * BufferChunks; |
3462 |
< |
IBAlloc(FBufferCache, FBufferChunkSize, FBufferChunkSize); |
3463 |
< |
if FCachedUpdates or (csReading in ComponentState) then |
3464 |
< |
IBAlloc(FOldBufferCache, FBufferChunkSize, FBufferChunkSize); |
3465 |
< |
FBPos := 0; |
3466 |
< |
FOBPos := 0; |
3467 |
< |
FBEnd := 0; |
3468 |
< |
FOBEnd := 0; |
3469 |
< |
FCacheSize := FBufferChunkSize; |
3470 |
< |
FOldCacheSize := FBufferChunkSize; |
3471 |
< |
{Step 6} |
3472 |
< |
IBAlloc(FModelBuffer, RecordDataLength(FQSelect.Current.Count), |
3473 |
< |
FRecordBufferSize); |
3474 |
< |
{Step 7} |
3475 |
< |
FOldBuffer := AllocRecordBuffer; |
3476 |
< |
end |
3477 |
< |
else |
3478 |
< |
FQSelect.ExecQuery; |
3479 |
< |
finally |
3480 |
< |
if SetCursor and (Screen.Cursor = crHourGlass) then |
3481 |
< |
Screen.Cursor := crDefault; |
3482 |
< |
end; |
3483 |
< |
end; |
3484 |
< |
|
3485 |
< |
procedure TIBCustomDataSet.InternalPost; |
3486 |
< |
var |
3487 |
< |
Qry: TIBSQL; |
3488 |
< |
Buff: PChar; |
3489 |
< |
SetCursor: Boolean; |
3490 |
< |
bInserting: Boolean; |
3491 |
< |
begin |
3492 |
< |
if Assigned(Database) and not Database.SQLHourGlass then |
3493 |
< |
SetCursor := False |
3494 |
< |
else |
3495 |
< |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
3496 |
< |
if SetCursor then |
3497 |
< |
Screen.Cursor := crHourGlass; |
3498 |
< |
try |
3499 |
< |
Buff := GetActiveBuf; |
3500 |
< |
CheckEditState; |
3501 |
< |
AdjustRecordOnInsert(Buff); |
3502 |
< |
if (State = dsInsert) then |
3503 |
< |
begin |
3504 |
< |
bInserting := True; |
3505 |
< |
Qry := FQInsert; |
3506 |
< |
PRecordData(Buff)^.rdUpdateStatus := usInserted; |
3507 |
< |
PRecordData(Buff)^.rdCachedUpdateStatus := cusInserted; |
3508 |
< |
WriteRecordCache(FRecordCount, Buff); |
3509 |
< |
FCurrentRecord := FRecordCount; |
3510 |
< |
end |
3511 |
< |
else begin |
3512 |
< |
bInserting := False; |
3513 |
< |
Qry := FQModify; |
3514 |
< |
if PRecordData(Buff)^.rdCachedUpdateStatus = cusUnmodified then |
3515 |
< |
begin |
3516 |
< |
PRecordData(Buff)^.rdUpdateStatus := usModified; |
3517 |
< |
PRecordData(Buff)^.rdCachedUpdateStatus := cusModified; |
3518 |
< |
end |
3519 |
< |
else if PRecordData(Buff)^. |
3520 |
< |
rdCachedUpdateStatus = cusUninserted then |
3521 |
< |
begin |
3522 |
< |
PRecordData(Buff)^.rdCachedUpdateStatus := cusInserted; |
3523 |
< |
Dec(FDeletedRecords); |
3524 |
< |
end; |
3525 |
< |
end; |
3526 |
< |
if (not CachedUpdates) then |
3527 |
< |
InternalPostRecord(Qry, Buff) |
3528 |
< |
else begin |
3529 |
< |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff); |
3530 |
< |
FUpdatesPending := True; |
3531 |
< |
end; |
3532 |
< |
if bInserting then |
3533 |
< |
Inc(FRecordCount); |
3534 |
< |
finally |
3535 |
< |
if SetCursor and (Screen.Cursor = crHourGlass) then |
3536 |
< |
Screen.Cursor := crDefault; |
3537 |
< |
end; |
3538 |
< |
end; |
3539 |
< |
|
3540 |
< |
procedure TIBCustomDataSet.InternalRefresh; |
3541 |
< |
begin |
3542 |
< |
inherited InternalRefresh; |
3543 |
< |
InternalRefreshRow; |
3544 |
< |
end; |
3545 |
< |
|
3546 |
< |
procedure TIBCustomDataSet.InternalSetToRecord(Buffer: PChar); |
3547 |
< |
begin |
3548 |
< |
InternalGotoBookmark(@(PRecordData(Buffer)^.rdRecordNumber)); |
3549 |
< |
end; |
3550 |
< |
|
3551 |
< |
function TIBCustomDataSet.IsCursorOpen: Boolean; |
3552 |
< |
begin |
3553 |
< |
result := FOpen; |
3554 |
< |
end; |
3555 |
< |
|
3556 |
< |
procedure TIBCustomDataSet.Loaded; |
3557 |
< |
begin |
3558 |
< |
if assigned(FQSelect) then |
3559 |
< |
FBaseSQLSelect.assign(FQSelect.SQL); |
3560 |
< |
inherited Loaded; |
3561 |
< |
end; |
3562 |
< |
|
3563 |
< |
function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant; |
3564 |
< |
Options: TLocateOptions): Boolean; |
3565 |
< |
var |
3566 |
< |
{$IF FPC_FULLVERSION >= 20700 } |
3567 |
< |
CurBookmark: TBookmark; |
3568 |
< |
{$ELSE} |
3569 |
< |
CurBookmark: string; |
3570 |
< |
{$ENDIF} |
3571 |
< |
begin |
3572 |
< |
DisableControls; |
3573 |
< |
try |
3574 |
< |
CurBookmark := Bookmark; |
3575 |
< |
First; |
3576 |
< |
result := InternalLocate(KeyFields, KeyValues, Options); |
3577 |
< |
if not result then |
3578 |
< |
Bookmark := CurBookmark; |
3579 |
< |
finally |
3580 |
< |
EnableControls; |
3581 |
< |
end; |
3582 |
< |
end; |
3583 |
< |
|
3584 |
< |
function TIBCustomDataSet.Lookup(const KeyFields: string; const KeyValues: Variant; |
3585 |
< |
const ResultFields: string): Variant; |
3586 |
< |
var |
3587 |
< |
fl: TList; |
3588 |
< |
{$IF FPC_FULLVERSION >= 20700 } |
3589 |
< |
CurBookmark: TBookmark; |
3590 |
< |
{$ELSE} |
3591 |
< |
CurBookmark: string; |
3592 |
< |
{$ENDIF} |
3593 |
< |
begin |
3594 |
< |
DisableControls; |
3595 |
< |
fl := TList.Create; |
3596 |
< |
CurBookmark := Bookmark; |
3597 |
< |
try |
3598 |
< |
First; |
3599 |
< |
if InternalLocate(KeyFields, KeyValues, []) then |
3600 |
< |
begin |
3601 |
< |
if (ResultFields <> '') then |
3602 |
< |
result := FieldValues[ResultFields] |
3603 |
< |
else |
3604 |
< |
result := NULL; |
3605 |
< |
end |
3606 |
< |
else |
3607 |
< |
result := Null; |
3608 |
< |
finally |
3609 |
< |
Bookmark := CurBookmark; |
3610 |
< |
fl.Free; |
3611 |
< |
EnableControls; |
3612 |
< |
end; |
3613 |
< |
end; |
3614 |
< |
|
3615 |
< |
procedure TIBCustomDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer); |
3616 |
< |
begin |
3617 |
< |
PRecordData(Buffer)^.rdRecordNumber := PInteger(Data)^; |
3618 |
< |
end; |
3619 |
< |
|
3620 |
< |
procedure TIBCustomDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); |
3621 |
< |
begin |
3622 |
< |
PRecordData(Buffer)^.rdBookmarkFlag := Value; |
3623 |
< |
end; |
3624 |
< |
|
3625 |
< |
procedure TIBCustomDataSet.SetCachedUpdates(Value: Boolean); |
3626 |
< |
begin |
3627 |
< |
if not Value and FCachedUpdates then |
3628 |
< |
CancelUpdates; |
3629 |
< |
if (not (csReading in ComponentState)) and Value then |
3630 |
< |
CheckDatasetClosed; |
3631 |
< |
FCachedUpdates := Value; |
3632 |
< |
end; |
3633 |
< |
|
3634 |
< |
procedure TIBCustomDataSet.SetDataSource(Value: TDataSource); |
3635 |
< |
begin |
3636 |
< |
if IsLinkedTo(Value) then |
3637 |
< |
IBError(ibxeCircularReference, [nil]); |
3638 |
< |
if FDataLink <> nil then |
3639 |
< |
FDataLink.DataSource := Value; |
3640 |
< |
end; |
3641 |
< |
|
3642 |
< |
procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer); |
3643 |
< |
var |
3644 |
< |
Buff, TmpBuff: PChar; |
3645 |
< |
MappedFieldPos: integer; |
3646 |
< |
begin |
3647 |
< |
Buff := GetActiveBuf; |
3648 |
< |
if Field.FieldNo < 0 then |
3649 |
< |
begin |
3650 |
< |
TmpBuff := Buff + FRecordSize + Field.Offset; |
3651 |
< |
Boolean(TmpBuff[0]) := LongBool(Buffer); |
3652 |
< |
if Boolean(TmpBuff[0]) then |
3653 |
< |
Move(Buffer^, TmpBuff[1], Field.DataSize); |
3654 |
< |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff); |
3655 |
< |
end |
3656 |
< |
else begin |
3657 |
< |
CheckEditState; |
3658 |
< |
with PRecordData(Buff)^ do |
3659 |
< |
begin |
3660 |
< |
{ If inserting, Adjust record position } |
3661 |
< |
AdjustRecordOnInsert(Buff); |
3662 |
< |
MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1]; |
3663 |
< |
if (MappedFieldPos > 0) and |
3664 |
< |
(MappedFieldPos <= rdFieldCount) then |
3665 |
< |
begin |
3666 |
< |
Field.Validate(Buffer); |
3667 |
< |
if (Buffer = nil) or |
3668 |
< |
(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then |
3669 |
< |
rdFields[MappedFieldPos].fdIsNull := True |
3670 |
< |
else begin |
3671 |
< |
Move(Buffer^, Buff[rdFields[MappedFieldPos].fdDataOfs], |
3672 |
< |
rdFields[MappedFieldPos].fdDataSize); |
3673 |
< |
if (rdFields[MappedFieldPos].fdDataType = SQL_TEXT) or |
3674 |
< |
(rdFields[MappedFieldPos].fdDataType = SQL_VARYING) then |
3675 |
< |
rdFields[MappedFieldPos].fdDataLength := StrLen(PChar(Buffer)); |
3676 |
< |
rdFields[MappedFieldPos].fdIsNull := False; |
3677 |
< |
if rdUpdateStatus = usUnmodified then |
3678 |
< |
begin |
3679 |
< |
if CachedUpdates then |
3680 |
< |
begin |
3681 |
< |
FUpdatesPending := True; |
3682 |
< |
if State = dsInsert then |
3683 |
< |
rdCachedUpdateStatus := cusInserted |
3684 |
< |
else if State = dsEdit then |
3685 |
< |
rdCachedUpdateStatus := cusModified; |
3686 |
< |
end; |
3687 |
< |
|
3688 |
< |
if State = dsInsert then |
3689 |
< |
rdUpdateStatus := usInserted |
3690 |
< |
else |
3691 |
< |
rdUpdateStatus := usModified; |
3692 |
< |
end; |
3693 |
< |
WriteRecordCache(rdRecordNumber, Buff); |
3694 |
< |
SetModified(True); |
3695 |
< |
end; |
3696 |
< |
end; |
3697 |
< |
end; |
3698 |
< |
end; |
3699 |
< |
if not (State in [dsCalcFields, dsFilter, dsNewValue]) then |
3700 |
< |
DataEvent(deFieldChange, PtrInt(Field)); |
3701 |
< |
end; |
3702 |
< |
|
3703 |
< |
procedure TIBCustomDataSet.SetRecNo(Value: Integer); |
3704 |
< |
begin |
3705 |
< |
CheckBrowseMode; |
3706 |
< |
if (Value < 1) then |
3707 |
< |
Value := 1 |
3708 |
< |
else if Value > FRecordCount then |
3709 |
< |
begin |
3710 |
< |
InternalLast; |
3711 |
< |
Value := Min(FRecordCount, Value); |
3712 |
< |
end; |
3713 |
< |
if (Value <> RecNo) then |
3714 |
< |
begin |
3715 |
< |
DoBeforeScroll; |
3716 |
< |
FCurrentRecord := Value - 1; |
3717 |
< |
Resync([]); |
3718 |
< |
DoAfterScroll; |
3719 |
< |
end; |
3720 |
< |
end; |
3721 |
< |
|
3722 |
< |
procedure TIBCustomDataSet.Disconnect; |
3723 |
< |
begin |
3724 |
< |
Close; |
3725 |
< |
InternalUnPrepare; |
3726 |
< |
end; |
3727 |
< |
|
3728 |
< |
procedure TIBCustomDataSet.SetUpdateMode(const Value: TUpdateMode); |
3729 |
< |
begin |
3730 |
< |
if not CanModify then |
3731 |
< |
IBError(ibxeCannotUpdate, [nil]) |
3732 |
< |
else |
3733 |
< |
FUpdateMode := Value; |
3734 |
< |
end; |
3735 |
< |
|
3736 |
< |
|
3737 |
< |
procedure TIBCustomDataSet.SetUpdateObject(Value: TIBDataSetUpdateObject); |
3738 |
< |
begin |
3739 |
< |
if Value <> FUpdateObject then |
3740 |
< |
begin |
3741 |
< |
if Assigned(FUpdateObject) and (FUpdateObject.DataSet = Self) then |
3742 |
< |
FUpdateObject.DataSet := nil; |
3743 |
< |
FUpdateObject := Value; |
3744 |
< |
if Assigned(FUpdateObject) then |
3745 |
< |
begin |
3746 |
< |
if Assigned(FUpdateObject.DataSet) and |
3747 |
< |
(FUpdateObject.DataSet <> Self) then |
3748 |
< |
FUpdateObject.DataSet.UpdateObject := nil; |
3749 |
< |
FUpdateObject.DataSet := Self; |
3750 |
< |
end; |
3751 |
< |
end; |
3752 |
< |
end; |
3753 |
< |
|
3754 |
< |
function TIBCustomDataSet.ConstraintsStored: Boolean; |
3755 |
< |
begin |
3756 |
< |
Result := Constraints.Count > 0; |
3757 |
< |
end; |
3758 |
< |
|
3759 |
< |
procedure TIBCustomDataSet.ClearCalcFields(Buffer: PChar); |
3760 |
< |
begin |
3761 |
< |
FillChar(Buffer[FRecordSize], CalcFieldsSize, 0); |
3762 |
< |
end; |
3763 |
< |
|
3764 |
< |
|
3765 |
< |
procedure TIBCustomDataSet.InternalUnPrepare; |
3766 |
< |
begin |
3767 |
< |
if FInternalPrepared then |
3768 |
< |
begin |
3769 |
< |
CheckDatasetClosed; |
3770 |
< |
FieldDefs.Clear; |
3771 |
< |
FieldDefs.Updated := false; |
3772 |
< |
FInternalPrepared := False; |
3773 |
< |
Setlength(FAliasNameList,0); |
3774 |
< |
end; |
3775 |
< |
end; |
3776 |
< |
|
3777 |
< |
procedure TIBCustomDataSet.InternalExecQuery; |
3778 |
< |
var |
3779 |
< |
DidActivate: Boolean; |
3780 |
< |
SetCursor: Boolean; |
3781 |
< |
begin |
3782 |
< |
DidActivate := False; |
3783 |
< |
if Assigned(Database) and not Database.SQLHourGlass then |
3784 |
< |
SetCursor := False |
3785 |
< |
else |
3786 |
< |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
3787 |
< |
if SetCursor then |
3788 |
< |
Screen.Cursor := crHourGlass; |
3789 |
< |
try |
3790 |
< |
ActivateConnection; |
3791 |
< |
DidActivate := ActivateTransaction; |
3792 |
< |
if FQSelect.SQL.Text = '' then |
3793 |
< |
IBError(ibxeEmptyQuery, [nil]); |
3794 |
< |
if not FInternalPrepared then |
3795 |
< |
InternalPrepare; |
3796 |
< |
if FQSelect.SQLType = SQLSelect then |
3797 |
< |
begin |
3798 |
< |
IBError(ibxeIsASelectStatement, [nil]); |
3799 |
< |
end |
3800 |
< |
else |
3801 |
< |
FQSelect.ExecQuery; |
3802 |
< |
finally |
3803 |
< |
if DidActivate then |
3804 |
< |
DeactivateTransaction; |
3805 |
< |
if SetCursor and (Screen.Cursor = crHourGlass) then |
3806 |
< |
Screen.Cursor := crDefault; |
3807 |
< |
end; |
3808 |
< |
end; |
3809 |
< |
|
3810 |
< |
function TIBCustomDataSet.GetSelectStmtHandle: TISC_STMT_HANDLE; |
3811 |
< |
begin |
3812 |
< |
Result := FQSelect.Handle; |
3813 |
< |
end; |
3814 |
< |
|
3815 |
< |
function TIBCustomDataSet.GetParser: TSelectSQLParser; |
3816 |
< |
begin |
3817 |
< |
if not assigned(FParser) then |
3818 |
< |
FParser := CreateParser; |
3819 |
< |
Result := FParser |
3820 |
< |
end; |
3821 |
< |
|
3822 |
< |
procedure TIBCustomDataSet.ResetParser; |
3823 |
< |
begin |
3824 |
< |
if assigned(FParser) then |
3825 |
< |
begin |
3826 |
< |
FParser.Free; |
3827 |
< |
FParser := nil; |
3828 |
< |
SQLChanging(nil) |
3829 |
< |
end; |
3830 |
< |
end; |
3831 |
< |
|
3832 |
< |
function TIBCustomDataSet.HasParser: boolean; |
3833 |
< |
begin |
3834 |
< |
Result := not (csDesigning in ComponentState) and (FParser <> nil) |
3835 |
< |
end; |
3836 |
< |
|
3837 |
< |
procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean); |
3838 |
< |
begin |
3839 |
< |
if FGenerateParamNames = AValue then Exit; |
3840 |
< |
FGenerateParamNames := AValue; |
3841 |
< |
Disconnect |
3842 |
< |
end; |
3843 |
< |
|
3844 |
< |
procedure TIBCustomDataSet.InitRecord(Buffer: PChar); |
3845 |
< |
begin |
3846 |
< |
inherited InitRecord(Buffer); |
3847 |
< |
with PRecordData(Buffer)^ do |
3848 |
< |
begin |
3849 |
< |
rdUpdateStatus := TUpdateStatus(usInserted); |
3850 |
< |
rdBookMarkFlag := bfInserted; |
3851 |
< |
rdRecordNumber := -1; |
3852 |
< |
end; |
3853 |
< |
end; |
3854 |
< |
|
3855 |
< |
procedure TIBCustomDataSet.InternalInsert; |
3856 |
< |
begin |
3857 |
< |
CursorPosChanged; |
3858 |
< |
end; |
3859 |
< |
|
3860 |
< |
{ TIBDataSet IProviderSupport } |
3861 |
< |
|
3862 |
< |
(*procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean); |
3863 |
< |
begin |
3864 |
< |
if Commit then |
3865 |
< |
Transaction.Commit else |
3866 |
< |
Transaction.Rollback; |
3867 |
< |
end; |
3868 |
< |
|
3869 |
< |
function TIBCustomDataSet.PSExecuteStatement(const ASQL: string; AParams: TParams; |
3870 |
< |
ResultSet: Pointer = nil): Integer; |
3871 |
< |
var |
3872 |
< |
FQuery: TIBQuery; |
3873 |
< |
begin |
3874 |
< |
if Assigned(ResultSet) then |
3875 |
< |
begin |
3876 |
< |
TDataSet(ResultSet^) := TIBQuery.Create(nil); |
3877 |
< |
with TIBQuery(ResultSet^) do |
3878 |
< |
begin |
3879 |
< |
SQL.Text := ASQL; |
3880 |
< |
Params.Assign(AParams); |
3881 |
< |
Open; |
3882 |
< |
Result := RowsAffected; |
3883 |
< |
end; |
3884 |
< |
end |
3885 |
< |
else |
3886 |
< |
begin |
3887 |
< |
FQuery := TIBQuery.Create(nil); |
3888 |
< |
try |
3889 |
< |
FQuery.Database := Database; |
3890 |
< |
FQuery.Transaction := Transaction; |
3891 |
< |
FQuery.GenerateParamNames := True; |
3892 |
< |
FQuery.SQL.Text := ASQL; |
3893 |
< |
FQuery.Params.Assign(AParams); |
3894 |
< |
FQuery.ExecSQL; |
3895 |
< |
Result := FQuery.RowsAffected; |
3896 |
< |
finally |
3897 |
< |
FQuery.Free; |
3898 |
< |
end; |
3899 |
< |
end; |
3900 |
< |
end; |
3901 |
< |
|
3902 |
< |
function TIBCustomDataSet.PSGetQuoteChar: string; |
3903 |
< |
begin |
3904 |
< |
if Database.SQLDialect = 3 then |
3905 |
< |
Result := '"' else |
3906 |
< |
Result := ''; |
3907 |
< |
end; |
3908 |
< |
|
3909 |
< |
function TIBCustomDataSet.PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; |
3910 |
< |
var |
3911 |
< |
PrevErr: Integer; |
3912 |
< |
begin |
3913 |
< |
if Prev <> nil then |
3914 |
< |
PrevErr := Prev.ErrorCode else |
3915 |
< |
PrevErr := 0; |
3916 |
< |
if E is EIBError then |
3917 |
< |
with EIBError(E) do |
3918 |
< |
Result := EUpdateError.Create(E.Message, '', SQLCode, PrevErr, E) else |
3919 |
< |
Result := inherited PSGetUpdateException(E, Prev); |
3920 |
< |
end; |
3921 |
< |
|
3922 |
< |
function TIBCustomDataSet.PSInTransaction: Boolean; |
3923 |
< |
begin |
3924 |
< |
Result := Transaction.InTransaction; |
3925 |
< |
end; |
3926 |
< |
|
3927 |
< |
function TIBCustomDataSet.PSIsSQLBased: Boolean; |
3928 |
< |
begin |
3929 |
< |
Result := True; |
3930 |
< |
end; |
3931 |
< |
|
3932 |
< |
function TIBCustomDataSet.PSIsSQLSupported: Boolean; |
3933 |
< |
begin |
3934 |
< |
Result := True; |
3935 |
< |
end; |
3936 |
< |
|
3937 |
< |
procedure TIBCustomDataSet.PSReset; |
3938 |
< |
begin |
3939 |
< |
inherited PSReset; |
3940 |
< |
if Active then |
3941 |
< |
begin |
3942 |
< |
Close; |
3943 |
< |
Open; |
3944 |
< |
end; |
3945 |
< |
end; |
3946 |
< |
|
3947 |
< |
function TIBCustomDataSet.PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; |
3948 |
< |
var |
3949 |
< |
UpdateAction: TIBUpdateAction; |
3950 |
< |
SQL: string; |
3951 |
< |
Params: TParams; |
3952 |
< |
|
3953 |
< |
procedure AssignParams(DataSet: TDataSet; Params: TParams); |
3954 |
< |
var |
3955 |
< |
I: Integer; |
3956 |
< |
Old: Boolean; |
3957 |
< |
Param: TParam; |
3958 |
< |
PName: string; |
3959 |
< |
Field: TField; |
3960 |
< |
Value: Variant; |
3961 |
< |
begin |
3962 |
< |
for I := 0 to Params.Count - 1 do |
3963 |
< |
begin |
3964 |
< |
Param := Params[I]; |
3965 |
< |
PName := Param.Name; |
3966 |
< |
Old := CompareText(Copy(PName, 1, 4), 'OLD_') = 0; {do not localize} |
3967 |
< |
if Old then System.Delete(PName, 1, 4); |
3968 |
< |
Field := DataSet.FindField(PName); |
3969 |
< |
if not Assigned(Field) then Continue; |
3970 |
< |
if Old then Param.AssignFieldValue(Field, Field.OldValue) else |
3971 |
< |
begin |
3972 |
< |
Value := Field.NewValue; |
3973 |
< |
if VarIsEmpty(Value) then Value := Field.OldValue; |
3974 |
< |
Param.AssignFieldValue(Field, Value); |
3975 |
< |
end; |
3976 |
< |
end; |
3977 |
< |
end; |
3978 |
< |
|
3979 |
< |
begin |
3980 |
< |
Result := False; |
3981 |
< |
if Assigned(OnUpdateRecord) then |
3982 |
< |
begin |
3983 |
< |
UpdateAction := uaFail; |
3984 |
< |
if Assigned(FOnUpdateRecord) then |
3985 |
< |
begin |
3986 |
< |
FOnUpdateRecord(Delta, UpdateKind, UpdateAction); |
3987 |
< |
Result := UpdateAction = uaApplied; |
3988 |
< |
end; |
3989 |
< |
end |
3990 |
< |
else if Assigned(FUpdateObject) then |
3991 |
< |
begin |
3992 |
< |
SQL := FUpdateObject.GetSQL(UpdateKind).Text; |
3993 |
< |
if SQL <> '' then |
3994 |
< |
begin |
3995 |
< |
Params := TParams.Create; |
3996 |
< |
try |
3997 |
< |
Params.ParseSQL(SQL, True); |
3998 |
< |
AssignParams(Delta, Params); |
3999 |
< |
if PSExecuteStatement(SQL, Params) = 0 then |
4000 |
< |
IBError(ibxeNoRecordsAffected, [nil]); |
4001 |
< |
Result := True; |
4002 |
< |
finally |
4003 |
< |
Params.Free; |
4004 |
< |
end; |
4005 |
< |
end; |
4006 |
< |
end; |
4007 |
< |
end; |
4008 |
< |
|
4009 |
< |
procedure TIBCustomDataSet.PSStartTransaction; |
4010 |
< |
begin |
4011 |
< |
ActivateConnection; |
4012 |
< |
Transaction.StartTransaction; |
4013 |
< |
end; |
4014 |
< |
|
4015 |
< |
function TIBCustomDataSet.PSGetTableName: string; |
4016 |
< |
begin |
4017 |
< |
// if not FInternalPrepared then |
4018 |
< |
// InternalPrepare; |
4019 |
< |
{ It is possible for the FQSelectSQL to be unprepared |
4020 |
< |
with FInternalPreprepared being true (see DoBeforeTransactionEnd). |
4021 |
< |
So check the Prepared of the SelectSQL instead } |
4022 |
< |
if not FQSelect.Prepared then |
4023 |
< |
FQSelect.Prepare; |
4024 |
< |
Result := FQSelect.UniqueRelationName; |
4025 |
< |
end;*) |
4026 |
< |
|
4027 |
< |
procedure TIBDataSet.BatchInput(InputObject: TIBBatchInput); |
4028 |
< |
begin |
4029 |
< |
InternalBatchInput(InputObject); |
4030 |
< |
end; |
4031 |
< |
|
4032 |
< |
procedure TIBDataSet.BatchOutput(OutputObject: TIBBatchOutput); |
4033 |
< |
begin |
4034 |
< |
InternalBatchOutput(OutputObject); |
4035 |
< |
end; |
4036 |
< |
|
4037 |
< |
procedure TIBDataSet.ExecSQL; |
4038 |
< |
begin |
4039 |
< |
InternalExecQuery; |
4040 |
< |
end; |
4041 |
< |
|
4042 |
< |
procedure TIBDataSet.Prepare; |
4043 |
< |
begin |
4044 |
< |
InternalPrepare; |
4045 |
< |
end; |
4046 |
< |
|
4047 |
< |
procedure TIBDataSet.UnPrepare; |
4048 |
< |
begin |
4049 |
< |
InternalUnPrepare; |
4050 |
< |
end; |
4051 |
< |
|
4052 |
< |
function TIBDataSet.GetPrepared: Boolean; |
4053 |
< |
begin |
4054 |
< |
Result := InternalPrepared; |
4055 |
< |
end; |
4056 |
< |
|
4057 |
< |
procedure TIBDataSet.InternalOpen; |
4058 |
< |
begin |
4059 |
< |
ActivateConnection; |
4060 |
< |
ActivateTransaction; |
4061 |
< |
InternalSetParamsFromCursor; |
4062 |
< |
Inherited InternalOpen; |
4063 |
< |
end; |
4064 |
< |
|
4065 |
< |
procedure TIBDataSet.SetFiltered(Value: Boolean); |
4066 |
< |
begin |
4067 |
< |
if(Filtered <> Value) then |
4068 |
< |
begin |
4069 |
< |
inherited SetFiltered(value); |
4070 |
< |
if Active then |
4071 |
< |
begin |
4072 |
< |
Close; |
4073 |
< |
Open; |
4074 |
< |
end; |
4075 |
< |
end |
4076 |
< |
else |
4077 |
< |
inherited SetFiltered(value); |
4078 |
< |
end; |
4079 |
< |
|
4080 |
< |
function TIBCustomDataSet.BookmarkValid(Bookmark: TBookmark): Boolean; |
4081 |
< |
begin |
4082 |
< |
Result := false; |
4083 |
< |
if not Assigned(Bookmark) then |
4084 |
< |
exit; |
4085 |
< |
Result := PInteger(Bookmark)^ < FRecordCount; |
4086 |
< |
end; |
4087 |
< |
|
4088 |
< |
function TIBCustomDataSet.GetFieldData(Field: TField; |
4089 |
< |
Buffer: Pointer): Boolean; |
4090 |
< |
{$IFDEF TBCDFIELD_IS_BCD} |
4091 |
< |
var |
4092 |
< |
lTempCurr : System.Currency; |
4093 |
< |
begin |
4094 |
< |
if (Field.DataType = ftBCD) and (Buffer <> nil) then |
4095 |
< |
begin |
4096 |
< |
Result := InternalGetFieldData(Field, @lTempCurr); |
4097 |
< |
if Result then |
4098 |
< |
CurrToBCD(lTempCurr, TBCD(Buffer^), 32, Field.Size); |
4099 |
< |
end |
4100 |
< |
else |
4101 |
< |
{$ELSE} |
4102 |
< |
begin |
4103 |
< |
{$ENDIF} |
4104 |
< |
Result := InternalGetFieldData(Field, Buffer); |
4105 |
< |
end; |
4106 |
< |
|
4107 |
< |
function TIBCustomDataSet.GetFieldData(Field: TField; Buffer: Pointer; |
4108 |
< |
NativeFormat: Boolean): Boolean; |
4109 |
< |
begin |
4110 |
< |
if (Field.DataType = ftBCD) and not NativeFormat then |
4111 |
< |
Result := InternalGetFieldData(Field, Buffer) |
4112 |
< |
else |
4113 |
< |
Result := inherited GetFieldData(Field, Buffer, NativeFormat); |
4114 |
< |
end; |
4115 |
< |
|
4116 |
< |
procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer); |
4117 |
< |
{$IFDEF TDBDFIELD_IS_BCD} |
4118 |
< |
var |
4119 |
< |
lTempCurr : System.Currency; |
4120 |
< |
begin |
4121 |
< |
if (Field.DataType = ftBCD) and (Buffer <> nil) then |
4122 |
< |
begin |
4123 |
< |
BCDToCurr(TBCD(Buffer^), lTempCurr); |
4124 |
< |
InternalSetFieldData(Field, @lTempCurr); |
4125 |
< |
end |
4126 |
< |
else |
4127 |
< |
{$ELSE} |
4128 |
< |
begin |
4129 |
< |
{$ENDIF} |
4130 |
< |
InternalSetFieldData(Field, Buffer); |
4131 |
< |
end; |
4132 |
< |
|
4133 |
< |
procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer; |
4134 |
< |
NativeFormat: Boolean); |
4135 |
< |
begin |
4136 |
< |
if (not NativeFormat) and (Field.DataType = ftBCD) then |
4137 |
< |
InternalSetfieldData(Field, Buffer) |
4138 |
< |
else |
4139 |
< |
inherited SetFieldData(Field, buffer, NativeFormat); |
4140 |
< |
end; |
4141 |
< |
|
4142 |
< |
{ TIBDataSetUpdateObject } |
4143 |
< |
|
4144 |
< |
constructor TIBDataSetUpdateObject.Create(AOwner: TComponent); |
4145 |
< |
begin |
4146 |
< |
inherited Create(AOwner); |
4147 |
< |
FRefreshSQL := TStringList.Create; |
4148 |
< |
end; |
4149 |
< |
|
4150 |
< |
destructor TIBDataSetUpdateObject.Destroy; |
4151 |
< |
begin |
4152 |
< |
FRefreshSQL.Free; |
4153 |
< |
inherited Destroy; |
4154 |
< |
end; |
4155 |
< |
|
4156 |
< |
procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings); |
4157 |
< |
begin |
4158 |
< |
FRefreshSQL.Assign(Value); |
4159 |
< |
end; |
4160 |
< |
|
4161 |
< |
procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar); |
4162 |
< |
begin |
4163 |
< |
if not Assigned(DataSet) then Exit; |
4164 |
< |
DataSet.SetInternalSQLParams(Query, buff); |
4165 |
< |
end; |
4166 |
< |
|
4167 |
< |
{ TIBDSBlobStream } |
4168 |
< |
constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream; |
4169 |
< |
Mode: TBlobStreamMode); |
4170 |
< |
begin |
4171 |
< |
FField := AField; |
4172 |
< |
FBlobStream := ABlobStream; |
4173 |
< |
FBlobStream.Seek(0, soFromBeginning); |
4174 |
< |
if (Mode = bmWrite) then |
4175 |
< |
FBlobStream.Truncate; |
4176 |
< |
end; |
4177 |
< |
|
4178 |
< |
function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint; |
4179 |
< |
begin |
4180 |
< |
result := FBlobStream.Read(Buffer, Count); |
4181 |
< |
end; |
4182 |
< |
|
4183 |
< |
function TIBDSBlobStream.Seek(Offset: Longint; Origin: Word): Longint; |
4184 |
< |
begin |
4185 |
< |
result := FBlobStream.Seek(Offset, Origin); |
4186 |
< |
end; |
4187 |
< |
|
4188 |
< |
procedure TIBDSBlobStream.SetSize(NewSize: Longint); |
4189 |
< |
begin |
4190 |
< |
FBlobStream.SetSize(NewSize); |
4191 |
< |
end; |
4192 |
< |
|
4193 |
< |
function TIBDSBlobStream.Write(const Buffer; Count: Longint): Longint; |
4194 |
< |
begin |
4195 |
< |
if not (FField.DataSet.State in [dsEdit, dsInsert]) then |
4196 |
< |
IBError(ibxeNotEditing, [nil]); |
4197 |
< |
TIBCustomDataSet(FField.DataSet).RecordModified(True); |
4198 |
< |
TBlobField(FField).Modified := true; |
4199 |
< |
result := FBlobStream.Write(Buffer, Count); |
4200 |
< |
TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField)); |
4201 |
< |
end; |
4202 |
< |
|
4203 |
< |
{ TIBGenerator } |
4204 |
< |
|
4205 |
< |
procedure TIBGenerator.SetIncrement(const AValue: integer); |
4206 |
< |
begin |
4207 |
< |
if AValue < 0 then |
4208 |
< |
raise Exception.Create('A Generator Increment cannot be negative'); |
4209 |
< |
FIncrement := AValue |
4210 |
< |
end; |
4211 |
< |
|
4212 |
< |
function TIBGenerator.GetNextValue(ADatabase: TIBDatabase; |
4213 |
< |
ATransaction: TIBTransaction): integer; |
4214 |
< |
begin |
4215 |
< |
with TIBSQL.Create(nil) do |
4216 |
< |
try |
4217 |
< |
Database := ADatabase; |
4218 |
< |
Transaction := ATransaction; |
4219 |
< |
if not assigned(Database) then |
4220 |
< |
IBError(ibxeCannotSetDatabase,[]); |
4221 |
< |
if not assigned(Transaction) then |
4222 |
< |
IBError(ibxeCannotSetTransaction,[]); |
4223 |
< |
with Transaction do |
4224 |
< |
if not InTransaction then StartTransaction; |
4225 |
< |
SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[FGeneratorName,Increment]); |
4226 |
< |
Prepare; |
4227 |
< |
ExecQuery; |
4228 |
< |
try |
4229 |
< |
Result := FieldByName('ID').AsInteger |
4230 |
< |
finally |
4231 |
< |
Close |
4232 |
< |
end; |
4233 |
< |
finally |
4234 |
< |
Free |
4235 |
< |
end; |
4236 |
< |
end; |
4237 |
< |
|
4238 |
< |
constructor TIBGenerator.Create(Owner: TIBCustomDataSet); |
4239 |
< |
begin |
4240 |
< |
FOwner := Owner; |
4241 |
< |
FIncrement := 1; |
4242 |
< |
end; |
4243 |
< |
|
4244 |
< |
|
4245 |
< |
procedure TIBGenerator.Apply; |
4246 |
< |
begin |
4247 |
< |
if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then |
4248 |
< |
Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction); |
4249 |
< |
end; |
4250 |
< |
|
4251 |
< |
end. |
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 |
> |
{ IBX For Lazarus (Firebird Express) } |
28 |
> |
{ Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk } |
29 |
> |
{ Portions created by MWA Software are copyright McCallum Whyman } |
30 |
> |
{ Associates Ltd 2011 - 2015 } |
31 |
> |
{ } |
32 |
> |
{************************************************************************} |
33 |
> |
|
34 |
> |
unit IBCustomDataSet; |
35 |
> |
|
36 |
> |
{$R-} |
37 |
> |
|
38 |
> |
{$IFDEF FPC} |
39 |
> |
{$Mode Delphi} |
40 |
> |
{$codepage UTF8} |
41 |
> |
{$ENDIF} |
42 |
> |
|
43 |
> |
{$IFDEF DELPHI} |
44 |
> |
{$DEFINE TDBDFIELD_IS_BCD} |
45 |
> |
{$ENDIF} |
46 |
> |
|
47 |
> |
interface |
48 |
> |
|
49 |
> |
uses |
50 |
> |
{$IFDEF WINDOWS } |
51 |
> |
Windows, |
52 |
> |
{$ELSE} |
53 |
> |
unix, |
54 |
> |
{$ENDIF} |
55 |
> |
SysUtils, Classes, IBDatabase, IBExternals, IB, IBSQL, Db, |
56 |
> |
IBUtils, IBBlob, IBSQLParser, IBDatabaseInfo; |
57 |
> |
|
58 |
> |
const |
59 |
> |
BufferCacheSize = 1000; { Allocate cache in this many record chunks} |
60 |
> |
UniCache = 2; { Uni-directional cache is 2 records big } |
61 |
> |
|
62 |
> |
type |
63 |
> |
TIBCustomDataSet = class; |
64 |
> |
TIBDataSet = class; |
65 |
> |
|
66 |
> |
{ TIBDataSetUpdateObject } |
67 |
> |
|
68 |
> |
TIBDataSetUpdateObject = class(TComponent) |
69 |
> |
private |
70 |
> |
FRefreshSQL: TStrings; |
71 |
> |
procedure SetRefreshSQL(value: TStrings); |
72 |
> |
protected |
73 |
> |
function GetDataSet: TIBCustomDataSet; virtual; abstract; |
74 |
> |
procedure SetDataSet(ADataSet: TIBCustomDataSet); virtual; abstract; |
75 |
> |
procedure Apply(UpdateKind: TUpdateKind; buff: PChar); virtual; abstract; |
76 |
> |
function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract; |
77 |
> |
procedure InternalSetParams(Params: ISQLParams; buff: PChar); overload; |
78 |
> |
procedure InternalSetParams(Query: TIBSQL; buff: PChar); overload; |
79 |
> |
procedure UpdateRecordFromQuery(QryResults: IResults; Buffer: PChar); |
80 |
> |
property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet; |
81 |
> |
public |
82 |
> |
constructor Create(AOwner: TComponent); override; |
83 |
> |
destructor Destroy; override; |
84 |
> |
published |
85 |
> |
property RefreshSQL: TStrings read FRefreshSQL write SetRefreshSQL; |
86 |
> |
end; |
87 |
> |
|
88 |
> |
TBlobDataArray = array[0..0] of TIBBlobStream; |
89 |
> |
PBlobDataArray = ^TBlobDataArray; |
90 |
> |
TIBArrayField = class; |
91 |
> |
|
92 |
> |
{ TIBArray } |
93 |
> |
|
94 |
> |
{Wrapper class to support array cache in TIBCustomDataset and event handling} |
95 |
> |
|
96 |
> |
TIBArray = class |
97 |
> |
private |
98 |
> |
FArray: IArray; |
99 |
> |
FRecNo: integer; |
100 |
> |
FField: TIBArrayField; |
101 |
> |
procedure EventHandler(Sender: IArray; Reason: TArrayEventReason); |
102 |
> |
public |
103 |
> |
constructor Create(aField: TIBArrayField; anArray: IArray); |
104 |
> |
destructor Destroy; override; |
105 |
> |
property ArrayIntf: IArray read FArray; |
106 |
> |
end; |
107 |
> |
|
108 |
> |
TArrayDataArray = array [0..0] of TIBArray; |
109 |
> |
PArrayDataArray = ^TArrayDataArray; |
110 |
> |
|
111 |
> |
{ TIBCustomDataSet } |
112 |
> |
|
113 |
> |
TCachedUpdateStatus = ( |
114 |
> |
cusUnmodified, cusModified, cusInserted, |
115 |
> |
cusDeleted, cusUninserted |
116 |
> |
); |
117 |
> |
TIBDBKey = record |
118 |
> |
DBKey: array[0..7] of Byte; |
119 |
> |
end; |
120 |
> |
PIBDBKey = ^TIBDBKey; |
121 |
> |
|
122 |
> |
PFieldData = ^TFieldData; |
123 |
> |
TFieldData = record |
124 |
> |
fdIsNull: Boolean; |
125 |
> |
fdDataLength: Short; |
126 |
> |
end; |
127 |
> |
|
128 |
> |
PColumnData = ^TColumnData; |
129 |
> |
TColumnData = record |
130 |
> |
fdDataType: Short; |
131 |
> |
fdDataScale: Short; |
132 |
> |
fdNullable: Boolean; |
133 |
> |
fdDataSize: Short; |
134 |
> |
fdDataOfs: Integer; |
135 |
> |
fdCodePage: TSystemCodePage; |
136 |
> |
end; |
137 |
> |
|
138 |
> |
PFieldColumns = ^TFieldColumns; |
139 |
> |
TFieldColumns = array[1..1] of TColumnData; |
140 |
> |
|
141 |
> |
TRecordData = record |
142 |
> |
rdBookmarkFlag: TBookmarkFlag; |
143 |
> |
rdFieldCount: Short; |
144 |
> |
rdRecordNumber: Integer; |
145 |
> |
rdCachedUpdateStatus: TCachedUpdateStatus; |
146 |
> |
rdUpdateStatus: TUpdateStatus; |
147 |
> |
rdSavedOffset: DWORD; |
148 |
> |
rdDBKey: TIBDBKey; |
149 |
> |
rdFields: array[1..1] of TFieldData; |
150 |
> |
end; |
151 |
> |
PRecordData = ^TRecordData; |
152 |
> |
|
153 |
> |
{ TIBArrayField } |
154 |
> |
|
155 |
> |
TIBArrayField = class(TField) |
156 |
> |
private |
157 |
> |
FArrayBounds: TArrayBounds; |
158 |
> |
FArrayDimensions: integer; |
159 |
> |
FRelationName: string; |
160 |
> |
FCacheOffset: word; |
161 |
> |
function GetArrayID: TISC_QUAD; |
162 |
> |
function GetArrayIntf: IArray; |
163 |
> |
procedure SetArrayIntf(AValue: IArray); |
164 |
> |
protected |
165 |
> |
class procedure CheckTypeSize(AValue: Longint); override; |
166 |
> |
function GetAsString: string; override; |
167 |
> |
function GetDataSize: Integer; override; |
168 |
> |
procedure Bind(Binding: Boolean); override; |
169 |
> |
public |
170 |
> |
constructor Create(AOwner: TComponent); override; |
171 |
> |
function CreateArray: IArray; |
172 |
> |
property ArrayID: TISC_QUAD read GetArrayID; |
173 |
> |
property ArrayIntf: IArray read GetArrayIntf write SetArrayIntf; |
174 |
> |
property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions; |
175 |
> |
property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds; |
176 |
> |
end; |
177 |
> |
|
178 |
> |
{ TIBStringField allows us to have strings longer than 8196 } |
179 |
> |
|
180 |
> |
TIBStringField = class(TStringField) |
181 |
> |
private |
182 |
> |
FCharacterSetName: RawByteString; |
183 |
> |
FCharacterSetSize: integer; |
184 |
> |
FAutoFieldSize: boolean; |
185 |
> |
FCodePage: TSystemCodePage; |
186 |
> |
FDataSize: integer; |
187 |
> |
protected |
188 |
> |
procedure Bind(Binding: Boolean); override; |
189 |
> |
function GetDataSize: Integer; override; |
190 |
> |
public |
191 |
> |
constructor Create(aOwner: TComponent); override; |
192 |
> |
class procedure CheckTypeSize(Value: Integer); override; |
193 |
> |
function GetAsString: string; override; |
194 |
> |
function GetAsVariant: Variant; override; |
195 |
> |
function GetValue(var Value: string): Boolean; |
196 |
> |
procedure SetAsString(const Value: string); override; |
197 |
> |
property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName; |
198 |
> |
property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize; |
199 |
> |
property CodePage: TSystemCodePage read FCodePage write FCodePage; |
200 |
> |
published |
201 |
> |
property AutoFieldSize: boolean read FAutoFieldSize write FAutoFieldSize default true; |
202 |
> |
end; |
203 |
> |
|
204 |
> |
{ TIBBCDField } |
205 |
> |
{ Actually, there is no BCD involved in this type, |
206 |
> |
instead it deals with currency types. |
207 |
> |
In IB, this is an encapsulation of Numeric (x, y) |
208 |
> |
where x < 18 and y <= 4. |
209 |
> |
Note: y > 4 will default to Floats |
210 |
> |
} |
211 |
> |
TIBBCDField = class(TBCDField) |
212 |
> |
private |
213 |
> |
FIdentityColumn: boolean; |
214 |
> |
protected |
215 |
> |
procedure Bind(Binding: Boolean); override; |
216 |
> |
class procedure CheckTypeSize(Value: Integer); override; |
217 |
> |
function GetAsCurrency: Currency; override; |
218 |
> |
function GetAsString: string; override; |
219 |
> |
function GetAsVariant: Variant; override; |
220 |
> |
function GetDataSize: Integer; override; |
221 |
> |
public |
222 |
> |
constructor Create(AOwner: TComponent); override; |
223 |
> |
property IdentityColumn: boolean read FIdentityColumn; |
224 |
> |
published |
225 |
> |
property Size default 8; |
226 |
> |
end; |
227 |
> |
|
228 |
> |
{The following integer field types extend the built in versions to enable IBX appplications |
229 |
> |
to check for an Identity column} |
230 |
> |
|
231 |
> |
{ TIBSmallintField } |
232 |
> |
|
233 |
> |
TIBSmallintField = class(TSmallintField) |
234 |
> |
private |
235 |
> |
FIdentityColumn: boolean; |
236 |
> |
protected |
237 |
> |
procedure Bind(Binding: Boolean); override; |
238 |
> |
public |
239 |
> |
property IdentityColumn: boolean read FIdentityColumn; |
240 |
> |
end; |
241 |
> |
|
242 |
> |
{ TIBIntegerField } |
243 |
> |
|
244 |
> |
TIBIntegerField = class(TIntegerField) |
245 |
> |
private |
246 |
> |
FIdentityColumn: boolean; |
247 |
> |
protected |
248 |
> |
procedure Bind(Binding: Boolean); override; |
249 |
> |
public |
250 |
> |
property IdentityColumn: boolean read FIdentityColumn; |
251 |
> |
end; |
252 |
> |
|
253 |
> |
{ TIBLargeIntField } |
254 |
> |
|
255 |
> |
TIBLargeIntField = class(TLargeIntField) |
256 |
> |
private |
257 |
> |
FIdentityColumn: boolean; |
258 |
> |
protected |
259 |
> |
procedure Bind(Binding: Boolean); override; |
260 |
> |
public |
261 |
> |
property IdentityColumn: boolean read FIdentityColumn; |
262 |
> |
end; |
263 |
> |
|
264 |
> |
{TIBMemoField} |
265 |
> |
{Allows us to show truncated text in DBGrids and anything else that uses |
266 |
> |
DisplayText} |
267 |
> |
|
268 |
> |
TIBMemoField = class(TMemoField) |
269 |
> |
private |
270 |
> |
FCharacterSetName: RawByteString; |
271 |
> |
FCharacterSetSize: integer; |
272 |
> |
FDisplayTextAsClassName: boolean; |
273 |
> |
function GetTruncatedText: string; |
274 |
> |
protected |
275 |
> |
procedure Bind(Binding: Boolean); override; |
276 |
> |
function GetAsString: string; override; |
277 |
> |
function GetDefaultWidth: Longint; override; |
278 |
> |
procedure GetText(var AText: string; ADisplayText: Boolean); override; |
279 |
> |
procedure SetAsString(const AValue: string); override; |
280 |
> |
public |
281 |
> |
constructor Create(AOwner: TComponent); override; |
282 |
> |
property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName; |
283 |
> |
property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize; |
284 |
> |
published |
285 |
> |
property DisplayTextAsClassName: boolean read FDisplayTextAsClassName |
286 |
> |
write FDisplayTextAsClassName; |
287 |
> |
private |
288 |
> |
FCodePage: TSystemCodePage; |
289 |
> |
FFCodePage: TSystemCodePage; |
290 |
> |
public |
291 |
> |
property CodePage: TSystemCodePage read FFCodePage write FFCodePage; |
292 |
> |
end; |
293 |
> |
|
294 |
> |
TIBDataLink = class(TDetailDataLink) |
295 |
> |
private |
296 |
> |
FDataSet: TIBCustomDataSet; |
297 |
> |
protected |
298 |
> |
procedure ActiveChanged; override; |
299 |
> |
procedure RecordChanged(Field: TField); override; |
300 |
> |
function GetDetailDataSet: TDataSet; override; |
301 |
> |
procedure CheckBrowseMode; override; |
302 |
> |
public |
303 |
> |
constructor Create(ADataSet: TIBCustomDataSet); |
304 |
> |
destructor Destroy; override; |
305 |
> |
end; |
306 |
> |
|
307 |
> |
TIBGeneratorApplyOnEvent = (gaeOnNewRecord,gaeOnPostRecord); |
308 |
> |
|
309 |
> |
{ TIBGenerator } |
310 |
> |
|
311 |
> |
TIBGenerator = class(TPersistent) |
312 |
> |
private |
313 |
> |
FOwner: TIBCustomDataSet; |
314 |
> |
FApplyOnEvent: TIBGeneratorApplyOnEvent; |
315 |
> |
FFieldName: string; |
316 |
> |
FGeneratorName: string; |
317 |
> |
FIncrement: integer; |
318 |
> |
FQuery: TIBSQL; |
319 |
> |
function GetDatabase: TIBDatabase; |
320 |
> |
function GetTransaction: TIBTransaction; |
321 |
> |
procedure SetDatabase(AValue: TIBDatabase); |
322 |
> |
procedure SetGeneratorName(AValue: string); |
323 |
> |
procedure SetIncrement(const AValue: integer); |
324 |
> |
procedure SetTransaction(AValue: TIBTransaction); |
325 |
> |
procedure SetQuerySQL; |
326 |
> |
protected |
327 |
> |
function GetNextValue: integer; |
328 |
> |
public |
329 |
> |
constructor Create(Owner: TIBCustomDataSet); |
330 |
> |
destructor Destroy; override; |
331 |
> |
procedure Apply; |
332 |
> |
property Owner: TIBCustomDataSet read FOwner; |
333 |
> |
property Database: TIBDatabase read GetDatabase write SetDatabase; |
334 |
> |
property Transaction: TIBTransaction read GetTransaction write SetTransaction; |
335 |
> |
published |
336 |
> |
property Generator: string read FGeneratorName write SetGeneratorName; |
337 |
> |
property Field: string read FFieldName write FFieldName; |
338 |
> |
property Increment: integer read FIncrement write SetIncrement default 1; |
339 |
> |
property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent; |
340 |
> |
end; |
341 |
> |
|
342 |
> |
{TIBControlLink - Allows IB Aware controls to react to dataset state changes} |
343 |
> |
|
344 |
> |
TIBControlLink = class |
345 |
> |
private |
346 |
> |
FTIBDataSet: TIBCustomDataSet; |
347 |
> |
procedure SetIBDataSet(AValue: TIBCustomDataSet); |
348 |
> |
protected |
349 |
> |
procedure UpdateSQL(Sender: TObject); virtual; |
350 |
> |
procedure UpdateParams(Sender: TObject); virtual; |
351 |
> |
public |
352 |
> |
destructor Destroy; override; |
353 |
> |
property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet; |
354 |
> |
end; |
355 |
> |
|
356 |
> |
TIBAutoCommit = (acDisabled, acCommitRetaining); |
357 |
> |
|
358 |
> |
{ TIBCustomDataSet } |
359 |
> |
|
360 |
> |
TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied); |
361 |
> |
|
362 |
> |
TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError; |
363 |
> |
UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction) |
364 |
> |
of object; |
365 |
> |
TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind; |
366 |
> |
var UpdateAction: TIBUpdateAction) of object; |
367 |
> |
|
368 |
> |
TIBUpdateRecordTypes = set of TCachedUpdateStatus; |
369 |
> |
|
370 |
> |
TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges); |
371 |
> |
|
372 |
> |
TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object; |
373 |
> |
|
374 |
> |
TIBCustomDataSet = class(TDataset) |
375 |
> |
private |
376 |
> |
FAllowAutoActivateTransaction: Boolean; |
377 |
> |
FArrayFieldCount: integer; |
378 |
> |
FArrayCacheOffset: integer; |
379 |
> |
FAutoCommit: TIBAutoCommit; |
380 |
> |
FGenerateParamNames: Boolean; |
381 |
> |
FGeneratorField: TIBGenerator; |
382 |
> |
FNeedsRefresh: Boolean; |
383 |
> |
FForcedRefresh: Boolean; |
384 |
> |
FDidActivate: Boolean; |
385 |
> |
FBase: TIBBase; |
386 |
> |
FBlobCacheOffset: Integer; |
387 |
> |
FBlobStreamList: TList; |
388 |
> |
FArrayList: TList; |
389 |
> |
FBufferChunks: Integer; |
390 |
> |
FBufferCache, |
391 |
> |
FOldBufferCache: PChar; |
392 |
> |
FBufferChunkSize, |
393 |
> |
FCacheSize, |
394 |
> |
FOldCacheSize: Integer; |
395 |
> |
FFilterBuffer: PChar; |
396 |
> |
FBPos, |
397 |
> |
FOBPos, |
398 |
> |
FBEnd, |
399 |
> |
FOBEnd: DWord; |
400 |
> |
FCachedUpdates: Boolean; |
401 |
> |
FCalcFieldsOffset: Integer; |
402 |
> |
FCurrentRecord: Long; |
403 |
> |
FDeletedRecords: Long; |
404 |
> |
FModelBuffer, |
405 |
> |
FOldBuffer: PChar; |
406 |
> |
FOnValidatePost: TOnValidatePost; |
407 |
> |
FOpen: Boolean; |
408 |
> |
FInternalPrepared: Boolean; |
409 |
> |
FQDelete, |
410 |
> |
FQInsert, |
411 |
> |
FQRefresh, |
412 |
> |
FQSelect, |
413 |
> |
FQModify: TIBSQL; |
414 |
> |
FDatabaseInfo: TIBDatabaseInfo; |
415 |
> |
FRecordBufferSize: Integer; |
416 |
> |
FRecordCount: Integer; |
417 |
> |
FRecordSize: Integer; |
418 |
> |
FDataSetCloseAction: TDataSetCloseAction; |
419 |
> |
FUniDirectional: Boolean; |
420 |
> |
FUpdateMode: TUpdateMode; |
421 |
> |
FUpdateObject: TIBDataSetUpdateObject; |
422 |
> |
FParamCheck: Boolean; |
423 |
> |
FUpdatesPending: Boolean; |
424 |
> |
FUpdateRecordTypes: TIBUpdateRecordTypes; |
425 |
> |
FMappedFieldPosition: array of Integer; |
426 |
> |
FDataLink: TIBDataLink; |
427 |
> |
|
428 |
> |
FBeforeDatabaseDisconnect, |
429 |
> |
FAfterDatabaseDisconnect, |
430 |
> |
FDatabaseFree: TNotifyEvent; |
431 |
> |
FOnUpdateError: TIBUpdateErrorEvent; |
432 |
> |
FOnUpdateRecord: TIBUpdateRecordEvent; |
433 |
> |
FBeforeTransactionEnd, |
434 |
> |
FAfterTransactionEnd, |
435 |
> |
FTransactionFree: TNotifyEvent; |
436 |
> |
FAliasNameMap: array of string; |
437 |
> |
FAliasNameList: array of string; |
438 |
> |
FBaseSQLSelect: TStrings; |
439 |
> |
FParser: TSelectSQLParser; |
440 |
> |
FCloseAction: TTransactionAction; |
441 |
> |
FInTransactionEnd: boolean; |
442 |
> |
FIBLinks: TList; |
443 |
> |
FFieldColumns: PFieldColumns; |
444 |
> |
procedure ColumnDataToBuffer(QryResults: IResults; ColumnIndex, |
445 |
> |
FieldIndex: integer; Buffer: PChar); |
446 |
> |
procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar); |
447 |
> |
function GetSelectStmtIntf: IStatement; |
448 |
> |
procedure SetUpdateMode(const Value: TUpdateMode); |
449 |
> |
procedure SetUpdateObject(Value: TIBDataSetUpdateObject); |
450 |
> |
|
451 |
> |
function AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode): TGetResult; |
452 |
> |
procedure AdjustRecordOnInsert(Buffer: Pointer); |
453 |
> |
function CanEdit: Boolean; |
454 |
> |
function CanInsert: Boolean; |
455 |
> |
function CanDelete: Boolean; |
456 |
> |
function CanRefresh: Boolean; |
457 |
> |
procedure CheckEditState; |
458 |
> |
procedure ClearBlobCache; |
459 |
> |
procedure ClearArrayCache; |
460 |
> |
procedure ClearIBLinks; |
461 |
> |
procedure CopyRecordBuffer(Source, Dest: Pointer); |
462 |
> |
procedure DoBeforeDatabaseDisconnect(Sender: TObject); |
463 |
> |
procedure DoAfterDatabaseDisconnect(Sender: TObject); |
464 |
> |
procedure DoDatabaseFree(Sender: TObject); |
465 |
> |
procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction); |
466 |
> |
procedure DoAfterTransactionEnd(Sender: TObject); |
467 |
> |
procedure DoTransactionFree(Sender: TObject); |
468 |
> |
procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer; |
469 |
> |
Buffer: PChar); |
470 |
> |
function GetDatabase: TIBDatabase; |
471 |
> |
function GetDeleteSQL: TStrings; |
472 |
> |
function GetInsertSQL: TStrings; |
473 |
> |
function GetSQLParams: ISQLParams; |
474 |
> |
function GetRefreshSQL: TStrings; |
475 |
> |
function GetSelectSQL: TStrings; |
476 |
> |
function GetStatementType: TIBSQLStatementTypes; |
477 |
> |
function GetModifySQL: TStrings; |
478 |
> |
function GetTransaction: TIBTransaction; |
479 |
> |
function GetParser: TSelectSQLParser; |
480 |
> |
procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual; |
481 |
> |
function InternalLocate(const KeyFields: string; const KeyValues: Variant; |
482 |
> |
Options: TLocateOptions): Boolean; virtual; |
483 |
> |
procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual; |
484 |
> |
procedure InternalRevertRecord(RecordNumber: Integer); virtual; |
485 |
> |
function IsVisible(Buffer: PChar): Boolean; |
486 |
> |
procedure RegisterIBLink(Sender: TIBControlLink); |
487 |
> |
procedure UnRegisterIBLink(Sender: TIBControlLink); |
488 |
> |
procedure SaveOldBuffer(Buffer: PChar); |
489 |
> |
procedure SetBufferChunks(Value: Integer); |
490 |
> |
procedure SetDatabase(Value: TIBDatabase); |
491 |
> |
procedure SetDeleteSQL(Value: TStrings); |
492 |
> |
procedure SetInsertSQL(Value: TStrings); |
493 |
> |
procedure SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer); |
494 |
> |
procedure SetRefreshSQL(Value: TStrings); |
495 |
> |
procedure SetSelectSQL(Value: TStrings); |
496 |
> |
procedure SetModifySQL(Value: TStrings); |
497 |
> |
procedure SetTransaction(Value: TIBTransaction); |
498 |
> |
procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes); |
499 |
> |
procedure SetUniDirectional(Value: Boolean); |
500 |
> |
procedure UpdateRecordFromQuery(QryResults: IResults; Buffer: PChar); |
501 |
> |
procedure RefreshParams; |
502 |
> |
function AdjustPosition(FCache: PChar; Offset: DWORD; |
503 |
> |
Origin: Integer): DWORD; |
504 |
> |
procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer; |
505 |
> |
Buffer: PChar); |
506 |
> |
procedure ReadRecordCache(RecordNumber: Integer; Buffer: PChar; |
507 |
> |
ReadOldBuffer: Boolean); |
508 |
> |
procedure WriteCache(FCache: PChar; Offset: DWORD; Origin: Integer; |
509 |
> |
Buffer: PChar); |
510 |
> |
procedure WriteRecordCache(RecordNumber: Integer; Buffer: PChar); |
511 |
> |
function InternalGetRecord(Buffer: PChar; GetMode: TGetMode; |
512 |
> |
DoCheck: Boolean): TGetResult; virtual; |
513 |
> |
|
514 |
> |
protected |
515 |
> |
procedure ActivateConnection; |
516 |
> |
function ActivateTransaction: Boolean; |
517 |
> |
procedure DeactivateTransaction; |
518 |
> |
procedure CheckDatasetClosed; |
519 |
> |
procedure CheckDatasetOpen; |
520 |
> |
function CreateParser: TSelectSQLParser; virtual; |
521 |
> |
procedure FieldDefsFromQuery(SourceQuery: TIBSQL); |
522 |
> |
function GetActiveBuf: PChar; |
523 |
> |
procedure InternalBatchInput(InputObject: TIBBatchInput); virtual; |
524 |
> |
procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual; |
525 |
> |
procedure InternalPrepare; virtual; |
526 |
> |
procedure InternalUnPrepare; virtual; |
527 |
> |
procedure InternalExecQuery; virtual; |
528 |
> |
procedure InternalRefreshRow; virtual; |
529 |
> |
procedure InternalSetParamsFromCursor; virtual; |
530 |
> |
procedure CheckNotUniDirectional; |
531 |
> |
procedure SQLChanging(Sender: TObject); virtual; |
532 |
> |
procedure SQLChanged(Sender: TObject); virtual; |
533 |
> |
|
534 |
> |
{ IProviderSupport } |
535 |
> |
procedure PSEndTransaction(Commit: Boolean); override; |
536 |
> |
function PSExecuteStatement(const ASQL: string; AParams: TParams; |
537 |
> |
ResultSet: Pointer = nil): Integer; override; |
538 |
> |
function PsGetTableName: string; override; |
539 |
> |
function PSGetQuoteChar: string; override; |
540 |
> |
function PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; override; |
541 |
> |
function PSInTransaction: Boolean; override; |
542 |
> |
function PSIsSQLBased: Boolean; override; |
543 |
> |
function PSIsSQLSupported: Boolean; override; |
544 |
> |
procedure PSStartTransaction; override; |
545 |
> |
procedure PSReset; override; |
546 |
> |
function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override; |
547 |
> |
|
548 |
> |
{ TDataSet support } |
549 |
> |
procedure InternalInsert; override; |
550 |
> |
procedure InitRecord(Buffer: PChar); override; |
551 |
> |
procedure Disconnect; virtual; |
552 |
> |
function ConstraintsStored: Boolean; |
553 |
> |
procedure ClearCalcFields(Buffer: PChar); override; |
554 |
> |
function AllocRecordBuffer: PChar; override; |
555 |
> |
procedure DoBeforeDelete; override; |
556 |
> |
procedure DoAfterDelete; override; |
557 |
> |
procedure DoBeforeEdit; override; |
558 |
> |
procedure DoAfterEdit; override; |
559 |
> |
procedure DoBeforeInsert; override; |
560 |
> |
procedure DoAfterInsert; override; |
561 |
> |
procedure DoBeforeClose; override; |
562 |
> |
procedure DoBeforeOpen; override; |
563 |
> |
procedure DoBeforePost; override; |
564 |
> |
procedure DoAfterPost; override; |
565 |
> |
procedure FreeRecordBuffer(var Buffer: PChar); override; |
566 |
> |
procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override; |
567 |
> |
function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override; |
568 |
> |
function GetCanModify: Boolean; override; |
569 |
> |
function GetDataSource: TDataSource; override; |
570 |
> |
function GetDBAliasName(FieldNo: integer): string; |
571 |
> |
function GetFieldDefFromAlias(aliasName: string): TFieldDef; |
572 |
> |
function GetFieldClass(FieldType: TFieldType): TFieldClass; override; |
573 |
> |
function GetRecNo: Integer; override; |
574 |
> |
function GetRecord(Buffer: PChar; GetMode: TGetMode; |
575 |
> |
DoCheck: Boolean): TGetResult; override; |
576 |
> |
function GetRecordCount: Integer; override; |
577 |
> |
function GetRecordSize: Word; override; |
578 |
> |
procedure InternalAutoCommit; |
579 |
> |
procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override; |
580 |
> |
procedure InternalCancel; override; |
581 |
> |
procedure InternalClose; override; |
582 |
> |
procedure InternalDelete; override; |
583 |
> |
procedure InternalFirst; override; |
584 |
> |
function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual; |
585 |
> |
procedure InternalGotoBookmark(Bookmark: Pointer); override; |
586 |
> |
procedure InternalHandleException; override; |
587 |
> |
procedure InternalInitFieldDefs; override; |
588 |
> |
procedure InternalInitRecord(Buffer: PChar); override; |
589 |
> |
procedure InternalLast; override; |
590 |
> |
procedure InternalOpen; override; |
591 |
> |
procedure InternalPost; override; |
592 |
> |
procedure InternalRefresh; override; |
593 |
> |
procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual; |
594 |
> |
procedure InternalSetToRecord(Buffer: PChar); override; |
595 |
> |
function IsCursorOpen: Boolean; override; |
596 |
> |
procedure Loaded; override; |
597 |
> |
procedure ReQuery; |
598 |
> |
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override; |
599 |
> |
procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override; |
600 |
> |
procedure SetCachedUpdates(Value: Boolean); |
601 |
> |
procedure SetDataSource(Value: TDataSource); |
602 |
> |
procedure SetGenerateParamNames(AValue: Boolean); virtual; |
603 |
> |
procedure SetFieldData(Field : TField; Buffer : Pointer); override; |
604 |
> |
procedure SetFieldData(Field : TField; Buffer : Pointer; |
605 |
> |
NativeFormat : Boolean); overload; override; |
606 |
> |
procedure SetRecNo(Value: Integer); override; |
607 |
> |
|
608 |
> |
protected |
609 |
> |
{Likely to be made public by descendant classes} |
610 |
> |
property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled; |
611 |
> |
property SQLParams: ISQLParams read GetSQLParams; |
612 |
> |
property Params: ISQLParams read GetSQLParams; |
613 |
> |
property InternalPrepared: Boolean read FInternalPrepared; |
614 |
> |
property QDelete: TIBSQL read FQDelete; |
615 |
> |
property QInsert: TIBSQL read FQInsert; |
616 |
> |
property QRefresh: TIBSQL read FQRefresh; |
617 |
> |
property QSelect: TIBSQL read FQSelect; |
618 |
> |
property QModify: TIBSQL read FQModify; |
619 |
> |
property StatementType: TIBSQLStatementTypes read GetStatementType; |
620 |
> |
property SelectStmtHandle: IStatement read GetSelectStmtIntf; |
621 |
> |
|
622 |
> |
{Likely to be made published by descendant classes} |
623 |
> |
property BufferChunks: Integer read FBufferChunks write SetBufferChunks; |
624 |
> |
property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates; |
625 |
> |
property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False; |
626 |
> |
property GeneratorField: TIBGenerator read FGeneratorField write FGeneratorField; |
627 |
> |
property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL; |
628 |
> |
property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL; |
629 |
> |
property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL; |
630 |
> |
property SelectSQL: TStrings read GetSelectSQL write SetSelectSQL; |
631 |
> |
property ModifySQL: TStrings read GetModifySQL write SetModifySQL; |
632 |
> |
property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll; |
633 |
> |
property ParamCheck: Boolean read FParamCheck write FParamCheck default True; |
634 |
> |
property Parser: TSelectSQLParser read GetParser; |
635 |
> |
property BaseSQLSelect: TStrings read FBaseSQLSelect; |
636 |
> |
|
637 |
> |
property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect |
638 |
> |
write FBeforeDatabaseDisconnect; |
639 |
> |
property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect |
640 |
> |
write FAfterDatabaseDisconnect; |
641 |
> |
property DatabaseFree: TNotifyEvent read FDatabaseFree |
642 |
> |
write FDatabaseFree; |
643 |
> |
property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd |
644 |
> |
write FBeforeTransactionEnd; |
645 |
> |
property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd |
646 |
> |
write FAfterTransactionEnd; |
647 |
> |
property TransactionFree: TNotifyEvent read FTransactionFree |
648 |
> |
write FTransactionFree; |
649 |
> |
property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost; |
650 |
> |
|
651 |
> |
public |
652 |
> |
constructor Create(AOwner: TComponent); override; |
653 |
> |
destructor Destroy; override; |
654 |
> |
procedure ApplyUpdates; |
655 |
> |
function CachedUpdateStatus: TCachedUpdateStatus; |
656 |
> |
procedure CancelUpdates; |
657 |
> |
function GetFieldPosition(AliasName: string): integer; |
658 |
> |
procedure FetchAll; |
659 |
> |
function LocateNext(const KeyFields: string; const KeyValues: Variant; |
660 |
> |
Options: TLocateOptions): Boolean; |
661 |
> |
procedure RecordModified(Value: Boolean); |
662 |
> |
procedure RevertRecord; |
663 |
> |
procedure Undelete; |
664 |
> |
procedure ResetParser; virtual; |
665 |
> |
function HasParser: boolean; |
666 |
> |
|
667 |
> |
{ TDataSet support methods } |
668 |
> |
function BookmarkValid(Bookmark: TBookmark): Boolean; override; |
669 |
> |
function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override; |
670 |
> |
function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override; |
671 |
> |
function GetArray(Field: TIBArrayField): IArray; |
672 |
> |
procedure SetArrayIntf(AnArray: IArray; Field: TIBArrayField); |
673 |
> |
function GetCurrentRecord(Buffer: PChar): Boolean; override; |
674 |
> |
function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override; |
675 |
> |
function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*) |
676 |
> |
function GetFieldData(Field : TField; Buffer : Pointer; |
677 |
> |
NativeFormat : Boolean) : Boolean; overload; override; |
678 |
> |
property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames; |
679 |
> |
function Locate(const KeyFields: string; const KeyValues: Variant; |
680 |
> |
Options: TLocateOptions): Boolean; override; |
681 |
> |
function Lookup(const KeyFields: string; const KeyValues: Variant; |
682 |
> |
const ResultFields: string): Variant; override; |
683 |
> |
function UpdateStatus: TUpdateStatus; override; |
684 |
> |
function IsSequenced: Boolean; override; |
685 |
> |
procedure Post; override; |
686 |
> |
function ParamByName(ParamName: String): ISQLParam; |
687 |
> |
property ArrayFieldCount: integer read FArrayFieldCount; |
688 |
> |
property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject; |
689 |
> |
property UpdatesPending: Boolean read FUpdatesPending; |
690 |
> |
property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes |
691 |
> |
write SetUpdateRecordTypes; |
692 |
> |
property DataSetCloseAction: TDataSetCloseAction |
693 |
> |
read FDataSetCloseAction write FDataSetCloseAction; |
694 |
> |
|
695 |
> |
published |
696 |
> |
property AllowAutoActivateTransaction: Boolean read FAllowAutoActivateTransaction |
697 |
> |
write FAllowAutoActivateTransaction; |
698 |
> |
property Database: TIBDatabase read GetDatabase write SetDatabase; |
699 |
> |
property Transaction: TIBTransaction read GetTransaction |
700 |
> |
write SetTransaction; |
701 |
> |
property ForcedRefresh: Boolean read FForcedRefresh |
702 |
> |
write FForcedRefresh default False; |
703 |
> |
property AutoCalcFields; |
704 |
> |
|
705 |
> |
property AfterCancel; |
706 |
> |
property AfterClose; |
707 |
> |
property AfterDelete; |
708 |
> |
property AfterEdit; |
709 |
> |
property AfterInsert; |
710 |
> |
property AfterOpen; |
711 |
> |
property AfterPost; |
712 |
> |
property AfterRefresh; |
713 |
> |
property AfterScroll; |
714 |
> |
property BeforeCancel; |
715 |
> |
property BeforeClose; |
716 |
> |
property BeforeDelete; |
717 |
> |
property BeforeEdit; |
718 |
> |
property BeforeInsert; |
719 |
> |
property BeforeOpen; |
720 |
> |
property BeforePost; |
721 |
> |
property BeforeRefresh; |
722 |
> |
property BeforeScroll; |
723 |
> |
property OnCalcFields; |
724 |
> |
property OnDeleteError; |
725 |
> |
property OnEditError; |
726 |
> |
property OnNewRecord; |
727 |
> |
property OnPostError; |
728 |
> |
property OnUpdateError: TIBUpdateErrorEvent read FOnUpdateError |
729 |
> |
write FOnUpdateError; |
730 |
> |
property OnUpdateRecord: TIBUpdateRecordEvent read FOnUpdateRecord |
731 |
> |
write FOnUpdateRecord; |
732 |
> |
end; |
733 |
> |
|
734 |
> |
TIBParserDataSet = class(TIBCustomDataSet) |
735 |
> |
public |
736 |
> |
property Parser; |
737 |
> |
end; |
738 |
> |
|
739 |
> |
TIBDataSet = class(TIBParserDataSet) |
740 |
> |
private |
741 |
> |
function GetPrepared: Boolean; |
742 |
> |
|
743 |
> |
protected |
744 |
> |
procedure SetFiltered(Value: Boolean); override; |
745 |
> |
procedure InternalOpen; override; |
746 |
> |
|
747 |
> |
public |
748 |
> |
procedure Prepare; |
749 |
> |
procedure UnPrepare; |
750 |
> |
procedure BatchInput(InputObject: TIBBatchInput); |
751 |
> |
procedure BatchOutput(OutputObject: TIBBatchOutput); |
752 |
> |
procedure ExecSQL; |
753 |
> |
|
754 |
> |
public |
755 |
> |
property Params; |
756 |
> |
property Prepared : Boolean read GetPrepared; |
757 |
> |
property QDelete; |
758 |
> |
property QInsert; |
759 |
> |
property QRefresh; |
760 |
> |
property QSelect; |
761 |
> |
property QModify; |
762 |
> |
property StatementType; |
763 |
> |
property SelectStmtHandle; |
764 |
> |
property BaseSQLSelect; |
765 |
> |
|
766 |
> |
published |
767 |
> |
{ TIBCustomDataSet } |
768 |
> |
property AutoCommit; |
769 |
> |
property BufferChunks; |
770 |
> |
property CachedUpdates; |
771 |
> |
property DeleteSQL; |
772 |
> |
property InsertSQL; |
773 |
> |
property RefreshSQL; |
774 |
> |
property SelectSQL; |
775 |
> |
property ModifySQL; |
776 |
> |
property GeneratorField; |
777 |
> |
property GenerateParamNames; |
778 |
> |
property ParamCheck; |
779 |
> |
property UniDirectional; |
780 |
> |
property Filtered; |
781 |
> |
property DataSetCloseAction; |
782 |
> |
|
783 |
> |
property BeforeDatabaseDisconnect; |
784 |
> |
property AfterDatabaseDisconnect; |
785 |
> |
property DatabaseFree; |
786 |
> |
property BeforeTransactionEnd; |
787 |
> |
property AfterTransactionEnd; |
788 |
> |
property TransactionFree; |
789 |
> |
|
790 |
> |
{ TIBDataSet } |
791 |
> |
property Active; |
792 |
> |
property AutoCalcFields; |
793 |
> |
property DataSource read GetDataSource write SetDataSource; |
794 |
> |
|
795 |
> |
property AfterCancel; |
796 |
> |
property AfterClose; |
797 |
> |
property AfterDelete; |
798 |
> |
property AfterEdit; |
799 |
> |
property AfterInsert; |
800 |
> |
property AfterOpen; |
801 |
> |
property AfterPost; |
802 |
> |
property AfterScroll; |
803 |
> |
property BeforeCancel; |
804 |
> |
property BeforeClose; |
805 |
> |
property BeforeDelete; |
806 |
> |
property BeforeEdit; |
807 |
> |
property BeforeInsert; |
808 |
> |
property BeforeOpen; |
809 |
> |
property BeforePost; |
810 |
> |
property BeforeScroll; |
811 |
> |
property OnCalcFields; |
812 |
> |
property OnDeleteError; |
813 |
> |
property OnEditError; |
814 |
> |
property OnFilterRecord; |
815 |
> |
property OnNewRecord; |
816 |
> |
property OnPostError; |
817 |
> |
property OnValidatePost; |
818 |
> |
end; |
819 |
> |
|
820 |
> |
{ TIBDSBlobStream } |
821 |
> |
TIBDSBlobStream = class(TStream) |
822 |
> |
private |
823 |
> |
FHasWritten: boolean; |
824 |
> |
protected |
825 |
> |
FField: TField; |
826 |
> |
FBlobStream: TIBBlobStream; |
827 |
> |
function GetSize: Int64; override; |
828 |
> |
public |
829 |
> |
constructor Create(AField: TField; ABlobStream: TIBBlobStream; |
830 |
> |
Mode: TBlobStreamMode); |
831 |
> |
destructor Destroy; override; |
832 |
> |
function Read(var Buffer; Count: Longint): Longint; override; |
833 |
> |
function Seek(Offset: Longint; Origin: Word): Longint; override; |
834 |
> |
procedure SetSize(NewSize: Longint); override; |
835 |
> |
function Write(const Buffer; Count: Longint): Longint; override; |
836 |
> |
end; |
837 |
> |
|
838 |
> |
{Extended Field Def for character set info} |
839 |
> |
|
840 |
> |
{ TIBFieldDef } |
841 |
> |
|
842 |
> |
TIBFieldDef = class(TFieldDef) |
843 |
> |
private |
844 |
> |
FArrayBounds: TArrayBounds; |
845 |
> |
FArrayDimensions: integer; |
846 |
> |
FCharacterSetName: RawByteString; |
847 |
> |
FCharacterSetSize: integer; |
848 |
> |
FCodePage: TSystemCodePage; |
849 |
> |
FIdentityColumn: boolean; |
850 |
> |
FRelationName: string; |
851 |
> |
FDataSize: integer; |
852 |
> |
published |
853 |
> |
property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName; |
854 |
> |
property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize; |
855 |
> |
property CodePage: TSystemCodePage read FCodePage write FCodePage; |
856 |
> |
property DataSize: integer read FDataSize write FDataSize; |
857 |
> |
property RelationName: string read FRelationName write FRelationName; |
858 |
> |
property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions; |
859 |
> |
property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds; |
860 |
> |
property IdentityColumn: boolean read FIdentityColumn write FIdentityColumn default false; |
861 |
> |
end; |
862 |
> |
|
863 |
> |
const |
864 |
> |
DefaultFieldClasses: array[TFieldType] of TFieldClass = ( |
865 |
> |
nil, { ftUnknown } |
866 |
> |
TIBStringField, { ftString } |
867 |
> |
TIBSmallintField, { ftSmallint } |
868 |
> |
TIBIntegerField, { ftInteger } |
869 |
> |
TWordField, { ftWord } |
870 |
> |
TBooleanField, { ftBoolean } |
871 |
> |
TFloatField, { ftFloat } |
872 |
> |
TCurrencyField, { ftCurrency } |
873 |
> |
TIBBCDField, { ftBCD } |
874 |
> |
TDateField, { ftDate } |
875 |
> |
TTimeField, { ftTime } |
876 |
> |
TDateTimeField, { ftDateTime } |
877 |
> |
TBytesField, { ftBytes } |
878 |
> |
TVarBytesField, { ftVarBytes } |
879 |
> |
TAutoIncField, { ftAutoInc } |
880 |
> |
TBlobField, { ftBlob } |
881 |
> |
TIBMemoField, { ftMemo } |
882 |
> |
TGraphicField, { ftGraphic } |
883 |
> |
TBlobField, { ftFmtMemo } |
884 |
> |
TBlobField, { ftParadoxOle } |
885 |
> |
TBlobField, { ftDBaseOle } |
886 |
> |
TBlobField, { ftTypedBinary } |
887 |
> |
nil, { ftCursor } |
888 |
> |
TStringField, { ftFixedChar } |
889 |
> |
nil, { ftWideString } |
890 |
> |
TIBLargeIntField, { ftLargeInt } |
891 |
> |
nil, { ftADT } |
892 |
> |
TIBArrayField, { ftArray } |
893 |
> |
nil, { ftReference } |
894 |
> |
nil, { ftDataSet } |
895 |
> |
TBlobField, { ftOraBlob } |
896 |
> |
TMemoField, { ftOraClob } |
897 |
> |
TVariantField, { ftVariant } |
898 |
> |
nil, { ftInterface } |
899 |
> |
nil, { ftIDispatch } |
900 |
> |
TGuidField, { ftGuid } |
901 |
> |
TDateTimeField, {ftTimestamp} |
902 |
> |
TIBBCDField, {ftFMTBcd} |
903 |
> |
nil, {ftFixedWideChar} |
904 |
> |
nil); {ftWideMemo} |
905 |
> |
(* |
906 |
> |
TADTField, { ftADT } |
907 |
> |
TArrayField, { ftArray } |
908 |
> |
TReferenceField, { ftReference } |
909 |
> |
TDataSetField, { ftDataSet } |
910 |
> |
TBlobField, { ftOraBlob } |
911 |
> |
TMemoField, { ftOraClob } |
912 |
> |
TVariantField, { ftVariant } |
913 |
> |
TInterfaceField, { ftInterface } |
914 |
> |
TIDispatchField, { ftIDispatch } |
915 |
> |
TGuidField); { ftGuid } *) |
916 |
> |
(*var |
917 |
> |
CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;*) |
918 |
> |
|
919 |
> |
implementation |
920 |
> |
|
921 |
> |
uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery; |
922 |
> |
|
923 |
> |
const FILE_BEGIN = 0; |
924 |
> |
FILE_CURRENT = 1; |
925 |
> |
FILE_END = 2; |
926 |
> |
|
927 |
> |
type |
928 |
> |
|
929 |
> |
TFieldNode = class(TObject) |
930 |
> |
protected |
931 |
> |
FieldName : String; |
932 |
> |
COMPUTED_BLR : Boolean; |
933 |
> |
DEFAULT_VALUE : boolean; |
934 |
> |
IDENTITY_COLUMN : boolean; |
935 |
> |
NextField : TFieldNode; |
936 |
> |
end; |
937 |
> |
|
938 |
> |
TRelationNode = class(TObject) |
939 |
> |
protected |
940 |
> |
RelationName : String; |
941 |
> |
FieldNodes : TFieldNode; |
942 |
> |
NextRelation : TRelationNode; |
943 |
> |
end; |
944 |
> |
|
945 |
> |
|
946 |
> |
{ Copied from LCLProc in order to avoid LCL dependency |
947 |
> |
|
948 |
> |
Ensures the covenient look of multiline string |
949 |
> |
when displaying it in the single line |
950 |
> |
* Replaces CR and LF with spaces |
951 |
> |
* Removes duplicate spaces |
952 |
> |
} |
953 |
> |
function TextToSingleLine(const AText: string): string; |
954 |
> |
var |
955 |
> |
str: string; |
956 |
> |
i, wstart, wlen: Integer; |
957 |
> |
begin |
958 |
> |
str := Trim(AText); |
959 |
> |
wstart := 0; |
960 |
> |
wlen := 0; |
961 |
> |
i := 1; |
962 |
> |
while i < Length(str) - 1 do |
963 |
> |
begin |
964 |
> |
if (str[i] in [' ', #13, #10]) then |
965 |
> |
begin |
966 |
> |
if (wstart = 0) then |
967 |
> |
begin |
968 |
> |
wstart := i; |
969 |
> |
wlen := 1; |
970 |
> |
end else |
971 |
> |
Inc(wlen); |
972 |
> |
end else |
973 |
> |
begin |
974 |
> |
if wstart > 0 then |
975 |
> |
begin |
976 |
> |
str[wstart] := ' '; |
977 |
> |
Delete(str, wstart+1, wlen-1); |
978 |
> |
Dec(i, wlen-1); |
979 |
> |
wstart := 0; |
980 |
> |
end; |
981 |
> |
end; |
982 |
> |
Inc(i); |
983 |
> |
end; |
984 |
> |
Result := str; |
985 |
> |
end; |
986 |
> |
|
987 |
> |
{ TIBLargeIntField } |
988 |
> |
|
989 |
> |
procedure TIBLargeIntField.Bind(Binding: Boolean); |
990 |
> |
begin |
991 |
> |
inherited Bind(Binding); |
992 |
> |
if Binding and (FieldDef <> nil) then |
993 |
> |
FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn; |
994 |
> |
end; |
995 |
> |
|
996 |
> |
{ TIBIntegerField } |
997 |
> |
|
998 |
> |
procedure TIBIntegerField.Bind(Binding: Boolean); |
999 |
> |
begin |
1000 |
> |
inherited Bind(Binding); |
1001 |
> |
if Binding and (FieldDef <> nil) then |
1002 |
> |
FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn; |
1003 |
> |
end; |
1004 |
> |
|
1005 |
> |
{ TIBSmallintField } |
1006 |
> |
|
1007 |
> |
procedure TIBSmallintField.Bind(Binding: Boolean); |
1008 |
> |
begin |
1009 |
> |
inherited Bind(Binding); |
1010 |
> |
if Binding and (FieldDef <> nil) then |
1011 |
> |
FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn; |
1012 |
> |
end; |
1013 |
> |
|
1014 |
> |
{ TIBArray } |
1015 |
> |
|
1016 |
> |
procedure TIBArray.EventHandler(Sender: IArray; Reason: TArrayEventReason); |
1017 |
> |
begin |
1018 |
> |
case Reason of |
1019 |
> |
arChanging: |
1020 |
> |
if FRecNo <> FField.Dataset.RecNo then |
1021 |
> |
IBError(ibxeNotCurrentArray,[nil]); |
1022 |
> |
|
1023 |
> |
arChanged: |
1024 |
> |
FField.DataChanged; |
1025 |
> |
end; |
1026 |
> |
end; |
1027 |
> |
|
1028 |
> |
constructor TIBArray.Create(aField: TIBArrayField; anArray: IArray); |
1029 |
> |
begin |
1030 |
> |
inherited Create; |
1031 |
> |
FField := aField; |
1032 |
> |
FArray := anArray; |
1033 |
> |
FRecNo := FField.Dataset.RecNo; |
1034 |
> |
FArray.AddEventHandler(EventHandler); |
1035 |
> |
end; |
1036 |
> |
|
1037 |
> |
destructor TIBArray.Destroy; |
1038 |
> |
begin |
1039 |
> |
FArray.RemoveEventHandler(EventHandler); |
1040 |
> |
inherited Destroy; |
1041 |
> |
end; |
1042 |
> |
|
1043 |
> |
{ TIBArrayField } |
1044 |
> |
|
1045 |
> |
function TIBArrayField.GetArrayIntf: IArray; |
1046 |
> |
begin |
1047 |
> |
Result := TIBCustomDataSet(DataSet).GetArray(self); |
1048 |
> |
end; |
1049 |
> |
|
1050 |
> |
function TIBArrayField.GetArrayID: TISC_QUAD; |
1051 |
> |
begin |
1052 |
> |
GetData(@Result); |
1053 |
> |
end; |
1054 |
> |
|
1055 |
> |
procedure TIBArrayField.SetArrayIntf(AValue: IArray); |
1056 |
> |
begin |
1057 |
> |
TIBCustomDataSet(DataSet).SetArrayIntf(AValue,self); |
1058 |
> |
DataChanged; |
1059 |
> |
end; |
1060 |
> |
|
1061 |
> |
class procedure TIBArrayField.CheckTypeSize(AValue: Longint); |
1062 |
> |
begin |
1063 |
> |
//Ignore |
1064 |
> |
end; |
1065 |
> |
|
1066 |
> |
function TIBArrayField.GetAsString: string; |
1067 |
> |
begin |
1068 |
> |
Result := '(Array)'; |
1069 |
> |
end; |
1070 |
> |
|
1071 |
> |
function TIBArrayField.GetDataSize: Integer; |
1072 |
> |
begin |
1073 |
> |
Result := sizeof(TISC_QUAD); |
1074 |
> |
end; |
1075 |
> |
|
1076 |
> |
procedure TIBArrayField.Bind(Binding: Boolean); |
1077 |
> |
begin |
1078 |
> |
inherited Bind(Binding); |
1079 |
> |
if Binding then |
1080 |
> |
begin |
1081 |
> |
FCacheOffset := TIBCustomDataSet(DataSet).ArrayFieldCount; |
1082 |
> |
Inc(TIBCustomDataSet(DataSet).FArrayFieldCount); |
1083 |
> |
if FieldDef <> nil then |
1084 |
> |
begin |
1085 |
> |
FRelationName := TIBFieldDef(FieldDef).FRelationName; |
1086 |
> |
FArrayDimensions := TIBFieldDef(FieldDef).ArrayDimensions; |
1087 |
> |
FArrayBounds := TIBFieldDef(FieldDef).ArrayBounds; |
1088 |
> |
end; |
1089 |
> |
end; |
1090 |
> |
end; |
1091 |
> |
|
1092 |
> |
constructor TIBArrayField.Create(AOwner: TComponent); |
1093 |
> |
begin |
1094 |
> |
inherited Create(AOwner); |
1095 |
> |
SetDataType(ftArray); |
1096 |
> |
end; |
1097 |
> |
|
1098 |
> |
function TIBArrayField.CreateArray: IArray; |
1099 |
> |
begin |
1100 |
> |
with DataSet as TIBCustomDataSet do |
1101 |
> |
Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,FRelationName,FieldName); |
1102 |
> |
end; |
1103 |
> |
|
1104 |
> |
{ TIBMemoField } |
1105 |
> |
|
1106 |
> |
function TIBMemoField.GetTruncatedText: string; |
1107 |
> |
begin |
1108 |
> |
Result := GetAsString; |
1109 |
> |
|
1110 |
> |
if Result <> '' then |
1111 |
> |
begin |
1112 |
> |
case CharacterSetSize of |
1113 |
> |
1: |
1114 |
> |
if DisplayWidth = 0 then |
1115 |
> |
Result := TextToSingleLine(Result) |
1116 |
> |
else |
1117 |
> |
if Length(Result) > DisplayWidth then {Show truncation with elipses} |
1118 |
> |
Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...'; |
1119 |
> |
|
1120 |
> |
{2: case 2 ignored. This should be handled by TIBWideMemo} |
1121 |
> |
|
1122 |
> |
3, {Assume UNICODE_FSS is really UTF8} |
1123 |
> |
4: {Include GB18030 - assuming UTF8 routines work for this codeset} |
1124 |
> |
if DisplayWidth = 0 then |
1125 |
> |
Result := ValidUTF8String(TextToSingleLine(Result)) |
1126 |
> |
else |
1127 |
> |
if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses} |
1128 |
> |
Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...'; |
1129 |
> |
end; |
1130 |
> |
end |
1131 |
> |
end; |
1132 |
> |
|
1133 |
> |
procedure TIBMemoField.Bind(Binding: Boolean); |
1134 |
> |
var IBFieldDef: TIBFieldDef; |
1135 |
> |
begin |
1136 |
> |
inherited Bind(Binding); |
1137 |
> |
if Binding and (FieldDef <> nil) then |
1138 |
> |
begin |
1139 |
> |
IBFieldDef := FieldDef as TIBFieldDef; |
1140 |
> |
CharacterSetSize := IBFieldDef.CharacterSetSize; |
1141 |
> |
CharacterSetName := IBFieldDef.CharacterSetName; |
1142 |
> |
CodePage := IBFieldDef.CodePage; |
1143 |
> |
end; |
1144 |
> |
end; |
1145 |
> |
|
1146 |
> |
function TIBMemoField.GetAsString: string; |
1147 |
> |
var s: RawByteString; |
1148 |
> |
begin |
1149 |
> |
s := inherited GetAsString; |
1150 |
> |
SetCodePage(s,CodePage,false); |
1151 |
> |
if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then |
1152 |
> |
SetCodePage(s,CP_UTF8,true); {LCL only accepts UTF8} |
1153 |
> |
Result := s; |
1154 |
> |
end; |
1155 |
> |
|
1156 |
> |
function TIBMemoField.GetDefaultWidth: Longint; |
1157 |
> |
begin |
1158 |
> |
if DisplayTextAsClassName then |
1159 |
> |
Result := inherited |
1160 |
> |
else |
1161 |
> |
Result := 128; |
1162 |
> |
end; |
1163 |
> |
|
1164 |
> |
procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean); |
1165 |
> |
begin |
1166 |
> |
if ADisplayText then |
1167 |
> |
begin |
1168 |
> |
if not DisplayTextAsClassName and (CharacterSetName <> '') then |
1169 |
> |
AText := GetTruncatedText |
1170 |
> |
else |
1171 |
> |
inherited GetText(AText, ADisplayText); |
1172 |
> |
end |
1173 |
> |
else |
1174 |
> |
AText := GetAsString; |
1175 |
> |
end; |
1176 |
> |
|
1177 |
> |
procedure TIBMemoField.SetAsString(const AValue: string); |
1178 |
> |
var s: RawByteString; |
1179 |
> |
begin |
1180 |
> |
s := AValue; |
1181 |
> |
if StringCodePage(s) <> CodePage then |
1182 |
> |
SetCodePage(s,CodePage,CodePage<>CP_NONE); |
1183 |
> |
inherited SetAsString(s); |
1184 |
> |
end; |
1185 |
> |
|
1186 |
> |
constructor TIBMemoField.Create(AOwner: TComponent); |
1187 |
> |
begin |
1188 |
> |
inherited Create(AOwner); |
1189 |
> |
BlobType := ftMemo; |
1190 |
> |
FCodePage := CP_NONE; |
1191 |
> |
end; |
1192 |
> |
|
1193 |
> |
{ TIBControlLink } |
1194 |
> |
|
1195 |
> |
destructor TIBControlLink.Destroy; |
1196 |
> |
begin |
1197 |
> |
IBDataSet := nil; |
1198 |
> |
inherited Destroy; |
1199 |
> |
end; |
1200 |
> |
|
1201 |
> |
procedure TIBControlLink.UpdateParams(Sender: TObject); |
1202 |
> |
begin |
1203 |
> |
|
1204 |
> |
end; |
1205 |
> |
|
1206 |
> |
procedure TIBControlLink.UpdateSQL(Sender: TObject); |
1207 |
> |
begin |
1208 |
> |
|
1209 |
> |
end; |
1210 |
> |
|
1211 |
> |
procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet); |
1212 |
> |
begin |
1213 |
> |
if FTIBDataSet = AValue then Exit; |
1214 |
> |
if IBDataSet <> nil then |
1215 |
> |
IBDataSet.UnRegisterIBLink(self); |
1216 |
> |
FTIBDataSet := AValue; |
1217 |
> |
if IBDataSet <> nil then |
1218 |
> |
IBDataSet.RegisterIBLink(self); |
1219 |
> |
end; |
1220 |
> |
|
1221 |
> |
|
1222 |
> |
{ TIBStringField} |
1223 |
> |
|
1224 |
> |
procedure TIBStringField.Bind(Binding: Boolean); |
1225 |
> |
var IBFieldDef: TIBFieldDef; |
1226 |
> |
begin |
1227 |
> |
inherited Bind(Binding); |
1228 |
> |
if Binding and (FieldDef <> nil) then |
1229 |
> |
begin |
1230 |
> |
IBFieldDef := FieldDef as TIBFieldDef; |
1231 |
> |
CharacterSetSize := IBFieldDef.CharacterSetSize; |
1232 |
> |
CharacterSetName := IBFieldDef.CharacterSetName; |
1233 |
> |
FDataSize := IBFieldDef.DataSize + 1; |
1234 |
> |
if AutoFieldSize then |
1235 |
> |
Size := IBFieldDef.Size; |
1236 |
> |
CodePage := IBFieldDef.CodePage; |
1237 |
> |
end; |
1238 |
> |
end; |
1239 |
> |
|
1240 |
> |
function TIBStringField.GetDataSize: Integer; |
1241 |
> |
begin |
1242 |
> |
Result := FDataSize; |
1243 |
> |
end; |
1244 |
> |
|
1245 |
> |
constructor TIBStringField.Create(aOwner: TComponent); |
1246 |
> |
begin |
1247 |
> |
inherited Create(aOwner); |
1248 |
> |
FCharacterSetSize := 1; |
1249 |
> |
FCodePage := CP_NONE; |
1250 |
> |
FAutoFieldSize := true; |
1251 |
> |
end; |
1252 |
> |
|
1253 |
> |
class procedure TIBStringField.CheckTypeSize(Value: Integer); |
1254 |
> |
begin |
1255 |
> |
{ don't check string size. all sizes valid } |
1256 |
> |
end; |
1257 |
> |
|
1258 |
> |
function TIBStringField.GetAsString: string; |
1259 |
> |
begin |
1260 |
> |
if not GetValue(Result) then Result := ''; |
1261 |
> |
end; |
1262 |
> |
|
1263 |
> |
function TIBStringField.GetAsVariant: Variant; |
1264 |
> |
var |
1265 |
> |
S: string; |
1266 |
> |
begin |
1267 |
> |
if GetValue(S) then Result := S else Result := Null; |
1268 |
> |
end; |
1269 |
> |
|
1270 |
> |
function TIBStringField.GetValue(var Value: string): Boolean; |
1271 |
> |
var |
1272 |
> |
Buffer: PChar; |
1273 |
> |
s: RawByteString; |
1274 |
> |
begin |
1275 |
> |
Buffer := nil; |
1276 |
> |
IBAlloc(Buffer, 0, DataSize); |
1277 |
> |
try |
1278 |
> |
Result := GetData(Buffer); |
1279 |
> |
if Result then |
1280 |
> |
begin |
1281 |
> |
s := strpas(Buffer); |
1282 |
> |
SetCodePage(s,CodePage,false); |
1283 |
> |
if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then |
1284 |
> |
SetCodePage(s,CP_UTF8,true); {LCL only accepts UTF8} |
1285 |
> |
Value := s; |
1286 |
> |
// writeln(FieldName,': ', StringCodePage(Value),', ',Value); |
1287 |
> |
if Transliterate and (Value <> '') then |
1288 |
> |
DataSet.Translate(PChar(Value), PChar(Value), False); |
1289 |
> |
end |
1290 |
> |
finally |
1291 |
> |
FreeMem(Buffer); |
1292 |
> |
end; |
1293 |
> |
end; |
1294 |
> |
|
1295 |
> |
procedure TIBStringField.SetAsString(const Value: string); |
1296 |
> |
var |
1297 |
> |
Buffer: PChar; |
1298 |
> |
s: RawByteString; |
1299 |
> |
begin |
1300 |
> |
Buffer := nil; |
1301 |
> |
IBAlloc(Buffer, 0, DataSize); |
1302 |
> |
try |
1303 |
> |
s := Value; |
1304 |
> |
if StringCodePage(s) <> CodePage then |
1305 |
> |
SetCodePage(s,CodePage,CodePage<>CP_NONE); |
1306 |
> |
StrLCopy(Buffer, PChar(s), DataSize-1); |
1307 |
> |
if Transliterate then |
1308 |
> |
DataSet.Translate(Buffer, Buffer, True); |
1309 |
> |
SetData(Buffer); |
1310 |
> |
finally |
1311 |
> |
FreeMem(Buffer); |
1312 |
> |
end; |
1313 |
> |
end; |
1314 |
> |
|
1315 |
> |
|
1316 |
> |
{ TIBBCDField } |
1317 |
> |
|
1318 |
> |
constructor TIBBCDField.Create(AOwner: TComponent); |
1319 |
> |
begin |
1320 |
> |
inherited Create(AOwner); |
1321 |
> |
SetDataType(ftBCD); |
1322 |
> |
Size := 8; |
1323 |
> |
end; |
1324 |
> |
|
1325 |
> |
procedure TIBBCDField.Bind(Binding: Boolean); |
1326 |
> |
begin |
1327 |
> |
inherited Bind(Binding); |
1328 |
> |
if Binding and (FieldDef <> nil) then |
1329 |
> |
FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn; |
1330 |
> |
end; |
1331 |
> |
|
1332 |
> |
class procedure TIBBCDField.CheckTypeSize(Value: Integer); |
1333 |
> |
begin |
1334 |
> |
{ No need to check as the base type is currency, not BCD } |
1335 |
> |
end; |
1336 |
> |
|
1337 |
> |
function TIBBCDField.GetAsCurrency: Currency; |
1338 |
> |
begin |
1339 |
> |
if not GetValue(Result) then |
1340 |
> |
Result := 0; |
1341 |
> |
end; |
1342 |
> |
|
1343 |
> |
function TIBBCDField.GetAsString: string; |
1344 |
> |
var |
1345 |
> |
C: System.Currency; |
1346 |
> |
begin |
1347 |
> |
if GetValue(C) then |
1348 |
> |
Result := CurrToStr(C) |
1349 |
> |
else |
1350 |
> |
Result := ''; |
1351 |
> |
end; |
1352 |
> |
|
1353 |
> |
function TIBBCDField.GetAsVariant: Variant; |
1354 |
> |
var |
1355 |
> |
C: System.Currency; |
1356 |
> |
begin |
1357 |
> |
if GetValue(C) then |
1358 |
> |
Result := C |
1359 |
> |
else |
1360 |
> |
Result := Null; |
1361 |
> |
end; |
1362 |
> |
|
1363 |
> |
function TIBBCDField.GetDataSize: Integer; |
1364 |
> |
begin |
1365 |
> |
{$IFDEF TBCDFIELD_IS_BCD} |
1366 |
> |
Result := 8; |
1367 |
> |
{$ELSE} |
1368 |
> |
Result := inherited GetDataSize |
1369 |
> |
{$ENDIF} |
1370 |
> |
end; |
1371 |
> |
|
1372 |
> |
{ TIBDataLink } |
1373 |
> |
|
1374 |
> |
constructor TIBDataLink.Create(ADataSet: TIBCustomDataSet); |
1375 |
> |
begin |
1376 |
> |
inherited Create; |
1377 |
> |
FDataSet := ADataSet; |
1378 |
> |
end; |
1379 |
> |
|
1380 |
> |
destructor TIBDataLink.Destroy; |
1381 |
> |
begin |
1382 |
> |
FDataSet.FDataLink := nil; |
1383 |
> |
inherited Destroy; |
1384 |
> |
end; |
1385 |
> |
|
1386 |
> |
|
1387 |
> |
procedure TIBDataLink.ActiveChanged; |
1388 |
> |
begin |
1389 |
> |
if FDataSet.Active then |
1390 |
> |
FDataSet.RefreshParams; |
1391 |
> |
end; |
1392 |
> |
|
1393 |
> |
|
1394 |
> |
function TIBDataLink.GetDetailDataSet: TDataSet; |
1395 |
> |
begin |
1396 |
> |
Result := FDataSet; |
1397 |
> |
end; |
1398 |
> |
|
1399 |
> |
procedure TIBDataLink.RecordChanged(Field: TField); |
1400 |
> |
begin |
1401 |
> |
if (Field = nil) and FDataSet.Active then |
1402 |
> |
FDataSet.RefreshParams; |
1403 |
> |
end; |
1404 |
> |
|
1405 |
> |
procedure TIBDataLink.CheckBrowseMode; |
1406 |
> |
begin |
1407 |
> |
if FDataSet.Active then |
1408 |
> |
FDataSet.CheckBrowseMode; |
1409 |
> |
end; |
1410 |
> |
|
1411 |
> |
{ TIBCustomDataSet } |
1412 |
> |
|
1413 |
> |
constructor TIBCustomDataSet.Create(AOwner: TComponent); |
1414 |
> |
begin |
1415 |
> |
inherited Create(AOwner); |
1416 |
> |
FBase := TIBBase.Create(Self); |
1417 |
> |
FDatabaseInfo := TIBDatabaseInfo.Create(self); |
1418 |
> |
FIBLinks := TList.Create; |
1419 |
> |
FCurrentRecord := -1; |
1420 |
> |
FDeletedRecords := 0; |
1421 |
> |
FUniDirectional := False; |
1422 |
> |
FBufferChunks := BufferCacheSize; |
1423 |
> |
FBlobStreamList := TList.Create; |
1424 |
> |
FArrayList := TList.Create; |
1425 |
> |
FGeneratorField := TIBGenerator.Create(self); |
1426 |
> |
FDataLink := TIBDataLink.Create(Self); |
1427 |
> |
FQDelete := TIBSQL.Create(Self); |
1428 |
> |
FQDelete.OnSQLChanging := SQLChanging; |
1429 |
> |
FQDelete.GoToFirstRecordOnExecute := False; |
1430 |
> |
FQInsert := TIBSQL.Create(Self); |
1431 |
> |
FQInsert.OnSQLChanging := SQLChanging; |
1432 |
> |
FQInsert.GoToFirstRecordOnExecute := False; |
1433 |
> |
FQRefresh := TIBSQL.Create(Self); |
1434 |
> |
FQRefresh.OnSQLChanging := SQLChanging; |
1435 |
> |
FQRefresh.GoToFirstRecordOnExecute := False; |
1436 |
> |
FQSelect := TIBSQL.Create(Self); |
1437 |
> |
FQSelect.OnSQLChanging := SQLChanging; |
1438 |
> |
FQSelect.OnSQLChanged := SQLChanged; |
1439 |
> |
FQSelect.GoToFirstRecordOnExecute := False; |
1440 |
> |
FQModify := TIBSQL.Create(Self); |
1441 |
> |
FQModify.OnSQLChanging := SQLChanging; |
1442 |
> |
FQModify.GoToFirstRecordOnExecute := False; |
1443 |
> |
FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted]; |
1444 |
> |
FParamCheck := True; |
1445 |
> |
FGenerateParamNames := False; |
1446 |
> |
FForcedRefresh := False; |
1447 |
> |
FAutoCommit:= acDisabled; |
1448 |
> |
FDataSetCloseAction := dcDiscardChanges; |
1449 |
> |
{Bookmark Size is Integer for IBX} |
1450 |
> |
BookmarkSize := SizeOf(Integer); |
1451 |
> |
FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect; |
1452 |
> |
FBase.AfterDatabaseDisconnect := DoAfterDatabaseDisconnect; |
1453 |
> |
FBase.OnDatabaseFree := DoDatabaseFree; |
1454 |
> |
FBase.BeforeTransactionEnd := DoBeforeTransactionEnd; |
1455 |
> |
FBase.AfterTransactionEnd := DoAfterTransactionEnd; |
1456 |
> |
FBase.OnTransactionFree := DoTransactionFree; |
1457 |
> |
if AOwner is TIBDatabase then |
1458 |
> |
Database := TIBDatabase(AOwner) |
1459 |
> |
else |
1460 |
> |
if AOwner is TIBTransaction then |
1461 |
> |
Transaction := TIBTransaction(AOwner); |
1462 |
> |
FBaseSQLSelect := TStringList.Create; |
1463 |
> |
end; |
1464 |
> |
|
1465 |
> |
destructor TIBCustomDataSet.Destroy; |
1466 |
> |
begin |
1467 |
> |
if Active then Active := false; |
1468 |
> |
if assigned(FGeneratorField) then FGeneratorField.Free; |
1469 |
> |
FDataLink.Free; |
1470 |
> |
FBase.Free; |
1471 |
> |
ClearBlobCache; |
1472 |
> |
ClearIBLinks; |
1473 |
> |
FIBLinks.Free; |
1474 |
> |
FBlobStreamList.Free; |
1475 |
> |
FArrayList.Free; |
1476 |
> |
FreeMem(FBufferCache); |
1477 |
> |
FBufferCache := nil; |
1478 |
> |
FreeMem(FOldBufferCache); |
1479 |
> |
FOldBufferCache := nil; |
1480 |
> |
FCacheSize := 0; |
1481 |
> |
FOldCacheSize := 0; |
1482 |
> |
FMappedFieldPosition := nil; |
1483 |
> |
if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free; |
1484 |
> |
if assigned(FParser) then FParser.Free; |
1485 |
> |
inherited Destroy; |
1486 |
> |
end; |
1487 |
> |
|
1488 |
> |
function TIBCustomDataSet.AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode): |
1489 |
> |
TGetResult; |
1490 |
> |
begin |
1491 |
> |
while not IsVisible(Buffer) do |
1492 |
> |
begin |
1493 |
> |
if GetMode = gmPrior then |
1494 |
> |
begin |
1495 |
> |
Dec(FCurrentRecord); |
1496 |
> |
if FCurrentRecord = -1 then |
1497 |
> |
begin |
1498 |
> |
result := grBOF; |
1499 |
> |
exit; |
1500 |
> |
end; |
1501 |
> |
ReadRecordCache(FCurrentRecord, Buffer, False); |
1502 |
> |
end |
1503 |
> |
else begin |
1504 |
> |
Inc(FCurrentRecord); |
1505 |
> |
if (FCurrentRecord = FRecordCount) then |
1506 |
> |
begin |
1507 |
> |
if (not FQSelect.EOF) and FQSelect.Next then |
1508 |
> |
begin |
1509 |
> |
FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer); |
1510 |
> |
Inc(FRecordCount); |
1511 |
> |
end |
1512 |
> |
else begin |
1513 |
> |
result := grEOF; |
1514 |
> |
exit; |
1515 |
> |
end; |
1516 |
> |
end |
1517 |
> |
else |
1518 |
> |
ReadRecordCache(FCurrentRecord, Buffer, False); |
1519 |
> |
end; |
1520 |
> |
end; |
1521 |
> |
result := grOK; |
1522 |
> |
end; |
1523 |
> |
|
1524 |
> |
procedure TIBCustomDataSet.ApplyUpdates; |
1525 |
> |
var |
1526 |
> |
CurBookmark: TBookmark; |
1527 |
> |
Buffer: PRecordData; |
1528 |
> |
CurUpdateTypes: TIBUpdateRecordTypes; |
1529 |
> |
UpdateAction: TIBUpdateAction; |
1530 |
> |
UpdateKind: TUpdateKind; |
1531 |
> |
bRecordsSkipped: Boolean; |
1532 |
> |
|
1533 |
> |
procedure GetUpdateKind; |
1534 |
> |
begin |
1535 |
> |
case Buffer^.rdCachedUpdateStatus of |
1536 |
> |
cusModified: |
1537 |
> |
UpdateKind := ukModify; |
1538 |
> |
cusInserted: |
1539 |
> |
UpdateKind := ukInsert; |
1540 |
> |
else |
1541 |
> |
UpdateKind := ukDelete; |
1542 |
> |
end; |
1543 |
> |
end; |
1544 |
> |
|
1545 |
> |
procedure ResetBufferUpdateStatus; |
1546 |
> |
begin |
1547 |
> |
case Buffer^.rdCachedUpdateStatus of |
1548 |
> |
cusModified: |
1549 |
> |
begin |
1550 |
> |
PRecordData(Buffer)^.rdUpdateStatus := usUnmodified; |
1551 |
> |
PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified; |
1552 |
> |
end; |
1553 |
> |
cusInserted: |
1554 |
> |
begin |
1555 |
> |
PRecordData(Buffer)^.rdUpdateStatus := usUnmodified; |
1556 |
> |
PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified; |
1557 |
> |
end; |
1558 |
> |
cusDeleted: |
1559 |
> |
begin |
1560 |
> |
PRecordData(Buffer)^.rdUpdateStatus := usDeleted; |
1561 |
> |
PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified; |
1562 |
> |
end; |
1563 |
> |
end; |
1564 |
> |
WriteRecordCache(PRecordData(Buffer)^.rdRecordNumber, Pointer(Buffer)); |
1565 |
> |
end; |
1566 |
> |
|
1567 |
> |
procedure UpdateUsingOnUpdateRecord; |
1568 |
> |
begin |
1569 |
> |
UpdateAction := uaFail; |
1570 |
> |
try |
1571 |
> |
FOnUpdateRecord(Self, UpdateKind, UpdateAction); |
1572 |
> |
except |
1573 |
> |
on E: Exception do |
1574 |
> |
begin |
1575 |
> |
if (E is EDatabaseError) and Assigned(FOnUpdateError) then |
1576 |
> |
FOnUpdateError(Self, EIBError(E), UpdateKind, UpdateAction); |
1577 |
> |
if UpdateAction = uaFail then |
1578 |
> |
raise; |
1579 |
> |
end; |
1580 |
> |
end; |
1581 |
> |
end; |
1582 |
> |
|
1583 |
> |
procedure UpdateUsingUpdateObject; |
1584 |
> |
begin |
1585 |
> |
try |
1586 |
> |
FUpdateObject.Apply(UpdateKind,PChar(Buffer)); |
1587 |
> |
ResetBufferUpdateStatus; |
1588 |
> |
except |
1589 |
> |
on E: Exception do |
1590 |
> |
if (E is EDatabaseError) and Assigned(FOnUpdateError) then |
1591 |
> |
FOnUpdateError(Self, EIBError(E), UpdateKind, UpdateAction); |
1592 |
> |
end; |
1593 |
> |
end; |
1594 |
> |
|
1595 |
> |
procedure UpdateUsingInternalquery; |
1596 |
> |
begin |
1597 |
> |
try |
1598 |
> |
case Buffer^.rdCachedUpdateStatus of |
1599 |
> |
cusModified: |
1600 |
> |
InternalPostRecord(FQModify, Buffer); |
1601 |
> |
cusInserted: |
1602 |
> |
InternalPostRecord(FQInsert, Buffer); |
1603 |
> |
cusDeleted: |
1604 |
> |
InternalDeleteRecord(FQDelete, Buffer); |
1605 |
> |
end; |
1606 |
> |
except |
1607 |
> |
on E: EIBError do begin |
1608 |
> |
UpdateAction := uaFail; |
1609 |
> |
if Assigned(FOnUpdateError) then |
1610 |
> |
FOnUpdateError(Self, E, UpdateKind, UpdateAction); |
1611 |
> |
case UpdateAction of |
1612 |
> |
uaFail: raise; |
1613 |
> |
uaAbort: SysUtils.Abort; |
1614 |
> |
uaSkip: bRecordsSkipped := True; |
1615 |
> |
end; |
1616 |
> |
end; |
1617 |
> |
end; |
1618 |
> |
end; |
1619 |
> |
|
1620 |
> |
begin |
1621 |
> |
if State in [dsEdit, dsInsert] then |
1622 |
> |
Post; |
1623 |
> |
FBase.CheckDatabase; |
1624 |
> |
FBase.CheckTransaction; |
1625 |
> |
DisableControls; |
1626 |
> |
CurBookmark := Bookmark; |
1627 |
> |
CurUpdateTypes := FUpdateRecordTypes; |
1628 |
> |
FUpdateRecordTypes := [cusModified, cusInserted, cusDeleted]; |
1629 |
> |
try |
1630 |
> |
First; |
1631 |
> |
bRecordsSkipped := False; |
1632 |
> |
while not EOF do |
1633 |
> |
begin |
1634 |
> |
Buffer := PRecordData(GetActiveBuf); |
1635 |
> |
GetUpdateKind; |
1636 |
> |
UpdateAction := uaApply; |
1637 |
> |
if Assigned(FUpdateObject) or Assigned(FOnUpdateRecord) then |
1638 |
> |
begin |
1639 |
> |
if (Assigned(FOnUpdateRecord)) then |
1640 |
> |
UpdateUsingOnUpdateRecord |
1641 |
> |
else |
1642 |
> |
if Assigned(FUpdateObject) then |
1643 |
> |
UpdateUsingUpdateObject; |
1644 |
> |
case UpdateAction of |
1645 |
> |
uaFail: |
1646 |
> |
IBError(ibxeUserAbort, [nil]); |
1647 |
> |
uaAbort: |
1648 |
> |
SysUtils.Abort; |
1649 |
> |
uaApplied: |
1650 |
> |
ResetBufferUpdateStatus; |
1651 |
> |
uaSkip: |
1652 |
> |
bRecordsSkipped := True; |
1653 |
> |
uaRetry: |
1654 |
> |
Continue; |
1655 |
> |
end; |
1656 |
> |
end; |
1657 |
> |
if (not Assigned(FUpdateObject)) and (UpdateAction = UaApply) then |
1658 |
> |
begin |
1659 |
> |
UpdateUsingInternalquery; |
1660 |
> |
UpdateAction := uaApplied; |
1661 |
> |
end; |
1662 |
> |
Next; |
1663 |
> |
end; |
1664 |
> |
FUpdatesPending := bRecordsSkipped; |
1665 |
> |
finally |
1666 |
> |
FUpdateRecordTypes := CurUpdateTypes; |
1667 |
> |
Bookmark := CurBookmark; |
1668 |
> |
EnableControls; |
1669 |
> |
end; |
1670 |
> |
end; |
1671 |
> |
|
1672 |
> |
procedure TIBCustomDataSet.InternalBatchInput(InputObject: TIBBatchInput); |
1673 |
> |
begin |
1674 |
> |
FQSelect.BatchInput(InputObject); |
1675 |
> |
end; |
1676 |
> |
|
1677 |
> |
procedure TIBCustomDataSet.InternalBatchOutput(OutputObject: TIBBatchOutput); |
1678 |
> |
var |
1679 |
> |
Qry: TIBSQL; |
1680 |
> |
begin |
1681 |
> |
Qry := TIBSQL.Create(Self); |
1682 |
> |
try |
1683 |
> |
Qry.Database := FBase.Database; |
1684 |
> |
Qry.Transaction := FBase.Transaction; |
1685 |
> |
Qry.SQL.Assign(FQSelect.SQL); |
1686 |
> |
Qry.BatchOutput(OutputObject); |
1687 |
> |
finally |
1688 |
> |
Qry.Free; |
1689 |
> |
end; |
1690 |
> |
end; |
1691 |
> |
|
1692 |
> |
procedure TIBCustomDataSet.CancelUpdates; |
1693 |
> |
var |
1694 |
> |
CurUpdateTypes: TIBUpdateRecordTypes; |
1695 |
> |
begin |
1696 |
> |
if State in [dsEdit, dsInsert] then |
1697 |
> |
Post; |
1698 |
> |
if FCachedUpdates and FUpdatesPending then |
1699 |
> |
begin |
1700 |
> |
DisableControls; |
1701 |
> |
CurUpdateTypes := UpdateRecordTypes; |
1702 |
> |
UpdateRecordTypes := [cusModified, cusInserted, cusDeleted]; |
1703 |
> |
try |
1704 |
> |
First; |
1705 |
> |
while not EOF do |
1706 |
> |
begin |
1707 |
> |
if UpdateStatus = usInserted then |
1708 |
> |
RevertRecord |
1709 |
> |
else |
1710 |
> |
begin |
1711 |
> |
RevertRecord; |
1712 |
> |
Next; |
1713 |
> |
end; |
1714 |
> |
end; |
1715 |
> |
finally |
1716 |
> |
UpdateRecordTypes := CurUpdateTypes; |
1717 |
> |
First; |
1718 |
> |
FUpdatesPending := False; |
1719 |
> |
EnableControls; |
1720 |
> |
end; |
1721 |
> |
end; |
1722 |
> |
end; |
1723 |
> |
|
1724 |
> |
function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer; |
1725 |
> |
var i: integer; |
1726 |
> |
Prepared: boolean; |
1727 |
> |
begin |
1728 |
> |
Result := 0; |
1729 |
> |
Prepared := FInternalPrepared; |
1730 |
> |
if not Prepared then |
1731 |
> |
InternalPrepare; |
1732 |
> |
try |
1733 |
> |
for i := 0 to Length(FAliasNameList) - 1 do |
1734 |
> |
if FAliasNameList[i] = AliasName then |
1735 |
> |
begin |
1736 |
> |
Result := i + 1; |
1737 |
> |
Exit |
1738 |
> |
end; |
1739 |
> |
finally |
1740 |
> |
if not Prepared then |
1741 |
> |
InternalUnPrepare; |
1742 |
> |
end; |
1743 |
> |
end; |
1744 |
> |
|
1745 |
> |
procedure TIBCustomDataSet.ActivateConnection; |
1746 |
> |
begin |
1747 |
> |
if not Assigned(Database) then |
1748 |
> |
IBError(ibxeDatabaseNotAssigned, [nil]); |
1749 |
> |
if not Assigned(Transaction) then |
1750 |
> |
IBError(ibxeTransactionNotAssigned, [nil]); |
1751 |
> |
if not Database.Connected then Database.Open; |
1752 |
> |
end; |
1753 |
> |
|
1754 |
> |
function TIBCustomDataSet.ActivateTransaction: Boolean; |
1755 |
> |
begin |
1756 |
> |
Result := False; |
1757 |
> |
if AllowAutoActivateTransaction or (csDesigning in ComponentState) then |
1758 |
> |
begin |
1759 |
> |
if not Assigned(Transaction) then |
1760 |
> |
IBError(ibxeTransactionNotAssigned, [nil]); |
1761 |
> |
if not Transaction.Active then |
1762 |
> |
begin |
1763 |
> |
Result := True; |
1764 |
> |
Transaction.StartTransaction; |
1765 |
> |
FDidActivate := True; |
1766 |
> |
end; |
1767 |
> |
end; |
1768 |
> |
end; |
1769 |
> |
|
1770 |
> |
procedure TIBCustomDataSet.DeactivateTransaction; |
1771 |
> |
var |
1772 |
> |
i: Integer; |
1773 |
> |
begin |
1774 |
> |
if not Assigned(Transaction) then |
1775 |
> |
IBError(ibxeTransactionNotAssigned, [nil]); |
1776 |
> |
with Transaction do |
1777 |
> |
begin |
1778 |
> |
for i := 0 to SQLObjectCount - 1 do |
1779 |
> |
begin |
1780 |
> |
if (SQLObjects[i] <> nil) and ((SQLObjects[i]).owner is TDataSet) then |
1781 |
> |
begin |
1782 |
> |
if TDataSet(SQLObjects[i].owner).Active then |
1783 |
> |
begin |
1784 |
> |
FDidActivate := False; |
1785 |
> |
exit; |
1786 |
> |
end; |
1787 |
> |
end; |
1788 |
> |
end; |
1789 |
> |
end; |
1790 |
> |
FInternalPrepared := False; |
1791 |
> |
if Transaction.InTransaction then |
1792 |
> |
Transaction.Commit; |
1793 |
> |
FDidActivate := False; |
1794 |
> |
end; |
1795 |
> |
|
1796 |
> |
procedure TIBCustomDataSet.CheckDatasetClosed; |
1797 |
> |
begin |
1798 |
> |
if FOpen then |
1799 |
> |
IBError(ibxeDatasetOpen, [nil]); |
1800 |
> |
end; |
1801 |
> |
|
1802 |
> |
procedure TIBCustomDataSet.CheckDatasetOpen; |
1803 |
> |
begin |
1804 |
> |
if not FOpen then |
1805 |
> |
IBError(ibxeDatasetClosed, [nil]); |
1806 |
> |
end; |
1807 |
> |
|
1808 |
> |
function TIBCustomDataSet.CreateParser: TSelectSQLParser; |
1809 |
> |
begin |
1810 |
> |
Result := TSelectSQLParser.Create(self,FBaseSQLSelect); |
1811 |
> |
Result.OnSQLChanging := SQLChanging |
1812 |
> |
end; |
1813 |
> |
|
1814 |
> |
procedure TIBCustomDataSet.CheckNotUniDirectional; |
1815 |
> |
begin |
1816 |
> |
if UniDirectional then |
1817 |
> |
IBError(ibxeDataSetUniDirectional, [nil]); |
1818 |
> |
end; |
1819 |
> |
|
1820 |
> |
procedure TIBCustomDataSet.AdjustRecordOnInsert(Buffer: Pointer); |
1821 |
> |
begin |
1822 |
> |
with PRecordData(Buffer)^ do |
1823 |
> |
if (State = dsInsert) and (not Modified) then |
1824 |
> |
begin |
1825 |
> |
rdRecordNumber := FRecordCount; |
1826 |
> |
FCurrentRecord := FRecordCount; |
1827 |
> |
end; |
1828 |
> |
end; |
1829 |
> |
|
1830 |
> |
function TIBCustomDataSet.CanEdit: Boolean; |
1831 |
> |
var |
1832 |
> |
Buff: PRecordData; |
1833 |
> |
begin |
1834 |
> |
Buff := PRecordData(GetActiveBuf); |
1835 |
> |
result := (FQModify.SQL.Text <> '') or |
1836 |
> |
(Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukModify).Text <> '')) or |
1837 |
> |
((Buff <> nil) and (Buff^.rdCachedUpdateStatus = cusInserted) and |
1838 |
> |
(FCachedUpdates)); |
1839 |
> |
end; |
1840 |
> |
|
1841 |
> |
function TIBCustomDataSet.CanInsert: Boolean; |
1842 |
> |
begin |
1843 |
> |
result := (FQInsert.SQL.Text <> '') or |
1844 |
> |
(Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukInsert).Text <> '')); |
1845 |
> |
end; |
1846 |
> |
|
1847 |
> |
function TIBCustomDataSet.CanDelete: Boolean; |
1848 |
> |
begin |
1849 |
> |
if (FQDelete.SQL.Text <> '') or |
1850 |
> |
(Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then |
1851 |
> |
result := True |
1852 |
> |
else |
1853 |
> |
result := False; |
1854 |
> |
end; |
1855 |
> |
|
1856 |
> |
function TIBCustomDataSet.CanRefresh: Boolean; |
1857 |
> |
begin |
1858 |
> |
result := (FQRefresh.SQL.Text <> '') or |
1859 |
> |
(Assigned(FUpdateObject) and (FUpdateObject.RefreshSQL.Text <> '')); |
1860 |
> |
end; |
1861 |
> |
|
1862 |
> |
procedure TIBCustomDataSet.CheckEditState; |
1863 |
> |
begin |
1864 |
> |
case State of |
1865 |
> |
{ Check all the wsEditMode types } |
1866 |
> |
dsEdit, dsInsert, dsSetKey, dsCalcFields, dsFilter, |
1867 |
> |
dsNewValue, dsInternalCalc : |
1868 |
> |
begin |
1869 |
> |
if (State in [dsEdit]) and (not CanEdit) then |
1870 |
> |
IBError(ibxeCannotUpdate, [nil]); |
1871 |
> |
if (State in [dsInsert]) and (not CanInsert) then |
1872 |
> |
IBError(ibxeCannotInsert, [nil]); |
1873 |
> |
end; |
1874 |
> |
else |
1875 |
> |
IBError(ibxeNotEditing, []) |
1876 |
> |
end; |
1877 |
> |
end; |
1878 |
> |
|
1879 |
> |
procedure TIBCustomDataSet.ClearBlobCache; |
1880 |
> |
var |
1881 |
> |
i: Integer; |
1882 |
> |
begin |
1883 |
> |
for i := 0 to FBlobStreamList.Count - 1 do |
1884 |
> |
begin |
1885 |
> |
TIBBlobStream(FBlobStreamList[i]).Free; |
1886 |
> |
FBlobStreamList[i] := nil; |
1887 |
> |
end; |
1888 |
> |
FBlobStreamList.Pack; |
1889 |
> |
end; |
1890 |
> |
|
1891 |
> |
procedure TIBCustomDataSet.ClearArrayCache; |
1892 |
> |
var |
1893 |
> |
i: Integer; |
1894 |
> |
begin |
1895 |
> |
for i := 0 to FArrayList.Count - 1 do |
1896 |
> |
begin |
1897 |
> |
TIBArray(FArrayList[i]).Free; |
1898 |
> |
FArrayList[i] := nil; |
1899 |
> |
end; |
1900 |
> |
FArrayList.Pack; |
1901 |
> |
end; |
1902 |
> |
|
1903 |
> |
procedure TIBCustomDataSet.CopyRecordBuffer(Source, Dest: Pointer); |
1904 |
> |
begin |
1905 |
> |
Move(Source^, Dest^, FRecordBufferSize); |
1906 |
> |
end; |
1907 |
> |
|
1908 |
> |
procedure TIBCustomDataSet.DoBeforeDatabaseDisconnect(Sender: TObject); |
1909 |
> |
begin |
1910 |
> |
if Active then |
1911 |
> |
Active := False; |
1912 |
> |
InternalUnPrepare; |
1913 |
> |
if Assigned(FBeforeDatabaseDisconnect) then |
1914 |
> |
FBeforeDatabaseDisconnect(Sender); |
1915 |
> |
end; |
1916 |
> |
|
1917 |
> |
procedure TIBCustomDataSet.DoAfterDatabaseDisconnect(Sender: TObject); |
1918 |
> |
begin |
1919 |
> |
if Assigned(FAfterDatabaseDisconnect) then |
1920 |
> |
FAfterDatabaseDisconnect(Sender); |
1921 |
> |
end; |
1922 |
> |
|
1923 |
> |
procedure TIBCustomDataSet.DoDatabaseFree(Sender: TObject); |
1924 |
> |
begin |
1925 |
> |
if Assigned(FDatabaseFree) then |
1926 |
> |
FDatabaseFree(Sender); |
1927 |
> |
end; |
1928 |
> |
|
1929 |
> |
procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject; |
1930 |
> |
Action: TTransactionAction); |
1931 |
> |
begin |
1932 |
> |
FCloseAction := Action; |
1933 |
> |
FInTransactionEnd := true; |
1934 |
> |
try |
1935 |
> |
if Active then |
1936 |
> |
Active := False; |
1937 |
> |
finally |
1938 |
> |
FInTransactionEnd := false; |
1939 |
> |
end; |
1940 |
> |
if FQSelect <> nil then |
1941 |
> |
FQSelect.FreeHandle; |
1942 |
> |
if FQDelete <> nil then |
1943 |
> |
FQDelete.FreeHandle; |
1944 |
> |
if FQInsert <> nil then |
1945 |
> |
FQInsert.FreeHandle; |
1946 |
> |
if FQModify <> nil then |
1947 |
> |
FQModify.FreeHandle; |
1948 |
> |
if FQRefresh <> nil then |
1949 |
> |
FQRefresh.FreeHandle; |
1950 |
> |
InternalUnPrepare; |
1951 |
> |
if Assigned(FBeforeTransactionEnd) then |
1952 |
> |
FBeforeTransactionEnd(Sender); |
1953 |
> |
end; |
1954 |
> |
|
1955 |
> |
procedure TIBCustomDataSet.DoAfterTransactionEnd(Sender: TObject); |
1956 |
> |
begin |
1957 |
> |
if Assigned(FAfterTransactionEnd) then |
1958 |
> |
FAfterTransactionEnd(Sender); |
1959 |
> |
end; |
1960 |
> |
|
1961 |
> |
procedure TIBCustomDataSet.DoTransactionFree(Sender: TObject); |
1962 |
> |
begin |
1963 |
> |
if Assigned(FTransactionFree) then |
1964 |
> |
FTransactionFree(Sender); |
1965 |
> |
end; |
1966 |
> |
|
1967 |
> |
procedure TIBCustomDataSet.InitModelBuffer(Qry: TIBSQL; Buffer: PChar); |
1968 |
> |
var i, j: Integer; |
1969 |
> |
FieldsLoaded: integer; |
1970 |
> |
p: PRecordData; |
1971 |
> |
colMetadata: IColumnMetaData; |
1972 |
> |
begin |
1973 |
> |
p := PRecordData(Buffer); |
1974 |
> |
{ Get record information } |
1975 |
> |
p^.rdBookmarkFlag := bfCurrent; |
1976 |
> |
p^.rdFieldCount := Qry.FieldCount; |
1977 |
> |
p^.rdRecordNumber := -1; |
1978 |
> |
p^.rdUpdateStatus := usUnmodified; |
1979 |
> |
p^.rdCachedUpdateStatus := cusUnmodified; |
1980 |
> |
p^.rdSavedOffset := $FFFFFFFF; |
1981 |
> |
|
1982 |
> |
{ Load up the fields } |
1983 |
> |
FieldsLoaded := FQSelect.MetaData.Count; |
1984 |
> |
j := 1; |
1985 |
> |
for i := 0 to Qry.MetaData.Count - 1 do |
1986 |
> |
begin |
1987 |
> |
if (Qry = FQSelect) then |
1988 |
> |
j := i + 1 |
1989 |
> |
else |
1990 |
> |
begin |
1991 |
> |
if FieldsLoaded = 0 then |
1992 |
> |
break; |
1993 |
> |
j := FQSelect.FieldIndex[Qry[i].Name] + 1; |
1994 |
> |
if j < 1 then |
1995 |
> |
continue |
1996 |
> |
else |
1997 |
> |
Dec(FieldsLoaded); |
1998 |
> |
end; |
1999 |
> |
if j > 0 then |
2000 |
> |
begin |
2001 |
> |
colMetadata := Qry.MetaData[i]; |
2002 |
> |
with p^.rdFields[j], FFieldColumns^[j] do |
2003 |
> |
begin |
2004 |
> |
fdDataType := colMetadata.GetSQLType; |
2005 |
> |
if fdDataType = SQL_BLOB then |
2006 |
> |
fdDataScale := 0 |
2007 |
> |
else |
2008 |
> |
fdDataScale := colMetadata.getScale; |
2009 |
> |
fdNullable := colMetadata.getIsNullable; |
2010 |
> |
fdIsNull := true; |
2011 |
> |
fdDataSize := colMetadata.GetSize; |
2012 |
> |
fdDataLength := 0; |
2013 |
> |
fdCodePage := CP_NONE; |
2014 |
> |
|
2015 |
> |
case fdDataType of |
2016 |
> |
SQL_TIMESTAMP, |
2017 |
> |
SQL_TYPE_DATE, |
2018 |
> |
SQL_TYPE_TIME: |
2019 |
> |
fdDataSize := SizeOf(TDateTime); |
2020 |
> |
SQL_SHORT, SQL_LONG: |
2021 |
> |
begin |
2022 |
> |
if (fdDataScale = 0) then |
2023 |
> |
fdDataSize := SizeOf(Integer) |
2024 |
> |
else |
2025 |
> |
if (fdDataScale >= (-4)) then |
2026 |
> |
fdDataSize := SizeOf(Currency) |
2027 |
> |
else |
2028 |
> |
fdDataSize := SizeOf(Double); |
2029 |
> |
end; |
2030 |
> |
SQL_INT64: |
2031 |
> |
begin |
2032 |
> |
if (fdDataScale = 0) then |
2033 |
> |
fdDataSize := SizeOf(Int64) |
2034 |
> |
else |
2035 |
> |
if (fdDataScale >= (-4)) then |
2036 |
> |
fdDataSize := SizeOf(Currency) |
2037 |
> |
else |
2038 |
> |
fdDataSize := SizeOf(Double); |
2039 |
> |
end; |
2040 |
> |
SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: |
2041 |
> |
fdDataSize := SizeOf(Double); |
2042 |
> |
SQL_BOOLEAN: |
2043 |
> |
fdDataSize := SizeOf(wordBool); |
2044 |
> |
SQL_VARYING, |
2045 |
> |
SQL_TEXT, |
2046 |
> |
SQL_BLOB: |
2047 |
> |
fdCodePage := Qry.Metadata[i].getCodePage; |
2048 |
> |
end; |
2049 |
> |
fdDataOfs := FRecordSize; |
2050 |
> |
Inc(FRecordSize, fdDataSize); |
2051 |
> |
end; |
2052 |
> |
end; |
2053 |
> |
end; |
2054 |
> |
end; |
2055 |
> |
|
2056 |
> |
{Update Buffer Fields from Query Results} |
2057 |
> |
|
2058 |
> |
procedure TIBCustomDataSet.UpdateRecordFromQuery(QryResults: IResults; |
2059 |
> |
Buffer: PChar); |
2060 |
> |
var i, j: integer; |
2061 |
> |
begin |
2062 |
> |
for i := 0 to QryResults.Count - 1 do |
2063 |
> |
begin |
2064 |
> |
j := GetFieldPosition(QryResults[i].GetAliasName); |
2065 |
> |
if j > 0 then |
2066 |
> |
ColumnDataToBuffer(QryResults,i,j,Buffer); |
2067 |
> |
end; |
2068 |
> |
end; |
2069 |
> |
|
2070 |
> |
|
2071 |
> |
{Move column data returned from query to row buffer} |
2072 |
> |
|
2073 |
> |
procedure TIBCustomDataSet.ColumnDataToBuffer(QryResults: IResults; |
2074 |
> |
ColumnIndex, FieldIndex: integer; Buffer: PChar); |
2075 |
> |
var |
2076 |
> |
LocalData: PByte; |
2077 |
> |
LocalDate, LocalDouble: Double; |
2078 |
> |
LocalInt: Integer; |
2079 |
> |
LocalBool: wordBool; |
2080 |
> |
LocalInt64: Int64; |
2081 |
> |
LocalCurrency: Currency; |
2082 |
> |
ColData: ISQLData; |
2083 |
> |
begin |
2084 |
> |
LocalData := nil; |
2085 |
> |
with PRecordData(Buffer)^.rdFields[FieldIndex], FFieldColumns^[FieldIndex] do |
2086 |
> |
begin |
2087 |
> |
QryResults.GetData(ColumnIndex,fdIsNull,fdDataLength,LocalData); |
2088 |
> |
if not fdIsNull then |
2089 |
> |
begin |
2090 |
> |
ColData := QryResults[ColumnIndex]; |
2091 |
> |
case fdDataType of {Get Formatted data for column types that need formatting} |
2092 |
> |
SQL_TIMESTAMP: |
2093 |
> |
begin |
2094 |
> |
LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(ColData.AsDateTime)); |
2095 |
> |
LocalData := PByte(@LocalDate); |
2096 |
> |
end; |
2097 |
> |
SQL_TYPE_DATE: |
2098 |
> |
begin |
2099 |
> |
LocalInt := DateTimeToTimeStamp(ColData.AsDateTime).Date; |
2100 |
> |
LocalData := PByte(@LocalInt); |
2101 |
> |
end; |
2102 |
> |
SQL_TYPE_TIME: |
2103 |
> |
begin |
2104 |
> |
LocalInt := DateTimeToTimeStamp(ColData.AsDateTime).Time; |
2105 |
> |
LocalData := PByte(@LocalInt); |
2106 |
> |
end; |
2107 |
> |
SQL_SHORT, SQL_LONG: |
2108 |
> |
begin |
2109 |
> |
if (fdDataScale = 0) then |
2110 |
> |
begin |
2111 |
> |
LocalInt := ColData.AsLong; |
2112 |
> |
LocalData := PByte(@LocalInt); |
2113 |
> |
end |
2114 |
> |
else |
2115 |
> |
if (fdDataScale >= (-4)) then |
2116 |
> |
begin |
2117 |
> |
LocalCurrency := ColData.AsCurrency; |
2118 |
> |
LocalData := PByte(@LocalCurrency); |
2119 |
> |
end |
2120 |
> |
else |
2121 |
> |
begin |
2122 |
> |
LocalDouble := ColData.AsDouble; |
2123 |
> |
LocalData := PByte(@LocalDouble); |
2124 |
> |
end; |
2125 |
> |
end; |
2126 |
> |
SQL_INT64: |
2127 |
> |
begin |
2128 |
> |
if (fdDataScale = 0) then |
2129 |
> |
begin |
2130 |
> |
LocalInt64 := ColData.AsInt64; |
2131 |
> |
LocalData := PByte(@LocalInt64); |
2132 |
> |
end |
2133 |
> |
else |
2134 |
> |
if (fdDataScale >= (-4)) then |
2135 |
> |
begin |
2136 |
> |
LocalCurrency := ColData.AsCurrency; |
2137 |
> |
LocalData := PByte(@LocalCurrency); |
2138 |
> |
end |
2139 |
> |
else |
2140 |
> |
begin |
2141 |
> |
LocalDouble := ColData.AsDouble; |
2142 |
> |
LocalData := PByte(@LocalDouble); |
2143 |
> |
end |
2144 |
> |
end; |
2145 |
> |
SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: |
2146 |
> |
begin |
2147 |
> |
LocalDouble := ColData.AsDouble; |
2148 |
> |
LocalData := PByte(@LocalDouble); |
2149 |
> |
end; |
2150 |
> |
SQL_BOOLEAN: |
2151 |
> |
begin |
2152 |
> |
LocalBool := ColData.AsBoolean; |
2153 |
> |
LocalData := PByte(@LocalBool); |
2154 |
> |
end; |
2155 |
> |
end; |
2156 |
> |
|
2157 |
> |
if fdDataType = SQL_VARYING then |
2158 |
> |
Move(LocalData^, Buffer[fdDataOfs], fdDataLength) |
2159 |
> |
else |
2160 |
> |
Move(LocalData^, Buffer[fdDataOfs], fdDataSize) |
2161 |
> |
end |
2162 |
> |
else {Null column} |
2163 |
> |
if fdDataType = SQL_VARYING then |
2164 |
> |
FillChar(Buffer[fdDataOfs],fdDataLength,0) |
2165 |
> |
else |
2166 |
> |
FillChar(Buffer[fdDataOfs],fdDataSize,0); |
2167 |
> |
end; |
2168 |
> |
end; |
2169 |
> |
|
2170 |
> |
{ Read the record from FQSelect.Current into the record buffer |
2171 |
> |
Then write the buffer to in memory cache } |
2172 |
> |
procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL; |
2173 |
> |
RecordNumber: Integer; Buffer: PChar); |
2174 |
> |
var |
2175 |
> |
pbd: PBlobDataArray; |
2176 |
> |
pda: PArrayDataArray; |
2177 |
> |
i, j: Integer; |
2178 |
> |
FieldsLoaded: Integer; |
2179 |
> |
p: PRecordData; |
2180 |
> |
begin |
2181 |
> |
if RecordNumber = -1 then |
2182 |
> |
begin |
2183 |
> |
InitModelBuffer(Qry,Buffer); |
2184 |
> |
Exit; |
2185 |
> |
end; |
2186 |
> |
p := PRecordData(Buffer); |
2187 |
> |
{ Make sure blob cache is empty } |
2188 |
> |
pbd := PBlobDataArray(Buffer + FBlobCacheOffset); |
2189 |
> |
pda := PArrayDataArray(Buffer + FArrayCacheOffset); |
2190 |
> |
for i := 0 to BlobFieldCount - 1 do |
2191 |
> |
pbd^[i] := nil; |
2192 |
> |
for i := 0 to ArrayFieldCount - 1 do |
2193 |
> |
pda^[i] := nil; |
2194 |
> |
|
2195 |
> |
{ Get record information } |
2196 |
> |
p^.rdBookmarkFlag := bfCurrent; |
2197 |
> |
p^.rdFieldCount := Qry.FieldCount; |
2198 |
> |
p^.rdRecordNumber := RecordNumber; |
2199 |
> |
p^.rdUpdateStatus := usUnmodified; |
2200 |
> |
p^.rdCachedUpdateStatus := cusUnmodified; |
2201 |
> |
p^.rdSavedOffset := $FFFFFFFF; |
2202 |
> |
|
2203 |
> |
{ Load up the fields } |
2204 |
> |
FieldsLoaded := FQSelect.MetaData.Count; |
2205 |
> |
j := 1; |
2206 |
> |
for i := 0 to Qry.FieldCount - 1 do |
2207 |
> |
begin |
2208 |
> |
if (Qry = FQSelect) then |
2209 |
> |
j := i + 1 |
2210 |
> |
else |
2211 |
> |
begin |
2212 |
> |
if FieldsLoaded = 0 then |
2213 |
> |
break; |
2214 |
> |
j := FQSelect.FieldIndex[Qry[i].Name] + 1; |
2215 |
> |
if j < 1 then |
2216 |
> |
continue |
2217 |
> |
else |
2218 |
> |
Dec(FieldsLoaded); |
2219 |
> |
end; |
2220 |
> |
with FQSelect.MetaData[j - 1] do |
2221 |
> |
if GetAliasname = 'IBX_INTERNAL_DBKEY' then {do not localize} |
2222 |
> |
begin |
2223 |
> |
if (GetSize <= 8) then |
2224 |
> |
p^.rdDBKey := PIBDBKEY(Qry[i].AsPointer)^; |
2225 |
> |
continue; |
2226 |
> |
end; |
2227 |
> |
if j > 0 then |
2228 |
> |
ColumnDataToBuffer(Qry.Current,i,j,Buffer); |
2229 |
> |
end; |
2230 |
> |
WriteRecordCache(RecordNumber, Buffer); |
2231 |
> |
end; |
2232 |
> |
|
2233 |
> |
function TIBCustomDataSet.GetActiveBuf: PChar; |
2234 |
> |
begin |
2235 |
> |
case State of |
2236 |
> |
dsBrowse: |
2237 |
> |
if IsEmpty then |
2238 |
> |
result := nil |
2239 |
> |
else |
2240 |
> |
result := ActiveBuffer; |
2241 |
> |
dsEdit, dsInsert: |
2242 |
> |
result := ActiveBuffer; |
2243 |
> |
dsCalcFields: |
2244 |
> |
result := CalcBuffer; |
2245 |
> |
dsFilter: |
2246 |
> |
result := FFilterBuffer; |
2247 |
> |
dsNewValue: |
2248 |
> |
result := ActiveBuffer; |
2249 |
> |
dsOldValue: |
2250 |
> |
if (PRecordData(ActiveBuffer)^.rdRecordNumber = |
2251 |
> |
PRecordData(FOldBuffer)^.rdRecordNumber) then |
2252 |
> |
result := FOldBuffer |
2253 |
> |
else |
2254 |
> |
result := ActiveBuffer; |
2255 |
> |
else if not FOpen then |
2256 |
> |
result := nil |
2257 |
> |
else |
2258 |
> |
result := ActiveBuffer; |
2259 |
> |
end; |
2260 |
> |
end; |
2261 |
> |
|
2262 |
> |
function TIBCustomDataSet.CachedUpdateStatus: TCachedUpdateStatus; |
2263 |
> |
begin |
2264 |
> |
if Active then |
2265 |
> |
result := PRecordData(GetActiveBuf)^.rdCachedUpdateStatus |
2266 |
> |
else |
2267 |
> |
result := cusUnmodified; |
2268 |
> |
end; |
2269 |
> |
|
2270 |
> |
function TIBCustomDataSet.GetDatabase: TIBDatabase; |
2271 |
> |
begin |
2272 |
> |
result := FBase.Database; |
2273 |
> |
end; |
2274 |
> |
|
2275 |
> |
function TIBCustomDataSet.GetDeleteSQL: TStrings; |
2276 |
> |
begin |
2277 |
> |
result := FQDelete.SQL; |
2278 |
> |
end; |
2279 |
> |
|
2280 |
> |
function TIBCustomDataSet.GetInsertSQL: TStrings; |
2281 |
> |
begin |
2282 |
> |
result := FQInsert.SQL; |
2283 |
> |
end; |
2284 |
> |
|
2285 |
> |
function TIBCustomDataSet.GetSQLParams: ISQLParams; |
2286 |
> |
begin |
2287 |
> |
if not FInternalPrepared then |
2288 |
> |
InternalPrepare; |
2289 |
> |
result := FQSelect.Params; |
2290 |
> |
end; |
2291 |
> |
|
2292 |
> |
function TIBCustomDataSet.GetRefreshSQL: TStrings; |
2293 |
> |
begin |
2294 |
> |
result := FQRefresh.SQL; |
2295 |
> |
end; |
2296 |
> |
|
2297 |
> |
function TIBCustomDataSet.GetSelectSQL: TStrings; |
2298 |
> |
begin |
2299 |
> |
result := FQSelect.SQL; |
2300 |
> |
end; |
2301 |
> |
|
2302 |
> |
function TIBCustomDataSet.GetStatementType: TIBSQLStatementTypes; |
2303 |
> |
begin |
2304 |
> |
result := FQSelect.SQLStatementType; |
2305 |
> |
end; |
2306 |
> |
|
2307 |
> |
function TIBCustomDataSet.GetModifySQL: TStrings; |
2308 |
> |
begin |
2309 |
> |
result := FQModify.SQL; |
2310 |
> |
end; |
2311 |
> |
|
2312 |
> |
function TIBCustomDataSet.GetTransaction: TIBTransaction; |
2313 |
> |
begin |
2314 |
> |
result := FBase.Transaction; |
2315 |
> |
end; |
2316 |
> |
|
2317 |
> |
procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); |
2318 |
> |
begin |
2319 |
> |
if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then |
2320 |
> |
FUpdateObject.Apply(ukDelete,Buff) |
2321 |
> |
else |
2322 |
> |
begin |
2323 |
> |
SetInternalSQLParams(FQDelete.Params, Buff); |
2324 |
> |
FQDelete.ExecQuery; |
2325 |
> |
end; |
2326 |
> |
with PRecordData(Buff)^ do |
2327 |
> |
begin |
2328 |
> |
rdUpdateStatus := usDeleted; |
2329 |
> |
rdCachedUpdateStatus := cusUnmodified; |
2330 |
> |
end; |
2331 |
> |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff); |
2332 |
> |
end; |
2333 |
> |
|
2334 |
> |
function TIBCustomDataSet.InternalLocate(const KeyFields: string; |
2335 |
> |
const KeyValues: Variant; Options: TLocateOptions): Boolean; |
2336 |
> |
var |
2337 |
> |
keyFieldList: TList; |
2338 |
> |
CurBookmark: TBookmark; |
2339 |
> |
fieldValue: Variant; |
2340 |
> |
lookupValues: array of variant; |
2341 |
> |
i, fieldCount: Integer; |
2342 |
> |
fieldValueAsString: string; |
2343 |
> |
lookupValueAsString: string; |
2344 |
> |
begin |
2345 |
> |
keyFieldList := TList.Create; |
2346 |
> |
try |
2347 |
> |
GetFieldList(keyFieldList, KeyFields); |
2348 |
> |
fieldCount := keyFieldList.Count; |
2349 |
> |
CurBookmark := Bookmark; |
2350 |
> |
result := false; |
2351 |
> |
SetLength(lookupValues, fieldCount); |
2352 |
> |
if not EOF then |
2353 |
> |
begin |
2354 |
> |
for i := 0 to fieldCount - 1 do {expand key values into lookupValues array} |
2355 |
> |
begin |
2356 |
> |
if VarIsArray(KeyValues) then |
2357 |
> |
lookupValues[i] := KeyValues[i] |
2358 |
> |
else |
2359 |
> |
if i > 0 then |
2360 |
> |
lookupValues[i] := NULL |
2361 |
> |
else |
2362 |
> |
lookupValues[0] := KeyValues; |
2363 |
> |
|
2364 |
> |
{convert to upper case is case insensitive search} |
2365 |
> |
if (TField(keyFieldList[i]).DataType = ftString) and |
2366 |
> |
not VarIsNull(lookupValues[i]) and (loCaseInsensitive in Options) then |
2367 |
> |
lookupValues[i] := UpperCase(lookupValues[i]); |
2368 |
> |
end; |
2369 |
> |
end; |
2370 |
> |
while not result and not EOF do {search for a matching record} |
2371 |
> |
begin |
2372 |
> |
i := 0; |
2373 |
> |
result := true; |
2374 |
> |
while result and (i < fieldCount) do |
2375 |
> |
{see if all of the key fields matches} |
2376 |
> |
begin |
2377 |
> |
fieldValue := TField(keyFieldList[i]).Value; |
2378 |
> |
result := not (VarIsNull(fieldValue) xor VarIsNull(lookupValues[i])); |
2379 |
> |
if result and not VarIsNull(fieldValue) then |
2380 |
> |
begin |
2381 |
> |
try |
2382 |
> |
if TField(keyFieldList[i]).DataType = ftString then |
2383 |
> |
begin |
2384 |
> |
{strings need special handling because of the locate options that |
2385 |
> |
apply to them} |
2386 |
> |
fieldValueAsString := TField(keyFieldList[i]).AsString; |
2387 |
> |
lookupValueAsString := lookupValues[i]; |
2388 |
> |
if (loCaseInsensitive in Options) then |
2389 |
> |
fieldValueAsString := UpperCase(fieldValueAsString); |
2390 |
> |
|
2391 |
> |
if (loPartialKey in Options) then |
2392 |
> |
result := result and (Pos(lookupValueAsString, fieldValueAsString) = 1) |
2393 |
> |
else |
2394 |
> |
result := result and (fieldValueAsString = lookupValueAsString); |
2395 |
> |
end |
2396 |
> |
else |
2397 |
> |
result := result and (lookupValues[i] = |
2398 |
> |
VarAsType(fieldValue, VarType(lookupValues[i]))); |
2399 |
> |
except on EVariantError do |
2400 |
> |
result := False; |
2401 |
> |
end; |
2402 |
> |
end; |
2403 |
> |
Inc(i); |
2404 |
> |
end; |
2405 |
> |
if not result then |
2406 |
> |
Next; |
2407 |
> |
end; |
2408 |
> |
if not result then |
2409 |
> |
Bookmark := CurBookmark |
2410 |
> |
else |
2411 |
> |
CursorPosChanged; |
2412 |
> |
finally |
2413 |
> |
keyFieldList.Free; |
2414 |
> |
SetLength(lookupValues,0) |
2415 |
> |
end; |
2416 |
> |
end; |
2417 |
> |
|
2418 |
> |
procedure TIBCustomDataSet.InternalPostRecord(Qry: TIBSQL; Buff: Pointer); |
2419 |
> |
var |
2420 |
> |
i, j, k, arr: Integer; |
2421 |
> |
pbd: PBlobDataArray; |
2422 |
> |
pda: PArrayDataArray; |
2423 |
> |
begin |
2424 |
> |
pbd := PBlobDataArray(PChar(Buff) + FBlobCacheOffset); |
2425 |
> |
pda := PArrayDataArray(PChar(Buff) + FArrayCacheOffset); |
2426 |
> |
j := 0; arr := 0; |
2427 |
> |
for i := 0 to FieldCount - 1 do |
2428 |
> |
if Fields[i].IsBlob then |
2429 |
> |
begin |
2430 |
> |
k := FMappedFieldPosition[Fields[i].FieldNo -1]; |
2431 |
> |
if pbd^[j] <> nil then |
2432 |
> |
begin |
2433 |
> |
pbd^[j].Finalize; |
2434 |
> |
PISC_QUAD( |
2435 |
> |
PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ := |
2436 |
> |
pbd^[j].BlobID; |
2437 |
> |
PRecordData(Buff)^.rdFields[k].fdIsNull := pbd^[j].Size = 0; |
2438 |
> |
end |
2439 |
> |
else |
2440 |
> |
begin |
2441 |
> |
PRecordData(Buff)^.rdFields[k].fdIsNull := true; |
2442 |
> |
with PISC_QUAD(PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ do |
2443 |
> |
begin |
2444 |
> |
gds_quad_high := 0; |
2445 |
> |
gds_quad_low := 0; |
2446 |
> |
end; |
2447 |
> |
end; |
2448 |
> |
Inc(j); |
2449 |
> |
end |
2450 |
> |
else |
2451 |
> |
if Fields[i] is TIBArrayField then |
2452 |
> |
begin |
2453 |
> |
if pda^[arr] <> nil then |
2454 |
> |
begin |
2455 |
> |
k := FMappedFieldPosition[Fields[i].FieldNo -1]; |
2456 |
> |
PISC_QUAD( |
2457 |
> |
PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ := pda^[arr].ArrayIntf.GetArrayID; |
2458 |
> |
PRecordData(Buff)^.rdFields[k].fdIsNull := pda^[arr].ArrayIntf.IsEmpty; |
2459 |
> |
end; |
2460 |
> |
Inc(arr); |
2461 |
> |
end; |
2462 |
> |
if Assigned(FUpdateObject) then |
2463 |
> |
begin |
2464 |
> |
if (Qry = FQDelete) then |
2465 |
> |
FUpdateObject.Apply(ukDelete,Buff) |
2466 |
> |
else if (Qry = FQInsert) then |
2467 |
> |
FUpdateObject.Apply(ukInsert,Buff) |
2468 |
> |
else |
2469 |
> |
FUpdateObject.Apply(ukModify,Buff); |
2470 |
> |
end |
2471 |
> |
else begin |
2472 |
> |
SetInternalSQLParams(Qry.Params, Buff); |
2473 |
> |
Qry.ExecQuery; |
2474 |
> |
end; |
2475 |
> |
if Qry.FieldCount > 0 then {Has RETURNING Clause} |
2476 |
> |
UpdateRecordFromQuery(Qry.Current,Buff); |
2477 |
> |
PRecordData(Buff)^.rdUpdateStatus := usUnmodified; |
2478 |
> |
PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified; |
2479 |
> |
SetModified(False); |
2480 |
> |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff); |
2481 |
> |
if (FForcedRefresh or FNeedsRefresh) and CanRefresh then |
2482 |
> |
InternalRefreshRow; |
2483 |
> |
end; |
2484 |
> |
|
2485 |
> |
procedure TIBCustomDataSet.InternalRefreshRow; |
2486 |
> |
var |
2487 |
> |
Buff: PChar; |
2488 |
> |
ofs: DWORD; |
2489 |
> |
Qry: TIBSQL; |
2490 |
> |
begin |
2491 |
> |
FBase.SetCursor; |
2492 |
> |
try |
2493 |
> |
Buff := GetActiveBuf; |
2494 |
> |
if CanRefresh then |
2495 |
> |
begin |
2496 |
> |
if Buff <> nil then |
2497 |
> |
begin |
2498 |
> |
if (Assigned(FUpdateObject) and (FUpdateObject.RefreshSQL.Text <> '')) then |
2499 |
> |
begin |
2500 |
> |
Qry := TIBSQL.Create(self); |
2501 |
> |
Qry.Database := Database; |
2502 |
> |
Qry.Transaction := Transaction; |
2503 |
> |
Qry.GoToFirstRecordOnExecute := False; |
2504 |
> |
Qry.SQL.Text := FUpdateObject.RefreshSQL.Text; |
2505 |
> |
end |
2506 |
> |
else |
2507 |
> |
Qry := FQRefresh; |
2508 |
> |
SetInternalSQLParams(Qry.Params, Buff); |
2509 |
> |
Qry.ExecQuery; |
2510 |
> |
try |
2511 |
> |
if (Qry.SQLStatementType = SQLExecProcedure) or Qry.Next then |
2512 |
> |
begin |
2513 |
> |
ofs := PRecordData(Buff)^.rdSavedOffset; |
2514 |
> |
FetchCurrentRecordToBuffer(Qry, |
2515 |
> |
PRecordData(Buff)^.rdRecordNumber, |
2516 |
> |
Buff); |
2517 |
> |
if FCachedUpdates and (ofs <> $FFFFFFFF) then |
2518 |
> |
begin |
2519 |
> |
PRecordData(Buff)^.rdSavedOffset := ofs; |
2520 |
> |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff); |
2521 |
> |
SaveOldBuffer(Buff); |
2522 |
> |
end; |
2523 |
> |
end; |
2524 |
> |
finally |
2525 |
> |
Qry.Close; |
2526 |
> |
end; |
2527 |
> |
if Qry <> FQRefresh then |
2528 |
> |
Qry.Free; |
2529 |
> |
end |
2530 |
> |
end |
2531 |
> |
else |
2532 |
> |
IBError(ibxeCannotRefresh, [nil]); |
2533 |
> |
finally |
2534 |
> |
FBase.RestoreCursor; |
2535 |
> |
end; |
2536 |
> |
end; |
2537 |
> |
|
2538 |
> |
procedure TIBCustomDataSet.InternalRevertRecord(RecordNumber: Integer); |
2539 |
> |
var |
2540 |
> |
NewBuffer, OldBuffer: PRecordData; |
2541 |
> |
|
2542 |
> |
begin |
2543 |
> |
NewBuffer := nil; |
2544 |
> |
OldBuffer := nil; |
2545 |
> |
NewBuffer := PRecordData(AllocRecordBuffer); |
2546 |
> |
OldBuffer := PRecordData(AllocRecordBuffer); |
2547 |
> |
try |
2548 |
> |
ReadRecordCache(RecordNumber, PChar(NewBuffer), False); |
2549 |
> |
ReadRecordCache(RecordNumber, PChar(OldBuffer), True); |
2550 |
> |
case NewBuffer^.rdCachedUpdateStatus of |
2551 |
> |
cusInserted: |
2552 |
> |
begin |
2553 |
> |
NewBuffer^.rdCachedUpdateStatus := cusUninserted; |
2554 |
> |
Inc(FDeletedRecords); |
2555 |
> |
end; |
2556 |
> |
cusModified, |
2557 |
> |
cusDeleted: |
2558 |
> |
begin |
2559 |
> |
if (NewBuffer^.rdCachedUpdateStatus = cusDeleted) then |
2560 |
> |
Dec(FDeletedRecords); |
2561 |
> |
CopyRecordBuffer(OldBuffer, NewBuffer); |
2562 |
> |
end; |
2563 |
> |
end; |
2564 |
> |
|
2565 |
> |
if State in dsEditModes then |
2566 |
> |
Cancel; |
2567 |
> |
|
2568 |
> |
WriteRecordCache(RecordNumber, PChar(NewBuffer)); |
2569 |
> |
|
2570 |
> |
if (NewBuffer^.rdCachedUpdateStatus = cusUninserted ) then |
2571 |
> |
ReSync([]); |
2572 |
> |
finally |
2573 |
> |
FreeRecordBuffer(PChar(NewBuffer)); |
2574 |
> |
FreeRecordBuffer(PChar(OldBuffer)); |
2575 |
> |
end; |
2576 |
> |
end; |
2577 |
> |
|
2578 |
> |
{ A visible record is one that is not truly deleted, |
2579 |
> |
and it is also listed in the FUpdateRecordTypes set } |
2580 |
> |
|
2581 |
> |
function TIBCustomDataSet.IsVisible(Buffer: PChar): Boolean; |
2582 |
> |
begin |
2583 |
> |
result := True; |
2584 |
> |
if not (State = dsOldValue) then |
2585 |
> |
result := |
2586 |
> |
(PRecordData(Buffer)^.rdCachedUpdateStatus in FUpdateRecordTypes) and |
2587 |
> |
(not ((PRecordData(Buffer)^.rdCachedUpdateStatus = cusUnmodified) and |
2588 |
> |
(PRecordData(Buffer)^.rdUpdateStatus = usDeleted))); |
2589 |
> |
end; |
2590 |
> |
|
2591 |
> |
|
2592 |
> |
function TIBCustomDataSet.LocateNext(const KeyFields: string; |
2593 |
> |
const KeyValues: Variant; Options: TLocateOptions): Boolean; |
2594 |
> |
begin |
2595 |
> |
DisableControls; |
2596 |
> |
try |
2597 |
> |
result := InternalLocate(KeyFields, KeyValues, Options); |
2598 |
> |
finally |
2599 |
> |
EnableControls; |
2600 |
> |
end; |
2601 |
> |
end; |
2602 |
> |
|
2603 |
> |
procedure TIBCustomDataSet.InternalPrepare; |
2604 |
> |
begin |
2605 |
> |
if FInternalPrepared then |
2606 |
> |
Exit; |
2607 |
> |
FBase.SetCursor; |
2608 |
> |
try |
2609 |
> |
ActivateConnection; |
2610 |
> |
ActivateTransaction; |
2611 |
> |
FBase.CheckDatabase; |
2612 |
> |
FBase.CheckTransaction; |
2613 |
> |
if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then |
2614 |
> |
begin |
2615 |
> |
FQSelect.OnSQLChanged := nil; {Do not react to change} |
2616 |
> |
try |
2617 |
> |
FQSelect.SQL.Text := FParser.SQLText; |
2618 |
> |
finally |
2619 |
> |
FQSelect.OnSQLChanged := SQLChanged; |
2620 |
> |
end; |
2621 |
> |
end; |
2622 |
> |
// writeln( FQSelect.SQL.Text); |
2623 |
> |
if FQSelect.SQL.Text <> '' then |
2624 |
> |
begin |
2625 |
> |
if not FQSelect.Prepared then |
2626 |
> |
begin |
2627 |
> |
FQSelect.GenerateParamNames := FGenerateParamNames; |
2628 |
> |
FQSelect.ParamCheck := ParamCheck; |
2629 |
> |
FQSelect.Prepare; |
2630 |
> |
end; |
2631 |
> |
FQDelete.GenerateParamNames := FGenerateParamNames; |
2632 |
> |
if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then |
2633 |
> |
FQDelete.Prepare; |
2634 |
> |
FQInsert.GenerateParamNames := FGenerateParamNames; |
2635 |
> |
if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then |
2636 |
> |
FQInsert.Prepare; |
2637 |
> |
FQRefresh.GenerateParamNames := FGenerateParamNames; |
2638 |
> |
if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then |
2639 |
> |
FQRefresh.Prepare; |
2640 |
> |
FQModify.GenerateParamNames := FGenerateParamNames; |
2641 |
> |
if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then |
2642 |
> |
FQModify.Prepare; |
2643 |
> |
FInternalPrepared := True; |
2644 |
> |
InternalInitFieldDefs; |
2645 |
> |
end else |
2646 |
> |
IBError(ibxeEmptyQuery, [nil]); |
2647 |
> |
finally |
2648 |
> |
FBase.RestoreCursor; |
2649 |
> |
end; |
2650 |
> |
end; |
2651 |
> |
|
2652 |
> |
procedure TIBCustomDataSet.RecordModified(Value: Boolean); |
2653 |
> |
begin |
2654 |
> |
SetModified(Value); |
2655 |
> |
end; |
2656 |
> |
|
2657 |
> |
procedure TIBCustomDataSet.RevertRecord; |
2658 |
> |
var |
2659 |
> |
Buff: PRecordData; |
2660 |
> |
begin |
2661 |
> |
if FCachedUpdates and FUpdatesPending then |
2662 |
> |
begin |
2663 |
> |
Buff := PRecordData(GetActiveBuf); |
2664 |
> |
InternalRevertRecord(Buff^.rdRecordNumber); |
2665 |
> |
ReadRecordCache(Buff^.rdRecordNumber, PChar(Buff), False); |
2666 |
> |
DataEvent(deRecordChange, 0); |
2667 |
> |
end; |
2668 |
> |
end; |
2669 |
> |
|
2670 |
> |
procedure TIBCustomDataSet.SaveOldBuffer(Buffer: PChar); |
2671 |
> |
var |
2672 |
> |
OldBuffer: Pointer; |
2673 |
> |
procedure CopyOldBuffer; |
2674 |
> |
begin |
2675 |
> |
CopyRecordBuffer(Buffer, OldBuffer); |
2676 |
> |
if BlobFieldCount > 0 then |
2677 |
> |
FillChar(PChar(OldBuffer)[FBlobCacheOffset], |
2678 |
> |
BlobFieldCount * SizeOf(TIBBlobStream) + ArrayFieldCount * SizeOf(IArray), |
2679 |
> |
0); |
2680 |
> |
end; |
2681 |
> |
|
2682 |
> |
begin |
2683 |
> |
if (Buffer <> nil) and (PRecordData(Buffer)^.rdRecordNumber >= 0) then |
2684 |
> |
begin |
2685 |
> |
OldBuffer := AllocRecordBuffer; |
2686 |
> |
try |
2687 |
> |
if (PRecordData(Buffer)^.rdSavedOffset = $FFFFFFFF) then |
2688 |
> |
begin |
2689 |
> |
PRecordData(Buffer)^.rdSavedOffset := AdjustPosition(FOldBufferCache, 0, |
2690 |
> |
FILE_END); |
2691 |
> |
CopyOldBuffer; |
2692 |
> |
WriteCache(FOldBufferCache, 0, FILE_CURRENT, OldBuffer); |
2693 |
> |
WriteCache(FBufferCache, PRecordData(Buffer)^.rdRecordNumber * FRecordBufferSize, |
2694 |
> |
FILE_BEGIN, Buffer); |
2695 |
> |
end |
2696 |
> |
else begin |
2697 |
> |
CopyOldBuffer; |
2698 |
> |
WriteCache(FOldBufferCache, PRecordData(Buffer)^.rdSavedOffset, FILE_BEGIN, |
2699 |
> |
OldBuffer); |
2700 |
> |
end; |
2701 |
> |
finally |
2702 |
> |
FreeRecordBuffer(PChar(OldBuffer)); |
2703 |
> |
end; |
2704 |
> |
end; |
2705 |
> |
end; |
2706 |
> |
|
2707 |
> |
procedure TIBCustomDataSet.SetBufferChunks(Value: Integer); |
2708 |
> |
begin |
2709 |
> |
if (Value <= 0) then |
2710 |
> |
FBufferChunks := BufferCacheSize |
2711 |
> |
else |
2712 |
> |
FBufferChunks := Value; |
2713 |
> |
end; |
2714 |
> |
|
2715 |
> |
procedure TIBCustomDataSet.SetDatabase(Value: TIBDatabase); |
2716 |
> |
begin |
2717 |
> |
if (FBase.Database <> Value) then |
2718 |
> |
begin |
2719 |
> |
CheckDatasetClosed; |
2720 |
> |
InternalUnPrepare; |
2721 |
> |
FBase.Database := Value; |
2722 |
> |
FQDelete.Database := Value; |
2723 |
> |
FQInsert.Database := Value; |
2724 |
> |
FQRefresh.Database := Value; |
2725 |
> |
FQSelect.Database := Value; |
2726 |
> |
FQModify.Database := Value; |
2727 |
> |
FDatabaseInfo.Database := Value; |
2728 |
> |
FGeneratorField.Database := Value; |
2729 |
> |
end; |
2730 |
> |
end; |
2731 |
> |
|
2732 |
> |
procedure TIBCustomDataSet.SetDeleteSQL(Value: TStrings); |
2733 |
> |
begin |
2734 |
> |
if FQDelete.SQL.Text <> Value.Text then |
2735 |
> |
begin |
2736 |
> |
Disconnect; |
2737 |
> |
FQDelete.SQL.Assign(Value); |
2738 |
> |
end; |
2739 |
> |
end; |
2740 |
> |
|
2741 |
> |
procedure TIBCustomDataSet.SetInsertSQL(Value: TStrings); |
2742 |
> |
begin |
2743 |
> |
if FQInsert.SQL.Text <> Value.Text then |
2744 |
> |
begin |
2745 |
> |
Disconnect; |
2746 |
> |
FQInsert.SQL.Assign(Value); |
2747 |
> |
end; |
2748 |
> |
end; |
2749 |
> |
|
2750 |
> |
procedure TIBCustomDataSet.SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer); |
2751 |
> |
var |
2752 |
> |
i, j: Integer; |
2753 |
> |
cr, data: PChar; |
2754 |
> |
fn: string; |
2755 |
> |
st: RawByteString; |
2756 |
> |
OldBuffer: Pointer; |
2757 |
> |
ts: TTimeStamp; |
2758 |
> |
Param: ISQLParam; |
2759 |
> |
begin |
2760 |
> |
if (Buffer = nil) then |
2761 |
> |
IBError(ibxeBufferNotSet, [nil]); |
2762 |
> |
if (not FInternalPrepared) then |
2763 |
> |
InternalPrepare; |
2764 |
> |
OldBuffer := nil; |
2765 |
> |
try |
2766 |
> |
for i := 0 to Params.GetCount - 1 do |
2767 |
> |
begin |
2768 |
> |
Param := Params[i]; |
2769 |
> |
fn := Param.Name; |
2770 |
> |
if (Pos('OLD_', fn) = 1) then {mbcs ok} |
2771 |
> |
begin |
2772 |
> |
fn := Copy(fn, 5, Length(fn)); |
2773 |
> |
if not Assigned(OldBuffer) then |
2774 |
> |
begin |
2775 |
> |
OldBuffer := AllocRecordBuffer; |
2776 |
> |
ReadRecordCache(PRecordData(Buffer)^.rdRecordNumber, OldBuffer, True); |
2777 |
> |
end; |
2778 |
> |
cr := OldBuffer; |
2779 |
> |
end |
2780 |
> |
else if (Pos('NEW_', fn) = 1) then {mbcs ok} |
2781 |
> |
begin |
2782 |
> |
fn := Copy(fn, 5, Length(fn)); |
2783 |
> |
cr := Buffer; |
2784 |
> |
end |
2785 |
> |
else |
2786 |
> |
cr := Buffer; |
2787 |
> |
j := FQSelect.FieldIndex[fn] + 1; |
2788 |
> |
if (j > 0) then |
2789 |
> |
with PRecordData(cr)^,rdFields[j], FFieldColumns^[j] do |
2790 |
> |
begin |
2791 |
> |
if Param.name = 'IBX_INTERNAL_DBKEY' then {do not localize} |
2792 |
> |
begin |
2793 |
> |
PIBDBKey(Param.AsPointer)^ := rdDBKey; |
2794 |
> |
continue; |
2795 |
> |
end; |
2796 |
> |
if fdIsNull then |
2797 |
> |
Param.IsNull := True |
2798 |
> |
else begin |
2799 |
> |
Param.IsNull := False; |
2800 |
> |
data := cr + fdDataOfs; |
2801 |
> |
case fdDataType of |
2802 |
> |
SQL_TEXT, SQL_VARYING: |
2803 |
> |
begin |
2804 |
> |
SetString(st, data, fdDataLength); |
2805 |
> |
SetCodePage(st,fdCodePage,false); |
2806 |
> |
Param.AsString := st; |
2807 |
> |
end; |
2808 |
> |
SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT: |
2809 |
> |
Param.AsDouble := PDouble(data)^; |
2810 |
> |
SQL_SHORT, SQL_LONG: |
2811 |
> |
begin |
2812 |
> |
if fdDataScale = 0 then |
2813 |
> |
Param.AsLong := PLong(data)^ |
2814 |
> |
else |
2815 |
> |
if fdDataScale >= (-4) then |
2816 |
> |
Param.AsCurrency := PCurrency(data)^ |
2817 |
> |
else |
2818 |
> |
Param.AsDouble := PDouble(data)^; |
2819 |
> |
end; |
2820 |
> |
SQL_INT64: |
2821 |
> |
begin |
2822 |
> |
if fdDataScale = 0 then |
2823 |
> |
Param.AsInt64 := PInt64(data)^ |
2824 |
> |
else |
2825 |
> |
if fdDataScale >= (-4) then |
2826 |
> |
Param.AsCurrency := PCurrency(data)^ |
2827 |
> |
else |
2828 |
> |
Param.AsDouble := PDouble(data)^; |
2829 |
> |
end; |
2830 |
> |
SQL_BLOB, SQL_ARRAY, SQL_QUAD: |
2831 |
> |
Param.AsQuad := PISC_QUAD(data)^; |
2832 |
> |
SQL_TYPE_DATE: |
2833 |
> |
begin |
2834 |
> |
ts.Date := PInt(data)^; |
2835 |
> |
ts.Time := 0; |
2836 |
> |
Param.AsDate := TimeStampToDateTime(ts); |
2837 |
> |
end; |
2838 |
> |
SQL_TYPE_TIME: |
2839 |
> |
begin |
2840 |
> |
ts.Date := 0; |
2841 |
> |
ts.Time := PInt(data)^; |
2842 |
> |
Param.AsTime := TimeStampToDateTime(ts); |
2843 |
> |
end; |
2844 |
> |
SQL_TIMESTAMP: |
2845 |
> |
Param.AsDateTime := |
2846 |
> |
TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^))); |
2847 |
> |
SQL_BOOLEAN: |
2848 |
> |
Param.AsBoolean := PWordBool(data)^; |
2849 |
> |
end; |
2850 |
> |
end; |
2851 |
> |
end; |
2852 |
> |
end; |
2853 |
> |
finally |
2854 |
> |
if (OldBuffer <> nil) then |
2855 |
> |
FreeRecordBuffer(PChar(OldBuffer)); |
2856 |
> |
end; |
2857 |
> |
end; |
2858 |
> |
|
2859 |
> |
procedure TIBCustomDataSet.SetRefreshSQL(Value: TStrings); |
2860 |
> |
begin |
2861 |
> |
if FQRefresh.SQL.Text <> Value.Text then |
2862 |
> |
begin |
2863 |
> |
Disconnect; |
2864 |
> |
FQRefresh.SQL.Assign(Value); |
2865 |
> |
end; |
2866 |
> |
end; |
2867 |
> |
|
2868 |
> |
procedure TIBCustomDataSet.SetSelectSQL(Value: TStrings); |
2869 |
> |
begin |
2870 |
> |
if FQSelect.SQL.Text <> Value.Text then |
2871 |
> |
begin |
2872 |
> |
Disconnect; |
2873 |
> |
FQSelect.SQL.Assign(Value); |
2874 |
> |
end; |
2875 |
> |
end; |
2876 |
> |
|
2877 |
> |
procedure TIBCustomDataSet.SetModifySQL(Value: TStrings); |
2878 |
> |
begin |
2879 |
> |
if FQModify.SQL.Text <> Value.Text then |
2880 |
> |
begin |
2881 |
> |
Disconnect; |
2882 |
> |
FQModify.SQL.Assign(Value); |
2883 |
> |
end; |
2884 |
> |
end; |
2885 |
> |
|
2886 |
> |
procedure TIBCustomDataSet.SetTransaction(Value: TIBTransaction); |
2887 |
> |
begin |
2888 |
> |
if (FBase.Transaction <> Value) then |
2889 |
> |
begin |
2890 |
> |
CheckDatasetClosed; |
2891 |
> |
FBase.Transaction := Value; |
2892 |
> |
FQDelete.Transaction := Value; |
2893 |
> |
FQInsert.Transaction := Value; |
2894 |
> |
FQRefresh.Transaction := Value; |
2895 |
> |
FQSelect.Transaction := Value; |
2896 |
> |
FQModify.Transaction := Value; |
2897 |
> |
FGeneratorField.Transaction := Value; |
2898 |
> |
end; |
2899 |
> |
end; |
2900 |
> |
|
2901 |
> |
procedure TIBCustomDataSet.SetUniDirectional(Value: Boolean); |
2902 |
> |
begin |
2903 |
> |
CheckDatasetClosed; |
2904 |
> |
FUniDirectional := Value; |
2905 |
> |
end; |
2906 |
> |
|
2907 |
> |
procedure TIBCustomDataSet.SetUpdateRecordTypes(Value: TIBUpdateRecordTypes); |
2908 |
> |
begin |
2909 |
> |
FUpdateRecordTypes := Value; |
2910 |
> |
if Active then |
2911 |
> |
First; |
2912 |
> |
end; |
2913 |
> |
|
2914 |
> |
procedure TIBCustomDataSet.RefreshParams; |
2915 |
> |
var |
2916 |
> |
DataSet: TDataSet; |
2917 |
> |
begin |
2918 |
> |
DisableControls; |
2919 |
> |
try |
2920 |
> |
if FDataLink.DataSource <> nil then |
2921 |
> |
begin |
2922 |
> |
DataSet := FDataLink.DataSource.DataSet; |
2923 |
> |
if DataSet <> nil then |
2924 |
> |
if DataSet.Active and (DataSet.State <> dsSetKey) then |
2925 |
> |
begin |
2926 |
> |
Close; |
2927 |
> |
Open; |
2928 |
> |
end; |
2929 |
> |
end; |
2930 |
> |
finally |
2931 |
> |
EnableControls; |
2932 |
> |
end; |
2933 |
> |
end; |
2934 |
> |
|
2935 |
> |
procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink); |
2936 |
> |
begin |
2937 |
> |
if FIBLinks.IndexOf(Sender) = -1 then |
2938 |
> |
FIBLinks.Add(Sender); |
2939 |
> |
end; |
2940 |
> |
|
2941 |
> |
|
2942 |
> |
procedure TIBCustomDataSet.SQLChanging(Sender: TObject); |
2943 |
> |
begin |
2944 |
> |
Active := false; |
2945 |
> |
{ if FOpen then |
2946 |
> |
InternalClose;} |
2947 |
> |
if FInternalPrepared then |
2948 |
> |
InternalUnPrepare; |
2949 |
> |
FieldDefs.Clear; |
2950 |
> |
FieldDefs.Updated := false; |
2951 |
> |
end; |
2952 |
> |
|
2953 |
> |
procedure TIBCustomDataSet.SQLChanged(Sender: TObject); |
2954 |
> |
begin |
2955 |
> |
FBaseSQLSelect.assign(FQSelect.SQL); |
2956 |
> |
end; |
2957 |
> |
|
2958 |
> |
{ I can "undelete" uninserted records (make them "inserted" again). |
2959 |
> |
I can "undelete" cached deleted (the deletion hasn't yet occurred) } |
2960 |
> |
procedure TIBCustomDataSet.Undelete; |
2961 |
> |
var |
2962 |
> |
Buff: PRecordData; |
2963 |
> |
begin |
2964 |
> |
CheckActive; |
2965 |
> |
Buff := PRecordData(GetActiveBuf); |
2966 |
> |
with Buff^ do |
2967 |
> |
begin |
2968 |
> |
if rdCachedUpdateStatus = cusUninserted then |
2969 |
> |
begin |
2970 |
> |
rdCachedUpdateStatus := cusInserted; |
2971 |
> |
Dec(FDeletedRecords); |
2972 |
> |
end |
2973 |
> |
else if (rdUpdateStatus = usDeleted) and |
2974 |
> |
(rdCachedUpdateStatus = cusDeleted) then |
2975 |
> |
begin |
2976 |
> |
rdCachedUpdateStatus := cusUnmodified; |
2977 |
> |
rdUpdateStatus := usUnmodified; |
2978 |
> |
Dec(FDeletedRecords); |
2979 |
> |
end; |
2980 |
> |
WriteRecordCache(rdRecordNumber, PChar(Buff)); |
2981 |
> |
end; |
2982 |
> |
end; |
2983 |
> |
|
2984 |
> |
procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink); |
2985 |
> |
begin |
2986 |
> |
FIBLinks.Remove(Sender); |
2987 |
> |
end; |
2988 |
> |
|
2989 |
> |
function TIBCustomDataSet.UpdateStatus: TUpdateStatus; |
2990 |
> |
begin |
2991 |
> |
if Active then |
2992 |
> |
if GetActiveBuf <> nil then |
2993 |
> |
result := PRecordData(GetActiveBuf)^.rdUpdateStatus |
2994 |
> |
else |
2995 |
> |
result := usUnmodified |
2996 |
> |
else |
2997 |
> |
result := usUnmodified; |
2998 |
> |
end; |
2999 |
> |
|
3000 |
> |
function TIBCustomDataSet.IsSequenced: Boolean; |
3001 |
> |
begin |
3002 |
> |
Result := Assigned( FQSelect ) and FQSelect.EOF; |
3003 |
> |
end; |
3004 |
> |
|
3005 |
> |
function TIBCustomDataSet.ParamByName(ParamName: String): ISQLParam; |
3006 |
> |
begin |
3007 |
> |
ActivateConnection; |
3008 |
> |
ActivateTransaction; |
3009 |
> |
if not FInternalPrepared then |
3010 |
> |
InternalPrepare; |
3011 |
> |
Result := Params.ByName(ParamName); |
3012 |
> |
end; |
3013 |
> |
|
3014 |
> |
{Beware: the parameter FCache is used as an identifier to determine which |
3015 |
> |
cache is being operated on and is not referenced in the computation. |
3016 |
> |
The result is an adjusted offset into the identified cache, either the |
3017 |
> |
Buffer Cache or the old Buffer Cache.} |
3018 |
> |
|
3019 |
> |
function TIBCustomDataSet.AdjustPosition(FCache: PChar; Offset: DWORD; |
3020 |
> |
Origin: Integer): DWORD; |
3021 |
> |
var |
3022 |
> |
OldCacheSize: Integer; |
3023 |
> |
begin |
3024 |
> |
if (FCache = FBufferCache) then |
3025 |
> |
begin |
3026 |
> |
case Origin of |
3027 |
> |
FILE_BEGIN: FBPos := Offset; |
3028 |
> |
FILE_CURRENT: FBPos := FBPos + Offset; |
3029 |
> |
FILE_END: FBPos := DWORD(FBEnd) + Offset; |
3030 |
> |
end; |
3031 |
> |
OldCacheSize := FCacheSize; |
3032 |
> |
while (FBPos >= DWORD(FCacheSize)) do |
3033 |
> |
Inc(FCacheSize, FBufferChunkSize); |
3034 |
> |
if FCacheSize > OldCacheSize then |
3035 |
> |
IBAlloc(FBufferCache, FCacheSize, FCacheSize); |
3036 |
> |
result := FBPos; |
3037 |
> |
end |
3038 |
> |
else begin |
3039 |
> |
case Origin of |
3040 |
> |
FILE_BEGIN: FOBPos := Offset; |
3041 |
> |
FILE_CURRENT: FOBPos := FOBPos + Offset; |
3042 |
> |
FILE_END: FOBPos := DWORD(FOBEnd) + Offset; |
3043 |
> |
end; |
3044 |
> |
OldCacheSize := FOldCacheSize; |
3045 |
> |
while (FBPos >= DWORD(FOldCacheSize)) do |
3046 |
> |
Inc(FOldCacheSize, FBufferChunkSize); |
3047 |
> |
if FOldCacheSize > OldCacheSize then |
3048 |
> |
IBAlloc(FOldBufferCache, FOldCacheSize, FOldCacheSize); |
3049 |
> |
result := FOBPos; |
3050 |
> |
end; |
3051 |
> |
end; |
3052 |
> |
|
3053 |
> |
procedure TIBCustomDataSet.ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer; |
3054 |
> |
Buffer: PChar); |
3055 |
> |
var |
3056 |
> |
pCache: PChar; |
3057 |
> |
AdjustedOffset: DWORD; |
3058 |
> |
bOld: Boolean; |
3059 |
> |
begin |
3060 |
> |
bOld := (FCache = FOldBufferCache); |
3061 |
> |
AdjustedOffset := AdjustPosition(FCache, Offset, Origin); |
3062 |
> |
if not bOld then |
3063 |
> |
pCache := FBufferCache + AdjustedOffset |
3064 |
> |
else |
3065 |
> |
pCache := FOldBufferCache + AdjustedOffset; |
3066 |
> |
Move(pCache^, Buffer^, DWORD(FRecordBufferSize)); |
3067 |
> |
AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT); |
3068 |
> |
end; |
3069 |
> |
|
3070 |
> |
procedure TIBCustomDataSet.ReadRecordCache(RecordNumber: Integer; Buffer: PChar; |
3071 |
> |
ReadOldBuffer: Boolean); |
3072 |
> |
begin |
3073 |
> |
if FUniDirectional then |
3074 |
> |
RecordNumber := RecordNumber mod UniCache; |
3075 |
> |
if (ReadOldBuffer) then |
3076 |
> |
begin |
3077 |
> |
ReadRecordCache(RecordNumber, Buffer, False); |
3078 |
> |
if FCachedUpdates and |
3079 |
> |
(PRecordData(Buffer)^.rdSavedOffset <> $FFFFFFFF) then |
3080 |
> |
ReadCache(FOldBufferCache, PRecordData(Buffer)^.rdSavedOffset, FILE_BEGIN, |
3081 |
> |
Buffer) |
3082 |
> |
else |
3083 |
> |
if ReadOldBuffer and |
3084 |
> |
(PRecordData(FOldBuffer)^.rdRecordNumber = RecordNumber) then |
3085 |
> |
CopyRecordBuffer( FOldBuffer, Buffer ) |
3086 |
> |
end |
3087 |
> |
else |
3088 |
> |
ReadCache(FBufferCache, RecordNumber * FRecordBufferSize, FILE_BEGIN, Buffer); |
3089 |
> |
end; |
3090 |
> |
|
3091 |
> |
procedure TIBCustomDataSet.WriteCache(FCache: PChar; Offset: DWORD; Origin: Integer; |
3092 |
> |
Buffer: PChar); |
3093 |
> |
var |
3094 |
> |
pCache: PChar; |
3095 |
> |
AdjustedOffset: DWORD; |
3096 |
> |
bOld: Boolean; |
3097 |
> |
dwEnd: DWORD; |
3098 |
> |
begin |
3099 |
> |
bOld := (FCache = FOldBufferCache); |
3100 |
> |
AdjustedOffset := AdjustPosition(FCache, Offset, Origin); |
3101 |
> |
if not bOld then |
3102 |
> |
pCache := FBufferCache + AdjustedOffset |
3103 |
> |
else |
3104 |
> |
pCache := FOldBufferCache + AdjustedOffset; |
3105 |
> |
Move(Buffer^, pCache^, FRecordBufferSize); |
3106 |
> |
dwEnd := AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT); |
3107 |
> |
if not bOld then |
3108 |
> |
begin |
3109 |
> |
if (dwEnd > FBEnd) then |
3110 |
> |
FBEnd := dwEnd; |
3111 |
> |
end |
3112 |
> |
else begin |
3113 |
> |
if (dwEnd > FOBEnd) then |
3114 |
> |
FOBEnd := dwEnd; |
3115 |
> |
end; |
3116 |
> |
end; |
3117 |
> |
|
3118 |
> |
procedure TIBCustomDataSet.WriteRecordCache(RecordNumber: Integer; Buffer: PChar); |
3119 |
> |
begin |
3120 |
> |
if RecordNumber >= 0 then |
3121 |
> |
begin |
3122 |
> |
if FUniDirectional then |
3123 |
> |
RecordNumber := RecordNumber mod UniCache; |
3124 |
> |
WriteCache(FBufferCache, RecordNumber * FRecordBufferSize, FILE_BEGIN, Buffer); |
3125 |
> |
end; |
3126 |
> |
end; |
3127 |
> |
|
3128 |
> |
function TIBCustomDataSet.AllocRecordBuffer: PChar; |
3129 |
> |
begin |
3130 |
> |
result := nil; |
3131 |
> |
IBAlloc(result, FRecordBufferSize, FRecordBufferSize); |
3132 |
> |
Move(FModelBuffer^, result^, FRecordBufferSize); |
3133 |
> |
end; |
3134 |
> |
|
3135 |
> |
function TIBCustomDataSet.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; |
3136 |
> |
var |
3137 |
> |
pb: PBlobDataArray; |
3138 |
> |
fs: TIBBlobStream; |
3139 |
> |
Buff: PChar; |
3140 |
> |
bTr, bDB: Boolean; |
3141 |
> |
begin |
3142 |
> |
if (Field = nil) or (Field.DataSet <> self) then |
3143 |
> |
IBError(ibxFieldNotinDataSet,[Field.Name,Name]); |
3144 |
> |
Buff := GetActiveBuf; |
3145 |
> |
if Buff = nil then |
3146 |
> |
begin |
3147 |
> |
fs := TIBBlobStream.Create; |
3148 |
> |
fs.Mode := bmReadWrite; |
3149 |
> |
fs.Database := Database; |
3150 |
> |
fs.Transaction := Transaction; |
3151 |
> |
fs.SetField(Field); |
3152 |
> |
FBlobStreamList.Add(Pointer(fs)); |
3153 |
> |
result := TIBDSBlobStream.Create(Field, fs, Mode); |
3154 |
> |
exit; |
3155 |
> |
end; |
3156 |
> |
pb := PBlobDataArray(Buff + FBlobCacheOffset); |
3157 |
> |
if pb^[Field.Offset] = nil then |
3158 |
> |
begin |
3159 |
> |
AdjustRecordOnInsert(Buff); |
3160 |
> |
pb^[Field.Offset] := TIBBlobStream.Create; |
3161 |
> |
fs := pb^[Field.Offset]; |
3162 |
> |
FBlobStreamList.Add(Pointer(fs)); |
3163 |
> |
fs.Mode := bmReadWrite; |
3164 |
> |
fs.Database := Database; |
3165 |
> |
fs.Transaction := Transaction; |
3166 |
> |
fs.SetField(Field); |
3167 |
> |
fs.BlobID := |
3168 |
> |
PISC_QUAD(@Buff[FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^; |
3169 |
> |
if (CachedUpdates) then |
3170 |
> |
begin |
3171 |
> |
bTr := not Transaction.InTransaction; |
3172 |
> |
bDB := not Database.Connected; |
3173 |
> |
if bDB then |
3174 |
> |
Database.Open; |
3175 |
> |
if bTr then |
3176 |
> |
Transaction.StartTransaction; |
3177 |
> |
fs.Seek(0, soFromBeginning); |
3178 |
> |
if bTr then |
3179 |
> |
Transaction.Commit; |
3180 |
> |
if bDB then |
3181 |
> |
Database.Close; |
3182 |
> |
end; |
3183 |
> |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff)); |
3184 |
> |
end else |
3185 |
> |
fs := pb^[Field.Offset]; |
3186 |
> |
result := TIBDSBlobStream.Create(Field, fs, Mode); |
3187 |
> |
end; |
3188 |
> |
|
3189 |
> |
function TIBCustomDataSet.GetArray(Field: TIBArrayField): IArray; |
3190 |
> |
var Buff: PChar; |
3191 |
> |
pda: PArrayDataArray; |
3192 |
> |
bTr, bDB: Boolean; |
3193 |
> |
begin |
3194 |
> |
if (Field = nil) or (Field.DataSet <> self) then |
3195 |
> |
IBError(ibxFieldNotinDataSet,[Field.Name,Name]); |
3196 |
> |
Buff := GetActiveBuf; |
3197 |
> |
if Buff = nil then |
3198 |
> |
Result := Database.Attachment.CreateArray(Transaction.TransactionIntf, |
3199 |
> |
Field.FRelationName,Field.FieldName) |
3200 |
> |
else |
3201 |
> |
begin |
3202 |
> |
pda := PArrayDataArray(Buff + FArrayCacheOffset); |
3203 |
> |
if pda^[Field.FCacheOffset] = nil then |
3204 |
> |
begin |
3205 |
> |
AdjustRecordOnInsert(Buff); |
3206 |
> |
if Field.IsNull then |
3207 |
> |
Result := Database.Attachment.CreateArray(Transaction.TransactionIntf, |
3208 |
> |
Field.FRelationName,Field.FieldName) |
3209 |
> |
else |
3210 |
> |
Result := Database.Attachment.OpenArray(Transaction.TransactionIntf, |
3211 |
> |
Field.FRelationName,Field.FieldName,Field.ArrayID); |
3212 |
> |
pda^[Field.FCacheOffset] := TIBArray.Create(Field,Result); |
3213 |
> |
FArrayList.Add(pda^[Field.FCacheOffset]); |
3214 |
> |
if (CachedUpdates) then |
3215 |
> |
begin |
3216 |
> |
bTr := not Transaction.InTransaction; |
3217 |
> |
bDB := not Database.Connected; |
3218 |
> |
if bDB then |
3219 |
> |
Database.Open; |
3220 |
> |
if bTr then |
3221 |
> |
Transaction.StartTransaction; |
3222 |
> |
pda^[Field.FCacheOffset].ArrayIntf.PreLoad; |
3223 |
> |
if bTr then |
3224 |
> |
Transaction.Commit; |
3225 |
> |
if bDB then |
3226 |
> |
Database.Close; |
3227 |
> |
end; |
3228 |
> |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff)); |
3229 |
> |
end |
3230 |
> |
else |
3231 |
> |
Result := pda^[Field.FCacheOffset].ArrayIntf; |
3232 |
> |
end; |
3233 |
> |
end; |
3234 |
> |
|
3235 |
> |
procedure TIBCustomDataSet.SetArrayIntf(AnArray: IArray; Field: TIBArrayField); |
3236 |
> |
var Buff: PChar; |
3237 |
> |
pda: PArrayDataArray; |
3238 |
> |
begin |
3239 |
> |
if (Field = nil) or (Field.DataSet <> self) then |
3240 |
> |
IBError(ibxFieldNotinDataSet,[Field.Name,Name]); |
3241 |
> |
Buff := GetActiveBuf; |
3242 |
> |
if Buff <> nil then |
3243 |
> |
begin |
3244 |
> |
AdjustRecordOnInsert(Buff); |
3245 |
> |
pda := PArrayDataArray(Buff + FArrayCacheOffset); |
3246 |
> |
pda^[Field.FCacheOffset].FArray := AnArray; |
3247 |
> |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff)); |
3248 |
> |
end; |
3249 |
> |
end; |
3250 |
> |
|
3251 |
> |
function TIBCustomDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; |
3252 |
> |
const |
3253 |
> |
CMPLess = -1; |
3254 |
> |
CMPEql = 0; |
3255 |
> |
CMPGtr = 1; |
3256 |
> |
RetCodes: array[Boolean, Boolean] of ShortInt = ((2, CMPLess), |
3257 |
> |
(CMPGtr, CMPEql)); |
3258 |
> |
begin |
3259 |
> |
result := RetCodes[Bookmark1 = nil, Bookmark2 = nil]; |
3260 |
> |
|
3261 |
> |
if Result = 2 then |
3262 |
> |
begin |
3263 |
> |
if PInteger(Bookmark1)^ < PInteger(Bookmark2)^ then |
3264 |
> |
Result := CMPLess |
3265 |
> |
else |
3266 |
> |
if PInteger(Bookmark1)^ > PInteger(Bookmark2)^ then |
3267 |
> |
Result := CMPGtr |
3268 |
> |
else |
3269 |
> |
Result := CMPEql; |
3270 |
> |
end; |
3271 |
> |
end; |
3272 |
> |
|
3273 |
> |
procedure TIBCustomDataSet.DoBeforeDelete; |
3274 |
> |
var |
3275 |
> |
Buff: PRecordData; |
3276 |
> |
begin |
3277 |
> |
if not CanDelete then |
3278 |
> |
IBError(ibxeCannotDelete, [nil]); |
3279 |
> |
Buff := PRecordData(GetActiveBuf); |
3280 |
> |
if FCachedUpdates and |
3281 |
> |
(Buff^.rdCachedUpdateStatus in [cusUnmodified]) then |
3282 |
> |
SaveOldBuffer(PChar(Buff)); |
3283 |
> |
inherited DoBeforeDelete; |
3284 |
> |
end; |
3285 |
> |
|
3286 |
> |
procedure TIBCustomDataSet.DoAfterDelete; |
3287 |
> |
begin |
3288 |
> |
inherited DoAfterDelete; |
3289 |
> |
FBase.DoAfterDelete(self); |
3290 |
> |
InternalAutoCommit; |
3291 |
> |
end; |
3292 |
> |
|
3293 |
> |
procedure TIBCustomDataSet.DoBeforeEdit; |
3294 |
> |
var |
3295 |
> |
Buff: PRecordData; |
3296 |
> |
begin |
3297 |
> |
Buff := PRecordData(GetActiveBuf); |
3298 |
> |
if not(CanEdit or (FQModify.SQL.Count <> 0) or |
3299 |
> |
(FCachedUpdates and Assigned(FOnUpdateRecord))) then |
3300 |
> |
IBError(ibxeCannotUpdate, [nil]); |
3301 |
> |
if FCachedUpdates and (Buff^.rdCachedUpdateStatus in [cusUnmodified, cusInserted]) then |
3302 |
> |
SaveOldBuffer(PChar(Buff)); |
3303 |
> |
CopyRecordBuffer(GetActiveBuf, FOldBuffer); |
3304 |
> |
inherited DoBeforeEdit; |
3305 |
> |
end; |
3306 |
> |
|
3307 |
> |
procedure TIBCustomDataSet.DoAfterEdit; |
3308 |
> |
begin |
3309 |
> |
inherited DoAfterEdit; |
3310 |
> |
FBase.DoAfterEdit(self); |
3311 |
> |
end; |
3312 |
> |
|
3313 |
> |
procedure TIBCustomDataSet.DoBeforeInsert; |
3314 |
> |
begin |
3315 |
> |
if not CanInsert then |
3316 |
> |
IBError(ibxeCannotInsert, [nil]); |
3317 |
> |
inherited DoBeforeInsert; |
3318 |
> |
end; |
3319 |
> |
|
3320 |
> |
procedure TIBCustomDataSet.DoAfterInsert; |
3321 |
> |
begin |
3322 |
> |
if GeneratorField.ApplyOnEvent = gaeOnNewRecord then |
3323 |
> |
GeneratorField.Apply; |
3324 |
> |
inherited DoAfterInsert; |
3325 |
> |
FBase.DoAfterInsert(self); |
3326 |
> |
end; |
3327 |
> |
|
3328 |
> |
procedure TIBCustomDataSet.DoBeforeClose; |
3329 |
> |
begin |
3330 |
> |
inherited DoBeforeClose; |
3331 |
> |
if FInTransactionEnd and (FCloseAction = TARollback) then |
3332 |
> |
Exit; |
3333 |
> |
if State in [dsInsert,dsEdit] then |
3334 |
> |
begin |
3335 |
> |
if DataSetCloseAction = dcSaveChanges then |
3336 |
> |
Post; |
3337 |
> |
{Note this can fail with an exception e.g. due to |
3338 |
> |
database validation error. In which case the dataset remains open } |
3339 |
> |
end; |
3340 |
> |
if FCachedUpdates and FUpdatesPending and (DataSetCloseAction = dcSaveChanges) then |
3341 |
> |
ApplyUpdates; |
3342 |
> |
end; |
3343 |
> |
|
3344 |
> |
procedure TIBCustomDataSet.DoBeforeOpen; |
3345 |
> |
var i: integer; |
3346 |
> |
begin |
3347 |
> |
if assigned(FParser) then |
3348 |
> |
FParser.Reset; |
3349 |
> |
for i := 0 to FIBLinks.Count - 1 do |
3350 |
> |
TIBControlLink(FIBLinks[i]).UpdateSQL(self); |
3351 |
> |
inherited DoBeforeOpen; |
3352 |
> |
for i := 0 to FIBLinks.Count - 1 do |
3353 |
> |
TIBControlLink(FIBLinks[i]).UpdateParams(self); |
3354 |
> |
end; |
3355 |
> |
|
3356 |
> |
procedure TIBCustomDataSet.DoBeforePost; |
3357 |
> |
begin |
3358 |
> |
inherited DoBeforePost; |
3359 |
> |
if (State = dsInsert) and |
3360 |
> |
(GeneratorField.ApplyOnEvent = gaeOnPostRecord) then |
3361 |
> |
GeneratorField.Apply |
3362 |
> |
end; |
3363 |
> |
|
3364 |
> |
procedure TIBCustomDataSet.DoAfterPost; |
3365 |
> |
begin |
3366 |
> |
inherited DoAfterPost; |
3367 |
> |
FBase.DoAfterPost(self); |
3368 |
> |
InternalAutoCommit; |
3369 |
> |
end; |
3370 |
> |
|
3371 |
> |
procedure TIBCustomDataSet.FetchAll; |
3372 |
> |
var |
3373 |
> |
CurBookmark: TBookmark; |
3374 |
> |
begin |
3375 |
> |
FBase.SetCursor; |
3376 |
> |
try |
3377 |
> |
if FQSelect.EOF or not FQSelect.Open then |
3378 |
> |
exit; |
3379 |
> |
DisableControls; |
3380 |
> |
try |
3381 |
> |
CurBookmark := Bookmark; |
3382 |
> |
Last; |
3383 |
> |
Bookmark := CurBookmark; |
3384 |
> |
finally |
3385 |
> |
EnableControls; |
3386 |
> |
end; |
3387 |
> |
finally |
3388 |
> |
FBase.RestoreCursor; |
3389 |
> |
end; |
3390 |
> |
end; |
3391 |
> |
|
3392 |
> |
procedure TIBCustomDataSet.FreeRecordBuffer(var Buffer: PChar); |
3393 |
> |
begin |
3394 |
> |
FreeMem(Buffer); |
3395 |
> |
Buffer := nil; |
3396 |
> |
end; |
3397 |
> |
|
3398 |
> |
procedure TIBCustomDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer); |
3399 |
> |
begin |
3400 |
> |
Move(PRecordData(Buffer)^.rdRecordNumber, Data^, BookmarkSize); |
3401 |
> |
end; |
3402 |
> |
|
3403 |
> |
function TIBCustomDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; |
3404 |
> |
begin |
3405 |
> |
result := PRecordData(Buffer)^.rdBookmarkFlag; |
3406 |
> |
end; |
3407 |
> |
|
3408 |
> |
function TIBCustomDataSet.GetCanModify: Boolean; |
3409 |
> |
begin |
3410 |
> |
result := (FQInsert.SQL.Text <> '') or |
3411 |
> |
(FQModify.SQL.Text <> '') or |
3412 |
> |
(FQDelete.SQL.Text <> '') or |
3413 |
> |
(Assigned(FUpdateObject)); |
3414 |
> |
end; |
3415 |
> |
|
3416 |
> |
function TIBCustomDataSet.GetCurrentRecord(Buffer: PChar): Boolean; |
3417 |
> |
begin |
3418 |
> |
if not IsEmpty and (GetBookmarkFlag(ActiveBuffer) = bfCurrent) then |
3419 |
> |
begin |
3420 |
> |
UpdateCursorPos; |
3421 |
> |
ReadRecordCache(PRecordData(ActiveBuffer)^.rdRecordNumber, Buffer, False); |
3422 |
> |
result := True; |
3423 |
> |
end |
3424 |
> |
else |
3425 |
> |
result := False; |
3426 |
> |
end; |
3427 |
> |
|
3428 |
> |
function TIBCustomDataSet.GetDataSource: TDataSource; |
3429 |
> |
begin |
3430 |
> |
if FDataLink = nil then |
3431 |
> |
result := nil |
3432 |
> |
else |
3433 |
> |
result := FDataLink.DataSource; |
3434 |
> |
end; |
3435 |
> |
|
3436 |
> |
function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string; |
3437 |
> |
begin |
3438 |
> |
Result := FAliasNameMap[FieldNo-1] |
3439 |
> |
end; |
3440 |
> |
|
3441 |
> |
function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef; |
3442 |
> |
var |
3443 |
> |
i: integer; |
3444 |
> |
begin |
3445 |
> |
Result := nil; |
3446 |
> |
for i := 0 to Length(FAliasNameMap) - 1 do |
3447 |
> |
if FAliasNameMap[i] = aliasName then |
3448 |
> |
begin |
3449 |
> |
Result := FieldDefs[i]; |
3450 |
> |
Exit |
3451 |
> |
end; |
3452 |
> |
end; |
3453 |
> |
|
3454 |
> |
function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass; |
3455 |
> |
begin |
3456 |
> |
Result := DefaultFieldClasses[FieldType]; |
3457 |
> |
end; |
3458 |
> |
|
3459 |
> |
function TIBCustomDataSet.GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; |
3460 |
> |
begin |
3461 |
> |
result := GetFieldData(FieldByNumber(FieldNo), buffer); |
3462 |
> |
end; |
3463 |
> |
|
3464 |
> |
function TIBCustomDataSet.InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean; |
3465 |
> |
var |
3466 |
> |
Buff, Data: PChar; |
3467 |
> |
CurrentRecord: PRecordData; |
3468 |
> |
begin |
3469 |
> |
result := False; |
3470 |
> |
Buff := GetActiveBuf; |
3471 |
> |
if (Buff = nil) or |
3472 |
> |
(not IsVisible(Buff)) or not assigned(Field.DataSet) then |
3473 |
> |
exit; |
3474 |
> |
{ The intention here is to stuff the buffer with the data for the |
3475 |
> |
referenced field for the current record } |
3476 |
> |
CurrentRecord := PRecordData(Buff); |
3477 |
> |
if (Field.FieldNo < 0) then |
3478 |
> |
begin |
3479 |
> |
Inc(Buff, FRecordSize + Field.Offset); |
3480 |
> |
result := Boolean(Buff[0]); |
3481 |
> |
if result and (Buffer <> nil) then |
3482 |
> |
Move(Buff[1], Buffer^, Field.DataSize); |
3483 |
> |
end |
3484 |
> |
else |
3485 |
> |
if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and |
3486 |
> |
(FMappedFieldPosition[Field.FieldNo - 1] <= CurrentRecord^.rdFieldCount) then |
3487 |
> |
with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]], |
3488 |
> |
FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]] do |
3489 |
> |
begin |
3490 |
> |
result := not fdIsNull; |
3491 |
> |
if result and (Buffer <> nil) then |
3492 |
> |
begin |
3493 |
> |
Data := Buff + fdDataOfs; |
3494 |
> |
if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then |
3495 |
> |
begin |
3496 |
> |
if fdDataLength < Field.DataSize then |
3497 |
> |
begin |
3498 |
> |
Move(Data^, Buffer^, fdDataLength); |
3499 |
> |
PChar(Buffer)[fdDataLength] := #0; |
3500 |
> |
end |
3501 |
> |
else |
3502 |
> |
IBError(ibxeFieldSizeError,[Field.FieldName]) |
3503 |
> |
end |
3504 |
> |
else |
3505 |
> |
Move(Data^, Buffer^, Field.DataSize); |
3506 |
> |
end; |
3507 |
> |
end; |
3508 |
> |
end; |
3509 |
> |
|
3510 |
> |
{ GetRecNo and SetRecNo both operate off of 1-based indexes as |
3511 |
> |
opposed to 0-based indexes. |
3512 |
> |
This is because we want LastRecordNumber/RecordCount = 1 } |
3513 |
> |
|
3514 |
> |
function TIBCustomDataSet.GetRecNo: Integer; |
3515 |
> |
begin |
3516 |
> |
if GetActiveBuf = nil then |
3517 |
> |
result := 0 |
3518 |
> |
else |
3519 |
> |
result := PRecordData(GetActiveBuf)^.rdRecordNumber + 1; |
3520 |
> |
end; |
3521 |
> |
|
3522 |
> |
function TIBCustomDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode; |
3523 |
> |
DoCheck: Boolean): TGetResult; |
3524 |
> |
var |
3525 |
> |
Accept: Boolean; |
3526 |
> |
SaveState: TDataSetState; |
3527 |
> |
begin |
3528 |
> |
Result := grOK; |
3529 |
> |
if Filtered and Assigned(OnFilterRecord) then |
3530 |
> |
begin |
3531 |
> |
Accept := False; |
3532 |
> |
SaveState := SetTempState(dsFilter); |
3533 |
> |
while not Accept do |
3534 |
> |
begin |
3535 |
> |
Result := InternalGetRecord(Buffer, GetMode, DoCheck); |
3536 |
> |
if Result <> grOK then |
3537 |
> |
break; |
3538 |
> |
FFilterBuffer := Buffer; |
3539 |
> |
try |
3540 |
> |
Accept := True; |
3541 |
> |
OnFilterRecord(Self, Accept); |
3542 |
> |
if not Accept and (GetMode = gmCurrent) then |
3543 |
> |
GetMode := gmPrior; |
3544 |
> |
except |
3545 |
> |
// FBase.HandleException(Self); |
3546 |
> |
end; |
3547 |
> |
end; |
3548 |
> |
RestoreState(SaveState); |
3549 |
> |
end |
3550 |
> |
else |
3551 |
> |
Result := InternalGetRecord(Buffer, GetMode, DoCheck); |
3552 |
> |
end; |
3553 |
> |
|
3554 |
> |
function TIBCustomDataSet.InternalGetRecord(Buffer: PChar; GetMode: TGetMode; |
3555 |
> |
DoCheck: Boolean): TGetResult; |
3556 |
> |
begin |
3557 |
> |
result := grError; |
3558 |
> |
case GetMode of |
3559 |
> |
gmCurrent: begin |
3560 |
> |
if (FCurrentRecord >= 0) then begin |
3561 |
> |
if FCurrentRecord < FRecordCount then |
3562 |
> |
ReadRecordCache(FCurrentRecord, Buffer, False) |
3563 |
> |
else begin |
3564 |
> |
while (not FQSelect.EOF) and FQSelect.Next and |
3565 |
> |
(FCurrentRecord >= FRecordCount) do begin |
3566 |
> |
FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer); |
3567 |
> |
Inc(FRecordCount); |
3568 |
> |
end; |
3569 |
> |
FCurrentRecord := FRecordCount - 1; |
3570 |
> |
if (FCurrentRecord >= 0) then |
3571 |
> |
ReadRecordCache(FCurrentRecord, Buffer, False); |
3572 |
> |
end; |
3573 |
> |
result := grOk; |
3574 |
> |
end else |
3575 |
> |
result := grBOF; |
3576 |
> |
end; |
3577 |
> |
gmNext: begin |
3578 |
> |
result := grOk; |
3579 |
> |
if FCurrentRecord = FRecordCount then |
3580 |
> |
result := grEOF |
3581 |
> |
else if FCurrentRecord = FRecordCount - 1 then begin |
3582 |
> |
if (not FQSelect.EOF) then begin |
3583 |
> |
FQSelect.Next; |
3584 |
> |
Inc(FCurrentRecord); |
3585 |
> |
end; |
3586 |
> |
if (FQSelect.EOF) then begin |
3587 |
> |
result := grEOF; |
3588 |
> |
end else begin |
3589 |
> |
Inc(FRecordCount); |
3590 |
> |
FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer); |
3591 |
> |
end; |
3592 |
> |
end else if (FCurrentRecord < FRecordCount) then begin |
3593 |
> |
Inc(FCurrentRecord); |
3594 |
> |
ReadRecordCache(FCurrentRecord, Buffer, False); |
3595 |
> |
end; |
3596 |
> |
end; |
3597 |
> |
else { gmPrior } |
3598 |
> |
begin |
3599 |
> |
if (FCurrentRecord = 0) then begin |
3600 |
> |
Dec(FCurrentRecord); |
3601 |
> |
result := grBOF; |
3602 |
> |
end else if (FCurrentRecord > 0) and |
3603 |
> |
(FCurrentRecord <= FRecordCount) then begin |
3604 |
> |
Dec(FCurrentRecord); |
3605 |
> |
ReadRecordCache(FCurrentRecord, Buffer, False); |
3606 |
> |
result := grOk; |
3607 |
> |
end else if (FCurrentRecord = -1) then |
3608 |
> |
result := grBOF; |
3609 |
> |
end; |
3610 |
> |
end; |
3611 |
> |
if result = grOk then |
3612 |
> |
result := AdjustCurrentRecord(Buffer, GetMode); |
3613 |
> |
if result = grOk then with PRecordData(Buffer)^ do begin |
3614 |
> |
rdBookmarkFlag := bfCurrent; |
3615 |
> |
GetCalcFields(Buffer); |
3616 |
> |
end else if (result = grEOF) then begin |
3617 |
> |
CopyRecordBuffer(FModelBuffer, Buffer); |
3618 |
> |
PRecordData(Buffer)^.rdBookmarkFlag := bfEOF; |
3619 |
> |
end else if (result = grBOF) then begin |
3620 |
> |
CopyRecordBuffer(FModelBuffer, Buffer); |
3621 |
> |
PRecordData(Buffer)^.rdBookmarkFlag := bfBOF; |
3622 |
> |
end else if (result = grError) then begin |
3623 |
> |
CopyRecordBuffer(FModelBuffer, Buffer); |
3624 |
> |
PRecordData(Buffer)^.rdBookmarkFlag := bfEOF; |
3625 |
> |
end;; |
3626 |
> |
end; |
3627 |
> |
|
3628 |
> |
function TIBCustomDataSet.GetRecordCount: Integer; |
3629 |
> |
begin |
3630 |
> |
result := FRecordCount - FDeletedRecords; |
3631 |
> |
end; |
3632 |
> |
|
3633 |
> |
function TIBCustomDataSet.GetRecordSize: Word; |
3634 |
> |
begin |
3635 |
> |
result := FRecordBufferSize; |
3636 |
> |
end; |
3637 |
> |
|
3638 |
> |
procedure TIBCustomDataSet.InternalAutoCommit; |
3639 |
> |
begin |
3640 |
> |
with Transaction do |
3641 |
> |
if InTransaction and (FAutoCommit = acCommitRetaining) then |
3642 |
> |
begin |
3643 |
> |
if CachedUpdates then ApplyUpdates; |
3644 |
> |
CommitRetaining; |
3645 |
> |
end; |
3646 |
> |
end; |
3647 |
> |
|
3648 |
> |
procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean); |
3649 |
> |
begin |
3650 |
> |
CheckEditState; |
3651 |
> |
begin |
3652 |
> |
{ When adding records, we *always* append. |
3653 |
> |
Insertion is just too costly } |
3654 |
> |
AdjustRecordOnInsert(Buffer); |
3655 |
> |
with PRecordData(Buffer)^ do |
3656 |
> |
begin |
3657 |
> |
rdUpdateStatus := usInserted; |
3658 |
> |
rdCachedUpdateStatus := cusInserted; |
3659 |
> |
end; |
3660 |
> |
if not CachedUpdates then |
3661 |
> |
InternalPostRecord(FQInsert, Buffer) |
3662 |
> |
else begin |
3663 |
> |
WriteRecordCache(FCurrentRecord, Buffer); |
3664 |
> |
FUpdatesPending := True; |
3665 |
> |
end; |
3666 |
> |
Inc(FRecordCount); |
3667 |
> |
InternalSetToRecord(Buffer); |
3668 |
> |
end |
3669 |
> |
end; |
3670 |
> |
|
3671 |
> |
procedure TIBCustomDataSet.InternalCancel; |
3672 |
> |
var |
3673 |
> |
Buff: PChar; |
3674 |
> |
CurRec: Integer; |
3675 |
> |
pda: PArrayDataArray; |
3676 |
> |
i: integer; |
3677 |
> |
begin |
3678 |
> |
inherited InternalCancel; |
3679 |
> |
Buff := GetActiveBuf; |
3680 |
> |
if Buff <> nil then |
3681 |
> |
begin |
3682 |
> |
pda := PArrayDataArray(Buff + FArrayCacheOffset); |
3683 |
> |
for i := 0 to ArrayFieldCount - 1 do |
3684 |
> |
pda^[i].ArrayIntf.CancelChanges; |
3685 |
> |
CurRec := FCurrentRecord; |
3686 |
> |
AdjustRecordOnInsert(Buff); |
3687 |
> |
if (State = dsEdit) then begin |
3688 |
> |
CopyRecordBuffer(FOldBuffer, Buff); |
3689 |
> |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff); |
3690 |
> |
end else begin |
3691 |
> |
CopyRecordBuffer(FModelBuffer, Buff); |
3692 |
> |
PRecordData(Buff)^.rdUpdateStatus := usDeleted; |
3693 |
> |
PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified; |
3694 |
> |
PRecordData(Buff)^.rdBookmarkFlag := bfEOF; |
3695 |
> |
FCurrentRecord := CurRec; |
3696 |
> |
end; |
3697 |
> |
end; |
3698 |
> |
end; |
3699 |
> |
|
3700 |
> |
|
3701 |
> |
procedure TIBCustomDataSet.InternalClose; |
3702 |
> |
begin |
3703 |
> |
if FDidActivate then |
3704 |
> |
DeactivateTransaction; |
3705 |
> |
FQSelect.Close; |
3706 |
> |
ClearBlobCache; |
3707 |
> |
ClearArrayCache; |
3708 |
> |
FreeRecordBuffer(FModelBuffer); |
3709 |
> |
FreeRecordBuffer(FOldBuffer); |
3710 |
> |
FCurrentRecord := -1; |
3711 |
> |
FOpen := False; |
3712 |
> |
FRecordCount := 0; |
3713 |
> |
FDeletedRecords := 0; |
3714 |
> |
FRecordSize := 0; |
3715 |
> |
FBPos := 0; |
3716 |
> |
FOBPos := 0; |
3717 |
> |
FCacheSize := 0; |
3718 |
> |
FOldCacheSize := 0; |
3719 |
> |
FBEnd := 0; |
3720 |
> |
FOBEnd := 0; |
3721 |
> |
FreeMem(FBufferCache); |
3722 |
> |
FBufferCache := nil; |
3723 |
> |
FreeMem(FFieldColumns); |
3724 |
> |
FFieldColumns := nil; |
3725 |
> |
FreeMem(FOldBufferCache); |
3726 |
> |
FOldBufferCache := nil; |
3727 |
> |
BindFields(False); |
3728 |
> |
ResetParser; |
3729 |
> |
if DefaultFields then DestroyFields; |
3730 |
> |
end; |
3731 |
> |
|
3732 |
> |
procedure TIBCustomDataSet.InternalDelete; |
3733 |
> |
var |
3734 |
> |
Buff: PChar; |
3735 |
> |
begin |
3736 |
> |
FBase.SetCursor; |
3737 |
> |
try |
3738 |
> |
Buff := GetActiveBuf; |
3739 |
> |
if CanDelete then |
3740 |
> |
begin |
3741 |
> |
if not CachedUpdates then |
3742 |
> |
InternalDeleteRecord(FQDelete, Buff) |
3743 |
> |
else |
3744 |
> |
begin |
3745 |
> |
with PRecordData(Buff)^ do |
3746 |
> |
begin |
3747 |
> |
if rdCachedUpdateStatus = cusInserted then |
3748 |
> |
rdCachedUpdateStatus := cusUninserted |
3749 |
> |
else begin |
3750 |
> |
rdUpdateStatus := usDeleted; |
3751 |
> |
rdCachedUpdateStatus := cusDeleted; |
3752 |
> |
end; |
3753 |
> |
end; |
3754 |
> |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff); |
3755 |
> |
end; |
3756 |
> |
Inc(FDeletedRecords); |
3757 |
> |
FUpdatesPending := True; |
3758 |
> |
end else |
3759 |
> |
IBError(ibxeCannotDelete, [nil]); |
3760 |
> |
finally |
3761 |
> |
FBase.RestoreCursor; |
3762 |
> |
end; |
3763 |
> |
end; |
3764 |
> |
|
3765 |
> |
procedure TIBCustomDataSet.InternalFirst; |
3766 |
> |
begin |
3767 |
> |
FCurrentRecord := -1; |
3768 |
> |
end; |
3769 |
> |
|
3770 |
> |
procedure TIBCustomDataSet.InternalGotoBookmark(Bookmark: Pointer); |
3771 |
> |
begin |
3772 |
> |
FCurrentRecord := PInteger(Bookmark)^; |
3773 |
> |
end; |
3774 |
> |
|
3775 |
> |
procedure TIBCustomDataSet.InternalHandleException; |
3776 |
> |
begin |
3777 |
> |
FBase.HandleException(Self) |
3778 |
> |
end; |
3779 |
> |
|
3780 |
> |
procedure TIBCustomDataSet.InternalInitFieldDefs; |
3781 |
> |
begin |
3782 |
> |
if not InternalPrepared then |
3783 |
> |
begin |
3784 |
> |
InternalPrepare; |
3785 |
> |
exit; |
3786 |
> |
end; |
3787 |
> |
FieldDefsFromQuery(FQSelect); |
3788 |
> |
end; |
3789 |
> |
|
3790 |
> |
procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL); |
3791 |
> |
const |
3792 |
> |
DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize} |
3793 |
> |
'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize} |
3794 |
> |
'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize} |
3795 |
> |
'where R.RDB$RELATION_NAME = :RELATION ' + {do not localize} |
3796 |
> |
'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize} |
3797 |
> |
'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize} |
3798 |
> |
' (not F.RDB$DEFAULT_VALUE is NULL)) '; {do not localize} |
3799 |
> |
|
3800 |
> |
DefaultSQLODS12 = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize} |
3801 |
> |
'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME, R.RDB$IDENTITY_TYPE ' + {do not localize} |
3802 |
> |
'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize} |
3803 |
> |
'where R.RDB$RELATION_NAME = :RELATION ' + {do not localize} |
3804 |
> |
'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize} |
3805 |
> |
'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize} |
3806 |
> |
' (not F.RDB$DEFAULT_VALUE is NULL) or ' + {do not localize} |
3807 |
> |
' ( not R.RDB$IDENTITY_TYPE is NULL))' ; {do not localize} |
3808 |
> |
|
3809 |
> |
var |
3810 |
> |
FieldType: TFieldType; |
3811 |
> |
FieldSize: Word; |
3812 |
> |
FieldDataSize: integer; |
3813 |
> |
charSetID: short; |
3814 |
> |
CharSetSize: integer; |
3815 |
> |
CharSetName: RawByteString; |
3816 |
> |
FieldCodePage: TSystemCodePage; |
3817 |
> |
FieldNullable : Boolean; |
3818 |
> |
i, FieldPosition, FieldPrecision: Integer; |
3819 |
> |
FieldAliasName, DBAliasName: string; |
3820 |
> |
aRelationName, FieldName: string; |
3821 |
> |
Query : TIBSQL; |
3822 |
> |
FieldIndex: Integer; |
3823 |
> |
FRelationNodes : TRelationNode; |
3824 |
> |
aArrayDimensions: integer; |
3825 |
> |
aArrayBounds: TArrayBounds; |
3826 |
> |
ArrayMetaData: IArrayMetaData; |
3827 |
> |
|
3828 |
> |
function Add_Node(Relation, Field : String) : TRelationNode; |
3829 |
> |
var |
3830 |
> |
FField : TFieldNode; |
3831 |
> |
begin |
3832 |
> |
if FRelationNodes.RelationName = '' then |
3833 |
> |
Result := FRelationNodes |
3834 |
> |
else |
3835 |
> |
begin |
3836 |
> |
Result := TRelationNode.Create; |
3837 |
> |
Result.NextRelation := FRelationNodes; |
3838 |
> |
end; |
3839 |
> |
Result.RelationName := Relation; |
3840 |
> |
FRelationNodes := Result; |
3841 |
> |
Query.Params[0].AsString := Relation; |
3842 |
> |
Query.ExecQuery; |
3843 |
> |
while not Query.Eof do |
3844 |
> |
begin |
3845 |
> |
FField := TFieldNode.Create; |
3846 |
> |
FField.FieldName := Query.Fields[2].AsString; |
3847 |
> |
FField.DEFAULT_VALUE := not Query.Fields[1].IsNull; |
3848 |
> |
FField.COMPUTED_BLR := not Query.Fields[0].IsNull; |
3849 |
> |
FField.IDENTITY_COLUMN := (Query.FieldCount > 3) and not Query.Fields[3].IsNull; |
3850 |
> |
FField.NextField := Result.FieldNodes; |
3851 |
> |
Result.FieldNodes := FField; |
3852 |
> |
Query.Next; |
3853 |
> |
end; |
3854 |
> |
Query.Close; |
3855 |
> |
end; |
3856 |
> |
|
3857 |
> |
function Has_COMPUTED_BLR(Relation, Field : String) : Boolean; |
3858 |
> |
var |
3859 |
> |
FRelation : TRelationNode; |
3860 |
> |
FField : TFieldNode; |
3861 |
> |
begin |
3862 |
> |
FRelation := FRelationNodes; |
3863 |
> |
while Assigned(FRelation) and |
3864 |
> |
(FRelation.RelationName <> Relation) do |
3865 |
> |
FRelation := FRelation.NextRelation; |
3866 |
> |
if not Assigned(FRelation) then |
3867 |
> |
FRelation := Add_Node(Relation, Field); |
3868 |
> |
Result := false; |
3869 |
> |
FField := FRelation.FieldNodes; |
3870 |
> |
while Assigned(FField) do |
3871 |
> |
if FField.FieldName = Field then |
3872 |
> |
begin |
3873 |
> |
Result := Ffield.COMPUTED_BLR; |
3874 |
> |
Exit; |
3875 |
> |
end |
3876 |
> |
else |
3877 |
> |
FField := Ffield.NextField; |
3878 |
> |
end; |
3879 |
> |
|
3880 |
> |
function Has_DEFAULT_VALUE(Relation, Field : String) : Boolean; |
3881 |
> |
var |
3882 |
> |
FRelation : TRelationNode; |
3883 |
> |
FField : TFieldNode; |
3884 |
> |
begin |
3885 |
> |
FRelation := FRelationNodes; |
3886 |
> |
while Assigned(FRelation) and |
3887 |
> |
(FRelation.RelationName <> Relation) do |
3888 |
> |
FRelation := FRelation.NextRelation; |
3889 |
> |
if not Assigned(FRelation) then |
3890 |
> |
FRelation := Add_Node(Relation, Field); |
3891 |
> |
Result := false; |
3892 |
> |
FField := FRelation.FieldNodes; |
3893 |
> |
while Assigned(FField) do |
3894 |
> |
if FField.FieldName = Field then |
3895 |
> |
begin |
3896 |
> |
Result := Ffield.DEFAULT_VALUE; |
3897 |
> |
Exit; |
3898 |
> |
end |
3899 |
> |
else |
3900 |
> |
FField := Ffield.NextField; |
3901 |
> |
end; |
3902 |
> |
|
3903 |
> |
function Is_IDENTITY_COLUMN(Relation, Field : String) : Boolean; |
3904 |
> |
var |
3905 |
> |
FRelation : TRelationNode; |
3906 |
> |
FField : TFieldNode; |
3907 |
> |
begin |
3908 |
> |
FRelation := FRelationNodes; |
3909 |
> |
while Assigned(FRelation) and |
3910 |
> |
(FRelation.RelationName <> Relation) do |
3911 |
> |
FRelation := FRelation.NextRelation; |
3912 |
> |
if not Assigned(FRelation) then |
3913 |
> |
FRelation := Add_Node(Relation, Field); |
3914 |
> |
Result := false; |
3915 |
> |
FField := FRelation.FieldNodes; |
3916 |
> |
while Assigned(FField) do |
3917 |
> |
if FField.FieldName = Field then |
3918 |
> |
begin |
3919 |
> |
Result := Ffield.IDENTITY_COLUMN; |
3920 |
> |
Exit; |
3921 |
> |
end |
3922 |
> |
else |
3923 |
> |
FField := Ffield.NextField; |
3924 |
> |
end; |
3925 |
> |
|
3926 |
> |
Procedure FreeNodes; |
3927 |
> |
var |
3928 |
> |
FRelation : TRelationNode; |
3929 |
> |
FField : TFieldNode; |
3930 |
> |
begin |
3931 |
> |
while Assigned(FRelationNodes) do |
3932 |
> |
begin |
3933 |
> |
While Assigned(FRelationNodes.FieldNodes) do |
3934 |
> |
begin |
3935 |
> |
FField := FRelationNodes.FieldNodes.NextField; |
3936 |
> |
FRelationNodes.FieldNodes.Free; |
3937 |
> |
FRelationNodes.FieldNodes := FField; |
3938 |
> |
end; |
3939 |
> |
FRelation := FRelationNodes.NextRelation; |
3940 |
> |
FRelationNodes.Free; |
3941 |
> |
FRelationNodes := FRelation; |
3942 |
> |
end; |
3943 |
> |
end; |
3944 |
> |
|
3945 |
> |
begin |
3946 |
> |
FRelationNodes := TRelationNode.Create; |
3947 |
> |
FNeedsRefresh := False; |
3948 |
> |
if not Database.InternalTransaction.InTransaction then |
3949 |
> |
Database.InternalTransaction.StartTransaction; |
3950 |
> |
Query := TIBSQL.Create(self); |
3951 |
> |
try |
3952 |
> |
Query.Database := DataBase; |
3953 |
> |
Query.Transaction := Database.InternalTransaction; |
3954 |
> |
FieldDefs.BeginUpdate; |
3955 |
> |
FieldDefs.Clear; |
3956 |
> |
FieldIndex := 0; |
3957 |
> |
if (Length(FMappedFieldPosition) < SourceQuery.MetaData.Count) then |
3958 |
> |
SetLength(FMappedFieldPosition, SourceQuery.MetaData.Count); |
3959 |
> |
if FDatabaseInfo.ODSMajorVersion >= 12 then |
3960 |
> |
Query.SQL.Text := DefaultSQLODS12 |
3961 |
> |
else |
3962 |
> |
Query.SQL.Text := DefaultSQL; |
3963 |
> |
Query.Prepare; |
3964 |
> |
SetLength(FAliasNameMap, SourceQuery.MetaData.Count); |
3965 |
> |
SetLength(FAliasNameList, SourceQuery.MetaData.Count); |
3966 |
> |
for i := 0 to SourceQuery.MetaData.GetCount - 1 do |
3967 |
> |
with SourceQuery.MetaData[i] do |
3968 |
> |
begin |
3969 |
> |
{ Get the field name } |
3970 |
> |
FieldAliasName := GetName; |
3971 |
> |
DBAliasName := GetAliasname; |
3972 |
> |
aRelationName := getRelationName; |
3973 |
> |
FieldName := getSQLName; |
3974 |
> |
FAliasNameList[i] := DBAliasName; |
3975 |
> |
FieldSize := 0; |
3976 |
> |
FieldDataSize := GetSize; |
3977 |
> |
FieldPrecision := 0; |
3978 |
> |
FieldNullable := IsNullable; |
3979 |
> |
CharSetSize := 0; |
3980 |
> |
CharSetName := ''; |
3981 |
> |
FieldCodePage := CP_NONE; |
3982 |
> |
aArrayDimensions := 0; |
3983 |
> |
SetLength(aArrayBounds,0); |
3984 |
> |
case SQLType of |
3985 |
> |
{ All VARCHAR's must be converted to strings before recording |
3986 |
> |
their values } |
3987 |
> |
SQL_VARYING, SQL_TEXT: |
3988 |
> |
begin |
3989 |
> |
if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then |
3990 |
> |
CharSetSize := 1; |
3991 |
> |
CharSetName := Database.Attachment.GetCharsetName(getCharSetID); |
3992 |
> |
Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage); |
3993 |
> |
FieldSize := FieldDataSize div CharSetSize; |
3994 |
> |
FieldType := ftString; |
3995 |
> |
end; |
3996 |
> |
{ All Doubles/Floats should be cast to doubles } |
3997 |
> |
SQL_DOUBLE, SQL_FLOAT: |
3998 |
> |
FieldType := ftFloat; |
3999 |
> |
SQL_SHORT: |
4000 |
> |
begin |
4001 |
> |
if (getScale = 0) then |
4002 |
> |
FieldType := ftSmallInt |
4003 |
> |
else begin |
4004 |
> |
FieldType := ftBCD; |
4005 |
> |
FieldPrecision := 4; |
4006 |
> |
FieldSize := -getScale; |
4007 |
> |
end; |
4008 |
> |
end; |
4009 |
> |
SQL_LONG: |
4010 |
> |
begin |
4011 |
> |
if (getScale = 0) then |
4012 |
> |
FieldType := ftInteger |
4013 |
> |
else if (getScale >= (-4)) then |
4014 |
> |
begin |
4015 |
> |
FieldType := ftBCD; |
4016 |
> |
FieldPrecision := 9; |
4017 |
> |
FieldSize := -getScale; |
4018 |
> |
end |
4019 |
> |
else |
4020 |
> |
if Database.SQLDialect = 1 then |
4021 |
> |
FieldType := ftFloat |
4022 |
> |
else |
4023 |
> |
if (FieldCount > i) and (Fields[i] is TFloatField) then |
4024 |
> |
FieldType := ftFloat |
4025 |
> |
else |
4026 |
> |
begin |
4027 |
> |
FieldType := ftFMTBCD; |
4028 |
> |
FieldPrecision := 9; |
4029 |
> |
FieldSize := -getScale; |
4030 |
> |
end; |
4031 |
> |
end; |
4032 |
> |
|
4033 |
> |
SQL_INT64: |
4034 |
> |
begin |
4035 |
> |
if (getScale = 0) then |
4036 |
> |
FieldType := ftLargeInt |
4037 |
> |
else if (getScale >= (-4)) then |
4038 |
> |
begin |
4039 |
> |
FieldType := ftBCD; |
4040 |
> |
FieldPrecision := 18; |
4041 |
> |
FieldSize := -getScale; |
4042 |
> |
end |
4043 |
> |
else |
4044 |
> |
FieldType := ftFloat; |
4045 |
> |
end; |
4046 |
> |
SQL_TIMESTAMP: FieldType := ftDateTime; |
4047 |
> |
SQL_TYPE_TIME: FieldType := ftTime; |
4048 |
> |
SQL_TYPE_DATE: FieldType := ftDate; |
4049 |
> |
SQL_BLOB: |
4050 |
> |
begin |
4051 |
> |
FieldSize := sizeof (TISC_QUAD); |
4052 |
> |
if (getSubtype = 1) then |
4053 |
> |
begin |
4054 |
> |
if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then |
4055 |
> |
CharSetSize := 1; |
4056 |
> |
CharSetName := Database.Attachment.GetCharsetName(getCharSetID); |
4057 |
> |
Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage); |
4058 |
> |
FieldType := ftMemo; |
4059 |
> |
end |
4060 |
> |
else |
4061 |
> |
FieldType := ftBlob; |
4062 |
> |
end; |
4063 |
> |
SQL_ARRAY: |
4064 |
> |
begin |
4065 |
> |
FieldSize := sizeof (TISC_QUAD); |
4066 |
> |
FieldType := ftArray; |
4067 |
> |
ArrayMetaData := GetArrayMetaData; |
4068 |
> |
if ArrayMetaData <> nil then |
4069 |
> |
begin |
4070 |
> |
aArrayDimensions := ArrayMetaData.GetDimensions; |
4071 |
> |
aArrayBounds := ArrayMetaData.GetBounds; |
4072 |
> |
end; |
4073 |
> |
end; |
4074 |
> |
SQL_BOOLEAN: |
4075 |
> |
FieldType:= ftBoolean; |
4076 |
> |
else |
4077 |
> |
FieldType := ftUnknown; |
4078 |
> |
end; |
4079 |
> |
FieldPosition := i + 1; |
4080 |
> |
if (FieldType <> ftUnknown) and (FieldAliasName <> 'IBX_INTERNAL_DBKEY') then {do not localize} |
4081 |
> |
begin |
4082 |
> |
FMappedFieldPosition[FieldIndex] := FieldPosition; |
4083 |
> |
Inc(FieldIndex); |
4084 |
> |
with TIBFieldDef.Create(FieldDefs,'',FieldType,0,False,FieldDefs.Count+1) do |
4085 |
> |
begin |
4086 |
> |
Name := FieldAliasName; |
4087 |
> |
FAliasNameMap[FieldNo-1] := DBAliasName; |
4088 |
> |
Size := FieldSize; |
4089 |
> |
DataSize := FieldDataSize; |
4090 |
> |
Precision := FieldPrecision; |
4091 |
> |
Required := not FieldNullable; |
4092 |
> |
RelationName := aRelationName; |
4093 |
> |
InternalCalcField := False; |
4094 |
> |
CharacterSetSize := CharSetSize; |
4095 |
> |
CharacterSetName := CharSetName; |
4096 |
> |
CodePage := FieldCodePage; |
4097 |
> |
ArrayDimensions := aArrayDimensions; |
4098 |
> |
ArrayBounds := aArrayBounds; |
4099 |
> |
if (FieldName <> '') and (RelationName <> '') then |
4100 |
> |
begin |
4101 |
> |
IdentityColumn := Is_IDENTITY_COLUMN(RelationName, FieldName); |
4102 |
> |
if Has_COMPUTED_BLR(RelationName, FieldName) then |
4103 |
> |
begin |
4104 |
> |
Attributes := [faReadOnly]; |
4105 |
> |
InternalCalcField := True; |
4106 |
> |
FNeedsRefresh := True; |
4107 |
> |
end |
4108 |
> |
else |
4109 |
> |
begin |
4110 |
> |
if Has_DEFAULT_VALUE(RelationName, FieldName) then |
4111 |
> |
begin |
4112 |
> |
if not FieldNullable then |
4113 |
> |
Attributes := [faRequired]; |
4114 |
> |
end |
4115 |
> |
else |
4116 |
> |
FNeedsRefresh := True; |
4117 |
> |
end; |
4118 |
> |
end; |
4119 |
> |
end; |
4120 |
> |
end; |
4121 |
> |
end; |
4122 |
> |
finally |
4123 |
> |
Query.free; |
4124 |
> |
FreeNodes; |
4125 |
> |
Database.InternalTransaction.Commit; |
4126 |
> |
FieldDefs.EndUpdate; |
4127 |
> |
FieldDefs.Updated := true; |
4128 |
> |
end; |
4129 |
> |
end; |
4130 |
> |
|
4131 |
> |
procedure TIBCustomDataSet.InternalInitRecord(Buffer: PChar); |
4132 |
> |
begin |
4133 |
> |
CopyRecordBuffer(FModelBuffer, Buffer); |
4134 |
> |
end; |
4135 |
> |
|
4136 |
> |
procedure TIBCustomDataSet.InternalLast; |
4137 |
> |
var |
4138 |
> |
Buffer: PChar; |
4139 |
> |
begin |
4140 |
> |
if (FQSelect.EOF) then |
4141 |
> |
FCurrentRecord := FRecordCount |
4142 |
> |
else begin |
4143 |
> |
Buffer := AllocRecordBuffer; |
4144 |
> |
try |
4145 |
> |
while FQSelect.Next do |
4146 |
> |
begin |
4147 |
> |
FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer); |
4148 |
> |
Inc(FRecordCount); |
4149 |
> |
end; |
4150 |
> |
FCurrentRecord := FRecordCount; |
4151 |
> |
finally |
4152 |
> |
FreeRecordBuffer(Buffer); |
4153 |
> |
end; |
4154 |
> |
end; |
4155 |
> |
end; |
4156 |
> |
|
4157 |
> |
procedure TIBCustomDataSet.InternalSetParamsFromCursor; |
4158 |
> |
var |
4159 |
> |
i: Integer; |
4160 |
> |
cur_param: ISQLParam; |
4161 |
> |
cur_field: TField; |
4162 |
> |
s: TStream; |
4163 |
> |
begin |
4164 |
> |
if FQSelect.SQL.Text = '' then |
4165 |
> |
IBError(ibxeEmptyQuery, [nil]); |
4166 |
> |
if not FInternalPrepared then |
4167 |
> |
InternalPrepare; |
4168 |
> |
if (SQLParams.GetCount > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then |
4169 |
> |
begin |
4170 |
> |
for i := 0 to SQLParams.GetCount - 1 do |
4171 |
> |
begin |
4172 |
> |
cur_field := DataSource.DataSet.FindField(SQLParams[i].Name); |
4173 |
> |
cur_param := SQLParams[i]; |
4174 |
> |
if (cur_field <> nil) then begin |
4175 |
> |
if (cur_field.IsNull) then |
4176 |
> |
cur_param.IsNull := True |
4177 |
> |
else case cur_field.DataType of |
4178 |
> |
ftString: |
4179 |
> |
cur_param.AsString := cur_field.AsString; |
4180 |
> |
ftBoolean: |
4181 |
> |
cur_param.AsBoolean := cur_field.AsBoolean; |
4182 |
> |
ftSmallint, ftWord: |
4183 |
> |
cur_param.AsShort := cur_field.AsInteger; |
4184 |
> |
ftInteger: |
4185 |
> |
cur_param.AsLong := cur_field.AsInteger; |
4186 |
> |
ftLargeInt: |
4187 |
> |
cur_param.AsInt64 := TLargeIntField(cur_field).AsLargeInt; |
4188 |
> |
ftFloat, ftCurrency: |
4189 |
> |
cur_param.AsDouble := cur_field.AsFloat; |
4190 |
> |
ftBCD: |
4191 |
> |
cur_param.AsCurrency := cur_field.AsCurrency; |
4192 |
> |
ftDate: |
4193 |
> |
cur_param.AsDate := cur_field.AsDateTime; |
4194 |
> |
ftTime: |
4195 |
> |
cur_param.AsTime := cur_field.AsDateTime; |
4196 |
> |
ftDateTime: |
4197 |
> |
cur_param.AsDateTime := cur_field.AsDateTime; |
4198 |
> |
ftBlob, ftMemo: |
4199 |
> |
begin |
4200 |
> |
s := nil; |
4201 |
> |
try |
4202 |
> |
s := DataSource.DataSet. |
4203 |
> |
CreateBlobStream(cur_field, bmRead); |
4204 |
> |
cur_param.AsBlob := TIBDSBlobStream(s).FBlobStream.Blob; |
4205 |
> |
finally |
4206 |
> |
s.free; |
4207 |
> |
end; |
4208 |
> |
end; |
4209 |
> |
ftArray: |
4210 |
> |
cur_param.AsArray := TIBArrayField(cur_field).ArrayIntf; |
4211 |
> |
else |
4212 |
> |
IBError(ibxeNotSupported, [nil]); |
4213 |
> |
end; |
4214 |
> |
end; |
4215 |
> |
end; |
4216 |
> |
end; |
4217 |
> |
end; |
4218 |
> |
|
4219 |
> |
procedure TIBCustomDataSet.ReQuery; |
4220 |
> |
begin |
4221 |
> |
FQSelect.Close; |
4222 |
> |
ClearBlobCache; |
4223 |
> |
FCurrentRecord := -1; |
4224 |
> |
FRecordCount := 0; |
4225 |
> |
FDeletedRecords := 0; |
4226 |
> |
FBPos := 0; |
4227 |
> |
FOBPos := 0; |
4228 |
> |
FBEnd := 0; |
4229 |
> |
FOBEnd := 0; |
4230 |
> |
FQSelect.Close; |
4231 |
> |
FQSelect.ExecQuery; |
4232 |
> |
FOpen := FQSelect.Open; |
4233 |
> |
First; |
4234 |
> |
end; |
4235 |
> |
|
4236 |
> |
procedure TIBCustomDataSet.InternalOpen; |
4237 |
> |
|
4238 |
> |
function RecordDataLength(n: Integer): Long; |
4239 |
> |
begin |
4240 |
> |
result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData)); |
4241 |
> |
end; |
4242 |
> |
|
4243 |
> |
begin |
4244 |
> |
FBase.SetCursor; |
4245 |
> |
try |
4246 |
> |
ActivateConnection; |
4247 |
> |
ActivateTransaction; |
4248 |
> |
if FQSelect.SQL.Text = '' then |
4249 |
> |
IBError(ibxeEmptyQuery, [nil]); |
4250 |
> |
if not FInternalPrepared then |
4251 |
> |
InternalPrepare; |
4252 |
> |
if FQSelect.SQLStatementType = SQLSelect then |
4253 |
> |
begin |
4254 |
> |
if DefaultFields then |
4255 |
> |
CreateFields; |
4256 |
> |
FArrayFieldCount := 0; |
4257 |
> |
BindFields(True); |
4258 |
> |
FCurrentRecord := -1; |
4259 |
> |
FQSelect.ExecQuery; |
4260 |
> |
FOpen := FQSelect.Open; |
4261 |
> |
|
4262 |
> |
{ Initialize offsets, buffer sizes, etc... |
4263 |
> |
1. Initially FRecordSize is just the "RecordDataLength". |
4264 |
> |
2. Allocate a "model" buffer and do a dummy fetch |
4265 |
> |
3. After the dummy fetch, FRecordSize will be appropriately |
4266 |
> |
adjusted to reflect the additional "weight" of the field |
4267 |
> |
data. |
4268 |
> |
4. Set up the FCalcFieldsOffset, FBlobCacheOffset, FArrayCacheOffset and FRecordBufferSize. |
4269 |
> |
5. Now, with the BufferSize available, allocate memory for chunks of records |
4270 |
> |
6. Re-allocate the model buffer, accounting for the new |
4271 |
> |
FRecordBufferSize. |
4272 |
> |
7. Finally, calls to AllocRecordBuffer will work!. |
4273 |
> |
} |
4274 |
> |
{Step 1} |
4275 |
> |
FRecordSize := RecordDataLength(FQSelect.FieldCount); |
4276 |
> |
{Step 2, 3} |
4277 |
> |
GetMem(FFieldColumns,sizeof(TFieldColumns) * (FQSelect.FieldCount)); |
4278 |
> |
IBAlloc(FModelBuffer, 0, FRecordSize); |
4279 |
> |
InitModelBuffer(FQSelect, FModelBuffer); |
4280 |
> |
{Step 4} |
4281 |
> |
FCalcFieldsOffset := FRecordSize; |
4282 |
> |
FBlobCacheOffset := FCalcFieldsOffset + CalcFieldsSize; |
4283 |
> |
FArrayCacheOffset := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream))); |
4284 |
> |
FRecordBufferSize := FArrayCacheOffset + (ArrayFieldCount * sizeof(IArray)); |
4285 |
> |
{Step 5} |
4286 |
> |
if UniDirectional then |
4287 |
> |
FBufferChunkSize := FRecordBufferSize * UniCache |
4288 |
> |
else |
4289 |
> |
FBufferChunkSize := FRecordBufferSize * BufferChunks; |
4290 |
> |
IBAlloc(FBufferCache, FBufferChunkSize, FBufferChunkSize); |
4291 |
> |
if FCachedUpdates or (csReading in ComponentState) then |
4292 |
> |
IBAlloc(FOldBufferCache, FBufferChunkSize, FBufferChunkSize); |
4293 |
> |
FBPos := 0; |
4294 |
> |
FOBPos := 0; |
4295 |
> |
FBEnd := 0; |
4296 |
> |
FOBEnd := 0; |
4297 |
> |
FCacheSize := FBufferChunkSize; |
4298 |
> |
FOldCacheSize := FBufferChunkSize; |
4299 |
> |
{Step 6} |
4300 |
> |
IBAlloc(FModelBuffer, RecordDataLength(FQSelect.FieldCount), |
4301 |
> |
FRecordBufferSize); |
4302 |
> |
{Step 7} |
4303 |
> |
FOldBuffer := AllocRecordBuffer; |
4304 |
> |
end |
4305 |
> |
else |
4306 |
> |
FQSelect.ExecQuery; |
4307 |
> |
finally |
4308 |
> |
FBase.RestoreCursor; |
4309 |
> |
end; |
4310 |
> |
end; |
4311 |
> |
|
4312 |
> |
procedure TIBCustomDataSet.InternalPost; |
4313 |
> |
var |
4314 |
> |
Qry: TIBSQL; |
4315 |
> |
Buff: PChar; |
4316 |
> |
bInserting: Boolean; |
4317 |
> |
begin |
4318 |
> |
FBase.SetCursor; |
4319 |
> |
try |
4320 |
> |
Buff := GetActiveBuf; |
4321 |
> |
CheckEditState; |
4322 |
> |
AdjustRecordOnInsert(Buff); |
4323 |
> |
if (State = dsInsert) then |
4324 |
> |
begin |
4325 |
> |
bInserting := True; |
4326 |
> |
Qry := FQInsert; |
4327 |
> |
PRecordData(Buff)^.rdUpdateStatus := usInserted; |
4328 |
> |
PRecordData(Buff)^.rdCachedUpdateStatus := cusInserted; |
4329 |
> |
WriteRecordCache(FRecordCount, Buff); |
4330 |
> |
FCurrentRecord := FRecordCount; |
4331 |
> |
end |
4332 |
> |
else begin |
4333 |
> |
bInserting := False; |
4334 |
> |
Qry := FQModify; |
4335 |
> |
if PRecordData(Buff)^.rdCachedUpdateStatus = cusUnmodified then |
4336 |
> |
begin |
4337 |
> |
PRecordData(Buff)^.rdUpdateStatus := usModified; |
4338 |
> |
PRecordData(Buff)^.rdCachedUpdateStatus := cusModified; |
4339 |
> |
end |
4340 |
> |
else if PRecordData(Buff)^. |
4341 |
> |
rdCachedUpdateStatus = cusUninserted then |
4342 |
> |
begin |
4343 |
> |
PRecordData(Buff)^.rdCachedUpdateStatus := cusInserted; |
4344 |
> |
Dec(FDeletedRecords); |
4345 |
> |
end; |
4346 |
> |
end; |
4347 |
> |
if (not CachedUpdates) then |
4348 |
> |
InternalPostRecord(Qry, Buff) |
4349 |
> |
else begin |
4350 |
> |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff); |
4351 |
> |
FUpdatesPending := True; |
4352 |
> |
end; |
4353 |
> |
if bInserting then |
4354 |
> |
Inc(FRecordCount); |
4355 |
> |
finally |
4356 |
> |
FBase.RestoreCursor; |
4357 |
> |
end; |
4358 |
> |
end; |
4359 |
> |
|
4360 |
> |
procedure TIBCustomDataSet.InternalRefresh; |
4361 |
> |
begin |
4362 |
> |
inherited InternalRefresh; |
4363 |
> |
InternalRefreshRow; |
4364 |
> |
end; |
4365 |
> |
|
4366 |
> |
procedure TIBCustomDataSet.InternalSetToRecord(Buffer: PChar); |
4367 |
> |
begin |
4368 |
> |
InternalGotoBookmark(@(PRecordData(Buffer)^.rdRecordNumber)); |
4369 |
> |
end; |
4370 |
> |
|
4371 |
> |
function TIBCustomDataSet.IsCursorOpen: Boolean; |
4372 |
> |
begin |
4373 |
> |
result := FOpen; |
4374 |
> |
end; |
4375 |
> |
|
4376 |
> |
procedure TIBCustomDataSet.Loaded; |
4377 |
> |
begin |
4378 |
> |
if assigned(FQSelect) then |
4379 |
> |
FBaseSQLSelect.assign(FQSelect.SQL); |
4380 |
> |
inherited Loaded; |
4381 |
> |
end; |
4382 |
> |
|
4383 |
> |
procedure TIBCustomDataSet.Post; |
4384 |
> |
var CancelPost: boolean; |
4385 |
> |
begin |
4386 |
> |
CancelPost := false; |
4387 |
> |
if assigned(FOnValidatePost) then |
4388 |
> |
OnValidatePost(self,CancelPost); |
4389 |
> |
if CancelPost then |
4390 |
> |
Cancel |
4391 |
> |
else |
4392 |
> |
inherited Post; |
4393 |
> |
end; |
4394 |
> |
|
4395 |
> |
function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant; |
4396 |
> |
Options: TLocateOptions): Boolean; |
4397 |
> |
var |
4398 |
> |
CurBookmark: TBookmark; |
4399 |
> |
begin |
4400 |
> |
DisableControls; |
4401 |
> |
try |
4402 |
> |
CurBookmark := Bookmark; |
4403 |
> |
First; |
4404 |
> |
result := InternalLocate(KeyFields, KeyValues, Options); |
4405 |
> |
if not result then |
4406 |
> |
Bookmark := CurBookmark; |
4407 |
> |
finally |
4408 |
> |
EnableControls; |
4409 |
> |
end; |
4410 |
> |
end; |
4411 |
> |
|
4412 |
> |
function TIBCustomDataSet.Lookup(const KeyFields: string; const KeyValues: Variant; |
4413 |
> |
const ResultFields: string): Variant; |
4414 |
> |
var |
4415 |
> |
fl: TList; |
4416 |
> |
CurBookmark: TBookmark; |
4417 |
> |
begin |
4418 |
> |
DisableControls; |
4419 |
> |
fl := TList.Create; |
4420 |
> |
CurBookmark := Bookmark; |
4421 |
> |
try |
4422 |
> |
First; |
4423 |
> |
if InternalLocate(KeyFields, KeyValues, []) then |
4424 |
> |
begin |
4425 |
> |
if (ResultFields <> '') then |
4426 |
> |
result := FieldValues[ResultFields] |
4427 |
> |
else |
4428 |
> |
result := NULL; |
4429 |
> |
end |
4430 |
> |
else |
4431 |
> |
result := Null; |
4432 |
> |
finally |
4433 |
> |
Bookmark := CurBookmark; |
4434 |
> |
fl.Free; |
4435 |
> |
EnableControls; |
4436 |
> |
end; |
4437 |
> |
end; |
4438 |
> |
|
4439 |
> |
procedure TIBCustomDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer); |
4440 |
> |
begin |
4441 |
> |
PRecordData(Buffer)^.rdRecordNumber := PInteger(Data)^; |
4442 |
> |
end; |
4443 |
> |
|
4444 |
> |
procedure TIBCustomDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); |
4445 |
> |
begin |
4446 |
> |
PRecordData(Buffer)^.rdBookmarkFlag := Value; |
4447 |
> |
end; |
4448 |
> |
|
4449 |
> |
procedure TIBCustomDataSet.SetCachedUpdates(Value: Boolean); |
4450 |
> |
begin |
4451 |
> |
if not Value and FCachedUpdates then |
4452 |
> |
CancelUpdates; |
4453 |
> |
if (not (csReading in ComponentState)) and Value then |
4454 |
> |
CheckDatasetClosed; |
4455 |
> |
FCachedUpdates := Value; |
4456 |
> |
end; |
4457 |
> |
|
4458 |
> |
procedure TIBCustomDataSet.SetDataSource(Value: TDataSource); |
4459 |
> |
begin |
4460 |
> |
if IsLinkedTo(Value) then |
4461 |
> |
IBError(ibxeCircularReference, [nil]); |
4462 |
> |
if FDataLink <> nil then |
4463 |
> |
FDataLink.DataSource := Value; |
4464 |
> |
end; |
4465 |
> |
|
4466 |
> |
procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer); |
4467 |
> |
var |
4468 |
> |
Buff, TmpBuff: PChar; |
4469 |
> |
MappedFieldPos: integer; |
4470 |
> |
begin |
4471 |
> |
Buff := GetActiveBuf; |
4472 |
> |
if Field.FieldNo < 0 then |
4473 |
> |
begin |
4474 |
> |
TmpBuff := Buff + FRecordSize + Field.Offset; |
4475 |
> |
Boolean(TmpBuff[0]) := LongBool(Buffer); |
4476 |
> |
if Boolean(TmpBuff[0]) then |
4477 |
> |
Move(Buffer^, TmpBuff[1], Field.DataSize); |
4478 |
> |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff); |
4479 |
> |
end |
4480 |
> |
else begin |
4481 |
> |
CheckEditState; |
4482 |
> |
with PRecordData(Buff)^ do |
4483 |
> |
begin |
4484 |
> |
{ If inserting, Adjust record position } |
4485 |
> |
AdjustRecordOnInsert(Buff); |
4486 |
> |
MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1]; |
4487 |
> |
if (MappedFieldPos > 0) and |
4488 |
> |
(MappedFieldPos <= rdFieldCount) then |
4489 |
> |
with rdFields[MappedFieldPos], FFieldColumns^[MappedFieldPos] do |
4490 |
> |
begin |
4491 |
> |
Field.Validate(Buffer); |
4492 |
> |
if (Buffer = nil) or |
4493 |
> |
(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then |
4494 |
> |
fdIsNull := True |
4495 |
> |
else |
4496 |
> |
begin |
4497 |
> |
Move(Buffer^, Buff[fdDataOfs],fdDataSize); |
4498 |
> |
if (fdDataType = SQL_TEXT) or (fdDataType = SQL_VARYING) then |
4499 |
> |
fdDataLength := StrLen(PChar(Buffer)); |
4500 |
> |
fdIsNull := False; |
4501 |
> |
if rdUpdateStatus = usUnmodified then |
4502 |
> |
begin |
4503 |
> |
if CachedUpdates then |
4504 |
> |
begin |
4505 |
> |
FUpdatesPending := True; |
4506 |
> |
if State = dsInsert then |
4507 |
> |
rdCachedUpdateStatus := cusInserted |
4508 |
> |
else if State = dsEdit then |
4509 |
> |
rdCachedUpdateStatus := cusModified; |
4510 |
> |
end; |
4511 |
> |
|
4512 |
> |
if State = dsInsert then |
4513 |
> |
rdUpdateStatus := usInserted |
4514 |
> |
else |
4515 |
> |
rdUpdateStatus := usModified; |
4516 |
> |
end; |
4517 |
> |
WriteRecordCache(rdRecordNumber, Buff); |
4518 |
> |
SetModified(True); |
4519 |
> |
end; |
4520 |
> |
end; |
4521 |
> |
end; |
4522 |
> |
end; |
4523 |
> |
if not (State in [dsCalcFields, dsFilter, dsNewValue]) then |
4524 |
> |
DataEvent(deFieldChange, PtrInt(Field)); |
4525 |
> |
end; |
4526 |
> |
|
4527 |
> |
procedure TIBCustomDataSet.SetRecNo(Value: Integer); |
4528 |
> |
begin |
4529 |
> |
CheckBrowseMode; |
4530 |
> |
if (Value < 1) then |
4531 |
> |
Value := 1 |
4532 |
> |
else if Value > FRecordCount then |
4533 |
> |
begin |
4534 |
> |
InternalLast; |
4535 |
> |
Value := Min(FRecordCount, Value); |
4536 |
> |
end; |
4537 |
> |
if (Value <> RecNo) then |
4538 |
> |
begin |
4539 |
> |
DoBeforeScroll; |
4540 |
> |
FCurrentRecord := Value - 1; |
4541 |
> |
Resync([]); |
4542 |
> |
DoAfterScroll; |
4543 |
> |
end; |
4544 |
> |
end; |
4545 |
> |
|
4546 |
> |
procedure TIBCustomDataSet.Disconnect; |
4547 |
> |
begin |
4548 |
> |
Close; |
4549 |
> |
InternalUnPrepare; |
4550 |
> |
end; |
4551 |
> |
|
4552 |
> |
procedure TIBCustomDataSet.SetUpdateMode(const Value: TUpdateMode); |
4553 |
> |
begin |
4554 |
> |
if not CanModify then |
4555 |
> |
IBError(ibxeCannotUpdate, [nil]) |
4556 |
> |
else |
4557 |
> |
FUpdateMode := Value; |
4558 |
> |
end; |
4559 |
> |
|
4560 |
> |
|
4561 |
> |
procedure TIBCustomDataSet.SetUpdateObject(Value: TIBDataSetUpdateObject); |
4562 |
> |
begin |
4563 |
> |
if Value <> FUpdateObject then |
4564 |
> |
begin |
4565 |
> |
if Assigned(FUpdateObject) and (FUpdateObject.DataSet = Self) then |
4566 |
> |
FUpdateObject.DataSet := nil; |
4567 |
> |
FUpdateObject := Value; |
4568 |
> |
if Assigned(FUpdateObject) then |
4569 |
> |
begin |
4570 |
> |
if Assigned(FUpdateObject.DataSet) and |
4571 |
> |
(FUpdateObject.DataSet <> Self) then |
4572 |
> |
FUpdateObject.DataSet.UpdateObject := nil; |
4573 |
> |
FUpdateObject.DataSet := Self; |
4574 |
> |
end; |
4575 |
> |
end; |
4576 |
> |
end; |
4577 |
> |
|
4578 |
> |
function TIBCustomDataSet.ConstraintsStored: Boolean; |
4579 |
> |
begin |
4580 |
> |
Result := Constraints.Count > 0; |
4581 |
> |
end; |
4582 |
> |
|
4583 |
> |
procedure TIBCustomDataSet.ClearCalcFields(Buffer: PChar); |
4584 |
> |
begin |
4585 |
> |
FillChar(Buffer[FRecordSize], CalcFieldsSize, 0); |
4586 |
> |
end; |
4587 |
> |
|
4588 |
> |
procedure TIBCustomDataSet.ClearIBLinks; |
4589 |
> |
var i: integer; |
4590 |
> |
begin |
4591 |
> |
for i := FIBLinks.Count - 1 downto 0 do |
4592 |
> |
TIBControlLink(FIBLinks[i]).IBDataSet := nil; |
4593 |
> |
end; |
4594 |
> |
|
4595 |
> |
|
4596 |
> |
procedure TIBCustomDataSet.InternalUnPrepare; |
4597 |
> |
begin |
4598 |
> |
if FInternalPrepared then |
4599 |
> |
begin |
4600 |
> |
CheckDatasetClosed; |
4601 |
> |
if FDidActivate then |
4602 |
> |
DeactivateTransaction; |
4603 |
> |
FieldDefs.Clear; |
4604 |
> |
FieldDefs.Updated := false; |
4605 |
> |
FInternalPrepared := False; |
4606 |
> |
Setlength(FAliasNameList,0); |
4607 |
> |
end; |
4608 |
> |
end; |
4609 |
> |
|
4610 |
> |
procedure TIBCustomDataSet.InternalExecQuery; |
4611 |
> |
var |
4612 |
> |
DidActivate: Boolean; |
4613 |
> |
begin |
4614 |
> |
DidActivate := False; |
4615 |
> |
FBase.SetCursor; |
4616 |
> |
try |
4617 |
> |
ActivateConnection; |
4618 |
> |
DidActivate := ActivateTransaction; |
4619 |
> |
if FQSelect.SQL.Text = '' then |
4620 |
> |
IBError(ibxeEmptyQuery, [nil]); |
4621 |
> |
if not FInternalPrepared then |
4622 |
> |
InternalPrepare; |
4623 |
> |
if FQSelect.SQLStatementType = SQLSelect then |
4624 |
> |
begin |
4625 |
> |
IBError(ibxeIsASelectStatement, [nil]); |
4626 |
> |
end |
4627 |
> |
else |
4628 |
> |
FQSelect.ExecQuery; |
4629 |
> |
finally |
4630 |
> |
if DidActivate then |
4631 |
> |
DeactivateTransaction; |
4632 |
> |
FBase.RestoreCursor; |
4633 |
> |
end; |
4634 |
> |
end; |
4635 |
> |
|
4636 |
> |
function TIBCustomDataSet.GetSelectStmtIntf: IStatement; |
4637 |
> |
begin |
4638 |
> |
Result := FQSelect.Statement; |
4639 |
> |
end; |
4640 |
> |
|
4641 |
> |
function TIBCustomDataSet.GetParser: TSelectSQLParser; |
4642 |
> |
begin |
4643 |
> |
if not assigned(FParser) then |
4644 |
> |
FParser := CreateParser; |
4645 |
> |
Result := FParser |
4646 |
> |
end; |
4647 |
> |
|
4648 |
> |
procedure TIBCustomDataSet.ResetParser; |
4649 |
> |
begin |
4650 |
> |
if assigned(FParser) then |
4651 |
> |
begin |
4652 |
> |
FParser.Free; |
4653 |
> |
FParser := nil; |
4654 |
> |
FQSelect.OnSQLChanged := nil; {Do not react to change} |
4655 |
> |
try |
4656 |
> |
FQSelect.SQL.Assign(FBaseSQLSelect); |
4657 |
> |
finally |
4658 |
> |
FQSelect.OnSQLChanged := SQLChanged; |
4659 |
> |
end; |
4660 |
> |
end; |
4661 |
> |
end; |
4662 |
> |
|
4663 |
> |
function TIBCustomDataSet.HasParser: boolean; |
4664 |
> |
begin |
4665 |
> |
Result := not (csDesigning in ComponentState) and (FParser <> nil) |
4666 |
> |
end; |
4667 |
> |
|
4668 |
> |
procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean); |
4669 |
> |
begin |
4670 |
> |
if FGenerateParamNames = AValue then Exit; |
4671 |
> |
FGenerateParamNames := AValue; |
4672 |
> |
Disconnect |
4673 |
> |
end; |
4674 |
> |
|
4675 |
> |
procedure TIBCustomDataSet.InitRecord(Buffer: PChar); |
4676 |
> |
begin |
4677 |
> |
inherited InitRecord(Buffer); |
4678 |
> |
with PRecordData(Buffer)^ do |
4679 |
> |
begin |
4680 |
> |
rdUpdateStatus := TUpdateStatus(usInserted); |
4681 |
> |
rdBookMarkFlag := bfInserted; |
4682 |
> |
rdRecordNumber := -1; |
4683 |
> |
end; |
4684 |
> |
end; |
4685 |
> |
|
4686 |
> |
procedure TIBCustomDataSet.InternalInsert; |
4687 |
> |
begin |
4688 |
> |
CursorPosChanged; |
4689 |
> |
end; |
4690 |
> |
|
4691 |
> |
{ TIBDataSet IProviderSupport } |
4692 |
> |
|
4693 |
> |
procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean); |
4694 |
> |
begin |
4695 |
> |
if Commit then |
4696 |
> |
Transaction.Commit else |
4697 |
> |
Transaction.Rollback; |
4698 |
> |
end; |
4699 |
> |
|
4700 |
> |
function TIBCustomDataSet.PSExecuteStatement(const ASQL: string; AParams: TParams; |
4701 |
> |
ResultSet: Pointer = nil): Integer; |
4702 |
> |
var |
4703 |
> |
FQuery: TIBQuery; |
4704 |
> |
begin |
4705 |
> |
if Assigned(ResultSet) then |
4706 |
> |
begin |
4707 |
> |
TDataSet(ResultSet^) := TIBQuery.Create(nil); |
4708 |
> |
with TIBQuery(ResultSet^) do |
4709 |
> |
begin |
4710 |
> |
SQL.Text := ASQL; |
4711 |
> |
Params.Assign(AParams); |
4712 |
> |
Open; |
4713 |
> |
Result := RowsAffected; |
4714 |
> |
end; |
4715 |
> |
end |
4716 |
> |
else |
4717 |
> |
begin |
4718 |
> |
FQuery := TIBQuery.Create(nil); |
4719 |
> |
try |
4720 |
> |
FQuery.Database := Database; |
4721 |
> |
FQuery.Transaction := Transaction; |
4722 |
> |
FQuery.GenerateParamNames := True; |
4723 |
> |
FQuery.SQL.Text := ASQL; |
4724 |
> |
FQuery.Params.Assign(AParams); |
4725 |
> |
FQuery.ExecSQL; |
4726 |
> |
Result := FQuery.RowsAffected; |
4727 |
> |
finally |
4728 |
> |
FQuery.Free; |
4729 |
> |
end; |
4730 |
> |
end; |
4731 |
> |
end; |
4732 |
> |
|
4733 |
> |
function TIBCustomDataSet.PSGetQuoteChar: string; |
4734 |
> |
begin |
4735 |
> |
if Database.SQLDialect = 3 then |
4736 |
> |
Result := '"' else |
4737 |
> |
Result := ''; |
4738 |
> |
end; |
4739 |
> |
|
4740 |
> |
function TIBCustomDataSet.PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; |
4741 |
> |
var |
4742 |
> |
PrevErr: Integer; |
4743 |
> |
begin |
4744 |
> |
if Prev <> nil then |
4745 |
> |
PrevErr := Prev.ErrorCode else |
4746 |
> |
PrevErr := 0; |
4747 |
> |
if E is EIBError then |
4748 |
> |
with EIBError(E) do |
4749 |
> |
Result := EUpdateError.Create(E.Message, '', SQLCode, PrevErr, E) else |
4750 |
> |
Result := inherited PSGetUpdateException(E, Prev); |
4751 |
> |
end; |
4752 |
> |
|
4753 |
> |
function TIBCustomDataSet.PSInTransaction: Boolean; |
4754 |
> |
begin |
4755 |
> |
Result := Transaction.InTransaction; |
4756 |
> |
end; |
4757 |
> |
|
4758 |
> |
function TIBCustomDataSet.PSIsSQLBased: Boolean; |
4759 |
> |
begin |
4760 |
> |
Result := True; |
4761 |
> |
end; |
4762 |
> |
|
4763 |
> |
function TIBCustomDataSet.PSIsSQLSupported: Boolean; |
4764 |
> |
begin |
4765 |
> |
Result := True; |
4766 |
> |
end; |
4767 |
> |
|
4768 |
> |
procedure TIBCustomDataSet.PSReset; |
4769 |
> |
begin |
4770 |
> |
inherited PSReset; |
4771 |
> |
if Active then |
4772 |
> |
begin |
4773 |
> |
Close; |
4774 |
> |
Open; |
4775 |
> |
end; |
4776 |
> |
end; |
4777 |
> |
|
4778 |
> |
function TIBCustomDataSet.PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; |
4779 |
> |
var |
4780 |
> |
UpdateAction: TIBUpdateAction; |
4781 |
> |
SQL: string; |
4782 |
> |
Params: TParams; |
4783 |
> |
|
4784 |
> |
procedure AssignParams(DataSet: TDataSet; Params: TParams); |
4785 |
> |
var |
4786 |
> |
I: Integer; |
4787 |
> |
Old: Boolean; |
4788 |
> |
Param: TParam; |
4789 |
> |
PName: string; |
4790 |
> |
Field: TField; |
4791 |
> |
Value: Variant; |
4792 |
> |
begin |
4793 |
> |
for I := 0 to Params.Count - 1 do |
4794 |
> |
begin |
4795 |
> |
Param := Params[I]; |
4796 |
> |
PName := Param.Name; |
4797 |
> |
Old := CompareText(Copy(PName, 1, 4), 'OLD_') = 0; {do not localize} |
4798 |
> |
if Old then System.Delete(PName, 1, 4); |
4799 |
> |
Field := DataSet.FindField(PName); |
4800 |
> |
if not Assigned(Field) then Continue; |
4801 |
> |
if Old then Param.AssignFieldValue(Field, Field.OldValue) else |
4802 |
> |
begin |
4803 |
> |
Value := Field.NewValue; |
4804 |
> |
if VarIsEmpty(Value) then Value := Field.OldValue; |
4805 |
> |
Param.AssignFieldValue(Field, Value); |
4806 |
> |
end; |
4807 |
> |
end; |
4808 |
> |
end; |
4809 |
> |
|
4810 |
> |
begin |
4811 |
> |
Result := False; |
4812 |
> |
if Assigned(OnUpdateRecord) then |
4813 |
> |
begin |
4814 |
> |
UpdateAction := uaFail; |
4815 |
> |
if Assigned(FOnUpdateRecord) then |
4816 |
> |
begin |
4817 |
> |
FOnUpdateRecord(Delta, UpdateKind, UpdateAction); |
4818 |
> |
Result := UpdateAction = uaApplied; |
4819 |
> |
end; |
4820 |
> |
end |
4821 |
> |
else if Assigned(FUpdateObject) then |
4822 |
> |
begin |
4823 |
> |
SQL := FUpdateObject.GetSQL(UpdateKind).Text; |
4824 |
> |
if SQL <> '' then |
4825 |
> |
begin |
4826 |
> |
Params := TParams.Create; |
4827 |
> |
try |
4828 |
> |
Params.ParseSQL(SQL, True); |
4829 |
> |
AssignParams(Delta, Params); |
4830 |
> |
if PSExecuteStatement(SQL, Params) = 0 then |
4831 |
> |
IBError(ibxeNoRecordsAffected, [nil]); |
4832 |
> |
Result := True; |
4833 |
> |
finally |
4834 |
> |
Params.Free; |
4835 |
> |
end; |
4836 |
> |
end; |
4837 |
> |
end; |
4838 |
> |
end; |
4839 |
> |
|
4840 |
> |
procedure TIBCustomDataSet.PSStartTransaction; |
4841 |
> |
begin |
4842 |
> |
ActivateConnection; |
4843 |
> |
Transaction.StartTransaction; |
4844 |
> |
end; |
4845 |
> |
|
4846 |
> |
function TIBCustomDataSet.PsGetTableName: string; |
4847 |
> |
begin |
4848 |
> |
// if not FInternalPrepared then |
4849 |
> |
// InternalPrepare; |
4850 |
> |
{ It is possible for the FQSelectSQL to be unprepared |
4851 |
> |
with FInternalPreprepared being true (see DoBeforeTransactionEnd). |
4852 |
> |
So check the Prepared of the SelectSQL instead } |
4853 |
> |
if not FQSelect.Prepared then |
4854 |
> |
FQSelect.Prepare; |
4855 |
> |
Result := FQSelect.UniqueRelationName; |
4856 |
> |
end; |
4857 |
> |
|
4858 |
> |
procedure TIBDataSet.BatchInput(InputObject: TIBBatchInput); |
4859 |
> |
begin |
4860 |
> |
InternalBatchInput(InputObject); |
4861 |
> |
end; |
4862 |
> |
|
4863 |
> |
procedure TIBDataSet.BatchOutput(OutputObject: TIBBatchOutput); |
4864 |
> |
begin |
4865 |
> |
InternalBatchOutput(OutputObject); |
4866 |
> |
end; |
4867 |
> |
|
4868 |
> |
procedure TIBDataSet.ExecSQL; |
4869 |
> |
begin |
4870 |
> |
InternalExecQuery; |
4871 |
> |
end; |
4872 |
> |
|
4873 |
> |
procedure TIBDataSet.Prepare; |
4874 |
> |
begin |
4875 |
> |
InternalPrepare; |
4876 |
> |
end; |
4877 |
> |
|
4878 |
> |
procedure TIBDataSet.UnPrepare; |
4879 |
> |
begin |
4880 |
> |
InternalUnPrepare; |
4881 |
> |
end; |
4882 |
> |
|
4883 |
> |
function TIBDataSet.GetPrepared: Boolean; |
4884 |
> |
begin |
4885 |
> |
Result := InternalPrepared; |
4886 |
> |
end; |
4887 |
> |
|
4888 |
> |
procedure TIBDataSet.InternalOpen; |
4889 |
> |
begin |
4890 |
> |
ActivateConnection; |
4891 |
> |
ActivateTransaction; |
4892 |
> |
InternalSetParamsFromCursor; |
4893 |
> |
Inherited InternalOpen; |
4894 |
> |
end; |
4895 |
> |
|
4896 |
> |
procedure TIBDataSet.SetFiltered(Value: Boolean); |
4897 |
> |
begin |
4898 |
> |
if(Filtered <> Value) then |
4899 |
> |
begin |
4900 |
> |
inherited SetFiltered(value); |
4901 |
> |
if Active then |
4902 |
> |
begin |
4903 |
> |
Close; |
4904 |
> |
Open; |
4905 |
> |
end; |
4906 |
> |
end |
4907 |
> |
else |
4908 |
> |
inherited SetFiltered(value); |
4909 |
> |
end; |
4910 |
> |
|
4911 |
> |
function TIBCustomDataSet.BookmarkValid(Bookmark: TBookmark): Boolean; |
4912 |
> |
begin |
4913 |
> |
Result := false; |
4914 |
> |
if not Assigned(Bookmark) then |
4915 |
> |
exit; |
4916 |
> |
Result := PInteger(Bookmark)^ < FRecordCount; |
4917 |
> |
end; |
4918 |
> |
|
4919 |
> |
function TIBCustomDataSet.GetFieldData(Field: TField; |
4920 |
> |
Buffer: Pointer): Boolean; |
4921 |
> |
{$IFDEF TBCDFIELD_IS_BCD} |
4922 |
> |
var |
4923 |
> |
lTempCurr : System.Currency; |
4924 |
> |
begin |
4925 |
> |
if (Field.DataType = ftBCD) and (Buffer <> nil) then |
4926 |
> |
begin |
4927 |
> |
Result := InternalGetFieldData(Field, @lTempCurr); |
4928 |
> |
if Result then |
4929 |
> |
CurrToBCD(lTempCurr, TBCD(Buffer^), 32, Field.Size); |
4930 |
> |
end |
4931 |
> |
else |
4932 |
> |
{$ELSE} |
4933 |
> |
begin |
4934 |
> |
{$ENDIF} |
4935 |
> |
Result := InternalGetFieldData(Field, Buffer); |
4936 |
> |
end; |
4937 |
> |
|
4938 |
> |
function TIBCustomDataSet.GetFieldData(Field: TField; Buffer: Pointer; |
4939 |
> |
NativeFormat: Boolean): Boolean; |
4940 |
> |
begin |
4941 |
> |
if (Field.DataType = ftBCD) and not NativeFormat then |
4942 |
> |
Result := InternalGetFieldData(Field, Buffer) |
4943 |
> |
else |
4944 |
> |
Result := inherited GetFieldData(Field, Buffer, NativeFormat); |
4945 |
> |
end; |
4946 |
> |
|
4947 |
> |
procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer); |
4948 |
> |
{$IFDEF TDBDFIELD_IS_BCD} |
4949 |
> |
var |
4950 |
> |
lTempCurr : System.Currency; |
4951 |
> |
begin |
4952 |
> |
if (Field.DataType = ftBCD) and (Buffer <> nil) then |
4953 |
> |
begin |
4954 |
> |
BCDToCurr(TBCD(Buffer^), lTempCurr); |
4955 |
> |
InternalSetFieldData(Field, @lTempCurr); |
4956 |
> |
end |
4957 |
> |
else |
4958 |
> |
{$ELSE} |
4959 |
> |
begin |
4960 |
> |
{$ENDIF} |
4961 |
> |
InternalSetFieldData(Field, Buffer); |
4962 |
> |
end; |
4963 |
> |
|
4964 |
> |
procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer; |
4965 |
> |
NativeFormat: Boolean); |
4966 |
> |
begin |
4967 |
> |
if (not NativeFormat) and (Field.DataType = ftBCD) then |
4968 |
> |
InternalSetfieldData(Field, Buffer) |
4969 |
> |
else |
4970 |
> |
inherited SetFieldData(Field, buffer, NativeFormat); |
4971 |
> |
end; |
4972 |
> |
|
4973 |
> |
{ TIBDataSetUpdateObject } |
4974 |
> |
|
4975 |
> |
constructor TIBDataSetUpdateObject.Create(AOwner: TComponent); |
4976 |
> |
begin |
4977 |
> |
inherited Create(AOwner); |
4978 |
> |
FRefreshSQL := TStringList.Create; |
4979 |
> |
end; |
4980 |
> |
|
4981 |
> |
destructor TIBDataSetUpdateObject.Destroy; |
4982 |
> |
begin |
4983 |
> |
FRefreshSQL.Free; |
4984 |
> |
inherited Destroy; |
4985 |
> |
end; |
4986 |
> |
|
4987 |
> |
procedure TIBDataSetUpdateObject.SetRefreshSQL(value: TStrings); |
4988 |
> |
begin |
4989 |
> |
FRefreshSQL.Assign(Value); |
4990 |
> |
end; |
4991 |
> |
|
4992 |
> |
procedure TIBDataSetUpdateObject.InternalSetParams(Params: ISQLParams; |
4993 |
> |
buff: PChar); |
4994 |
> |
begin |
4995 |
> |
if not Assigned(DataSet) then Exit; |
4996 |
> |
DataSet.SetInternalSQLParams(Params, buff); |
4997 |
> |
end; |
4998 |
> |
|
4999 |
> |
procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar); |
5000 |
> |
begin |
5001 |
> |
InternalSetParams(Query.Params,buff); |
5002 |
> |
end; |
5003 |
> |
|
5004 |
> |
procedure TIBDataSetUpdateObject.UpdateRecordFromQuery(QryResults: IResults; |
5005 |
> |
Buffer: PChar); |
5006 |
> |
begin |
5007 |
> |
if not Assigned(DataSet) then Exit; |
5008 |
> |
DataSet.UpdateRecordFromQuery(QryResults, Buffer); |
5009 |
> |
end; |
5010 |
> |
|
5011 |
> |
function TIBDSBlobStream.GetSize: Int64; |
5012 |
> |
begin |
5013 |
> |
Result := FBlobStream.BlobSize; |
5014 |
> |
end; |
5015 |
> |
|
5016 |
> |
{ TIBDSBlobStream } |
5017 |
> |
constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream; |
5018 |
> |
Mode: TBlobStreamMode); |
5019 |
> |
begin |
5020 |
> |
FField := AField; |
5021 |
> |
FBlobStream := ABlobStream; |
5022 |
> |
FBlobStream.Seek(0, soFromBeginning); |
5023 |
> |
if (Mode = bmWrite) then |
5024 |
> |
begin |
5025 |
> |
FBlobStream.Truncate; |
5026 |
> |
TIBCustomDataSet(FField.DataSet).RecordModified(True); |
5027 |
> |
TBlobField(FField).Modified := true; |
5028 |
> |
FHasWritten := true; |
5029 |
> |
end; |
5030 |
> |
end; |
5031 |
> |
|
5032 |
> |
destructor TIBDSBlobStream.Destroy; |
5033 |
> |
begin |
5034 |
> |
if FHasWritten then |
5035 |
> |
TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField)); |
5036 |
> |
inherited Destroy; |
5037 |
> |
end; |
5038 |
> |
|
5039 |
> |
function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint; |
5040 |
> |
begin |
5041 |
> |
result := FBlobStream.Read(Buffer, Count); |
5042 |
> |
end; |
5043 |
> |
|
5044 |
> |
function TIBDSBlobStream.Seek(Offset: Longint; Origin: Word): Longint; |
5045 |
> |
begin |
5046 |
> |
result := FBlobStream.Seek(Offset, Origin); |
5047 |
> |
end; |
5048 |
> |
|
5049 |
> |
procedure TIBDSBlobStream.SetSize(NewSize: Longint); |
5050 |
> |
begin |
5051 |
> |
FBlobStream.SetSize(NewSize); |
5052 |
> |
end; |
5053 |
> |
|
5054 |
> |
function TIBDSBlobStream.Write(const Buffer; Count: Longint): Longint; |
5055 |
> |
begin |
5056 |
> |
if not (FField.DataSet.State in [dsEdit, dsInsert]) then |
5057 |
> |
IBError(ibxeNotEditing, [nil]); |
5058 |
> |
TIBCustomDataSet(FField.DataSet).RecordModified(True); |
5059 |
> |
TBlobField(FField).Modified := true; |
5060 |
> |
result := FBlobStream.Write(Buffer, Count); |
5061 |
> |
FHasWritten := true; |
5062 |
> |
{ TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField)); |
5063 |
> |
Removed as this caused a seek to beginning of the blob stream thus corrupting |
5064 |
> |
the blob stream. Moved to the destructor i.e. called after blob written} |
5065 |
> |
end; |
5066 |
> |
|
5067 |
> |
{ TIBGenerator } |
5068 |
> |
|
5069 |
> |
procedure TIBGenerator.SetIncrement(const AValue: integer); |
5070 |
> |
begin |
5071 |
> |
if FIncrement = AValue then Exit; |
5072 |
> |
if AValue < 0 then |
5073 |
> |
IBError(ibxeNegativeGenerator,[]); |
5074 |
> |
FIncrement := AValue; |
5075 |
> |
SetQuerySQL; |
5076 |
> |
end; |
5077 |
> |
|
5078 |
> |
procedure TIBGenerator.SetTransaction(AValue: TIBTransaction); |
5079 |
> |
begin |
5080 |
> |
FQuery.Transaction := AValue; |
5081 |
> |
end; |
5082 |
> |
|
5083 |
> |
procedure TIBGenerator.SetQuerySQL; |
5084 |
> |
begin |
5085 |
> |
FQuery.SQL.Text := Format('Select Gen_ID(%s,%d) From RDB$Database',[FGeneratorName,Increment]); |
5086 |
> |
end; |
5087 |
> |
|
5088 |
> |
function TIBGenerator.GetDatabase: TIBDatabase; |
5089 |
> |
begin |
5090 |
> |
Result := FQuery.Database; |
5091 |
> |
end; |
5092 |
> |
|
5093 |
> |
function TIBGenerator.GetTransaction: TIBTransaction; |
5094 |
> |
begin |
5095 |
> |
Result := FQuery.Transaction; |
5096 |
> |
end; |
5097 |
> |
|
5098 |
> |
procedure TIBGenerator.SetDatabase(AValue: TIBDatabase); |
5099 |
> |
begin |
5100 |
> |
FQuery.Database := AValue; |
5101 |
> |
end; |
5102 |
> |
|
5103 |
> |
procedure TIBGenerator.SetGeneratorName(AValue: string); |
5104 |
> |
begin |
5105 |
> |
if FGeneratorName = AValue then Exit; |
5106 |
> |
FGeneratorName := AValue; |
5107 |
> |
SetQuerySQL; |
5108 |
> |
end; |
5109 |
> |
|
5110 |
> |
function TIBGenerator.GetNextValue: integer; |
5111 |
> |
begin |
5112 |
> |
with FQuery do |
5113 |
> |
begin |
5114 |
> |
Transaction.Active := true; |
5115 |
> |
ExecQuery; |
5116 |
> |
try |
5117 |
> |
Result := Fields[0].AsInteger |
5118 |
> |
finally |
5119 |
> |
Close |
5120 |
> |
end; |
5121 |
> |
end; |
5122 |
> |
end; |
5123 |
> |
|
5124 |
> |
constructor TIBGenerator.Create(Owner: TIBCustomDataSet); |
5125 |
> |
begin |
5126 |
> |
FOwner := Owner; |
5127 |
> |
FIncrement := 1; |
5128 |
> |
FQuery := TIBSQL.Create(nil); |
5129 |
> |
end; |
5130 |
> |
|
5131 |
> |
destructor TIBGenerator.Destroy; |
5132 |
> |
begin |
5133 |
> |
if assigned(FQuery) then FQuery.Free; |
5134 |
> |
inherited Destroy; |
5135 |
> |
end; |
5136 |
> |
|
5137 |
> |
|
5138 |
> |
procedure TIBGenerator.Apply; |
5139 |
> |
begin |
5140 |
> |
if assigned(Database) and assigned(Transaction) and |
5141 |
> |
(FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then |
5142 |
> |
Owner.FieldByName(FFieldName).AsInteger := GetNextValue; |
5143 |
> |
end; |
5144 |
> |
|
5145 |
> |
|
5146 |
> |
end. |