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