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 } |
30 |
> |
{ Associates Ltd 2011 - 2015 } |
31 |
|
{ } |
32 |
|
{************************************************************************} |
33 |
|
|
34 |
|
unit IBCustomDataSet; |
35 |
|
|
36 |
+ |
{$R-} |
37 |
+ |
|
38 |
|
{$Mode Delphi} |
39 |
|
|
40 |
|
{$IFDEF DELPHI} |
49 |
|
{$ELSE} |
50 |
|
unix, |
51 |
|
{$ENDIF} |
52 |
< |
SysUtils, Classes, Forms, Controls, IBDatabase, |
53 |
< |
IBExternals, IB, IBHeader, IBSQL, Db, |
52 |
< |
IBUtils, IBBlob; |
52 |
> |
SysUtils, Classes, IBDatabase, IBExternals, IB, IBHeader, IBSQL, Db, |
53 |
> |
IBUtils, IBBlob, IBSQLParser; |
54 |
|
|
55 |
|
const |
56 |
|
BufferCacheSize = 1000; { Allocate cache in this many record chunks} |
119 |
|
{ TIBStringField allows us to have strings longer than 8196 } |
120 |
|
|
121 |
|
TIBStringField = class(TStringField) |
122 |
+ |
private |
123 |
+ |
FInitialised: boolean; |
124 |
+ |
protected |
125 |
+ |
procedure SetSize(AValue: Integer); override; |
126 |
|
public |
127 |
|
constructor create(AOwner: TComponent); override; |
128 |
|
class procedure CheckTypeSize(Value: Integer); override; |
190 |
|
property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent; |
191 |
|
end; |
192 |
|
|
193 |
+ |
{TIBControlLink - Allows IB Aware controls to react to dataset state changes} |
194 |
+ |
|
195 |
+ |
TIBControlLink = class |
196 |
+ |
private |
197 |
+ |
FTIBDataSet: TIBCustomDataSet; |
198 |
+ |
procedure SetIBDataSet(AValue: TIBCustomDataSet); |
199 |
+ |
protected |
200 |
+ |
procedure UpdateSQL(Sender: TObject); virtual; |
201 |
+ |
procedure UpdateParams(Sender: TObject); virtual; |
202 |
+ |
public |
203 |
+ |
destructor Destroy; override; |
204 |
+ |
property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet; |
205 |
+ |
end; |
206 |
+ |
|
207 |
+ |
TIBAutoCommit = (acDisabled, acCommitRetaining); |
208 |
+ |
|
209 |
|
{ TIBCustomDataSet } |
210 |
|
TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied); |
211 |
|
|
212 |
|
TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError; |
213 |
< |
UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction) |
213 |
> |
UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction) |
214 |
|
of object; |
215 |
|
TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind; |
216 |
|
var UpdateAction: TIBUpdateAction) of object; |
217 |
|
|
218 |
|
TIBUpdateRecordTypes = set of TCachedUpdateStatus; |
219 |
|
|
220 |
+ |
TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges); |
221 |
+ |
|
222 |
+ |
TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object; |
223 |
+ |
|
224 |
|
TIBCustomDataSet = class(TDataset) |
225 |
|
private |
226 |
+ |
FAutoCommit: TIBAutoCommit; |
227 |
+ |
FGenerateParamNames: Boolean; |
228 |
|
FGeneratorField: TIBGenerator; |
229 |
|
FNeedsRefresh: Boolean; |
230 |
|
FForcedRefresh: Boolean; |
250 |
|
FDeletedRecords: Long; |
251 |
|
FModelBuffer, |
252 |
|
FOldBuffer: PChar; |
253 |
+ |
FOnValidatePost: TOnValidatePost; |
254 |
|
FOpen: Boolean; |
255 |
|
FInternalPrepared: Boolean; |
256 |
|
FQDelete, |
261 |
|
FRecordBufferSize: Integer; |
262 |
|
FRecordCount: Integer; |
263 |
|
FRecordSize: Integer; |
264 |
+ |
FDataSetCloseAction: TDataSetCloseAction; |
265 |
|
FUniDirectional: Boolean; |
266 |
|
FUpdateMode: TUpdateMode; |
267 |
|
FUpdateObject: TIBDataSetUpdateObject; |
279 |
|
FBeforeTransactionEnd, |
280 |
|
FAfterTransactionEnd, |
281 |
|
FTransactionFree: TNotifyEvent; |
282 |
< |
|
282 |
> |
FAliasNameMap: array of string; |
283 |
> |
FAliasNameList: array of string; |
284 |
> |
FBaseSQLSelect: TStrings; |
285 |
> |
FParser: TSelectSQLParser; |
286 |
> |
FCloseAction: TTransactionAction; |
287 |
> |
FInTransactionEnd: boolean; |
288 |
> |
FIBLinks: TList; |
289 |
|
function GetSelectStmtHandle: TISC_STMT_HANDLE; |
290 |
|
procedure SetUpdateMode(const Value: TUpdateMode); |
291 |
|
procedure SetUpdateObject(Value: TIBDataSetUpdateObject); |
298 |
|
function CanRefresh: Boolean; |
299 |
|
procedure CheckEditState; |
300 |
|
procedure ClearBlobCache; |
301 |
+ |
procedure ClearIBLinks; |
302 |
|
procedure CopyRecordBuffer(Source, Dest: Pointer); |
303 |
|
procedure DoBeforeDatabaseDisconnect(Sender: TObject); |
304 |
|
procedure DoAfterDatabaseDisconnect(Sender: TObject); |
305 |
|
procedure DoDatabaseFree(Sender: TObject); |
306 |
< |
procedure DoBeforeTransactionEnd(Sender: TObject); |
306 |
> |
procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction); |
307 |
|
procedure DoAfterTransactionEnd(Sender: TObject); |
308 |
|
procedure DoTransactionFree(Sender: TObject); |
309 |
|
procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer; |
319 |
|
function GetModifySQL: TStrings; |
320 |
|
function GetTransaction: TIBTransaction; |
321 |
|
function GetTRHandle: PISC_TR_HANDLE; |
322 |
+ |
function GetParser: TSelectSQLParser; |
323 |
|
procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual; |
324 |
|
function InternalLocate(const KeyFields: string; const KeyValues: Variant; |
325 |
|
Options: TLocateOptions): Boolean; virtual; |
326 |
|
procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual; |
327 |
|
procedure InternalRevertRecord(RecordNumber: Integer); virtual; |
328 |
|
function IsVisible(Buffer: PChar): Boolean; |
329 |
+ |
procedure RegisterIBLink(Sender: TIBControlLink); |
330 |
+ |
procedure UnRegisterIBLink(Sender: TIBControlLink); |
331 |
|
procedure SaveOldBuffer(Buffer: PChar); |
332 |
|
procedure SetBufferChunks(Value: Integer); |
333 |
|
procedure SetDatabase(Value: TIBDatabase); |
360 |
|
procedure DeactivateTransaction; |
361 |
|
procedure CheckDatasetClosed; |
362 |
|
procedure CheckDatasetOpen; |
363 |
+ |
function CreateParser: TSelectSQLParser; virtual; |
364 |
+ |
procedure FieldDefsFromQuery(SourceQuery: TIBSQL); |
365 |
|
function GetActiveBuf: PChar; |
366 |
|
procedure InternalBatchInput(InputObject: TIBBatchInput); virtual; |
367 |
|
procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual; |
394 |
|
procedure ClearCalcFields(Buffer: PChar); override; |
395 |
|
function AllocRecordBuffer: PChar; override; |
396 |
|
procedure DoBeforeDelete; override; |
397 |
+ |
procedure DoAfterDelete; override; |
398 |
|
procedure DoBeforeEdit; override; |
399 |
+ |
procedure DoAfterEdit; override; |
400 |
|
procedure DoBeforeInsert; override; |
401 |
|
procedure DoAfterInsert; override; |
402 |
+ |
procedure DoBeforeClose; override; |
403 |
+ |
procedure DoBeforeOpen; override; |
404 |
|
procedure DoBeforePost; override; |
405 |
+ |
procedure DoAfterPost; override; |
406 |
|
procedure FreeRecordBuffer(var Buffer: PChar); override; |
407 |
|
procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override; |
408 |
|
function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override; |
409 |
|
function GetCanModify: Boolean; override; |
410 |
|
function GetDataSource: TDataSource; override; |
411 |
+ |
function GetDBAliasName(FieldNo: integer): string; |
412 |
+ |
function GetFieldDefFromAlias(aliasName: string): TFieldDef; |
413 |
|
function GetFieldClass(FieldType: TFieldType): TFieldClass; override; |
414 |
|
function GetRecNo: Integer; override; |
415 |
|
function GetRecord(Buffer: PChar; GetMode: TGetMode; |
416 |
|
DoCheck: Boolean): TGetResult; override; |
417 |
|
function GetRecordCount: Integer; override; |
418 |
|
function GetRecordSize: Word; override; |
419 |
+ |
procedure InternalAutoCommit; |
420 |
|
procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override; |
421 |
|
procedure InternalCancel; override; |
422 |
|
procedure InternalClose; override; |
434 |
|
procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual; |
435 |
|
procedure InternalSetToRecord(Buffer: PChar); override; |
436 |
|
function IsCursorOpen: Boolean; override; |
437 |
+ |
procedure Loaded; override; |
438 |
|
procedure ReQuery; |
439 |
|
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override; |
440 |
|
procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override; |
441 |
|
procedure SetCachedUpdates(Value: Boolean); |
442 |
|
procedure SetDataSource(Value: TDataSource); |
443 |
+ |
procedure SetGenerateParamNames(AValue: Boolean); virtual; |
444 |
|
procedure SetFieldData(Field : TField; Buffer : Pointer); override; |
445 |
|
procedure SetFieldData(Field : TField; Buffer : Pointer; |
446 |
|
NativeFormat : Boolean); overload; override; |
448 |
|
|
449 |
|
protected |
450 |
|
{Likely to be made public by descendant classes} |
451 |
+ |
property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled; |
452 |
|
property SQLParams: TIBXSQLDA read GetSQLParams; |
453 |
|
property Params: TIBXSQLDA read GetSQLParams; |
454 |
|
property InternalPrepared: Boolean read FInternalPrepared; |
472 |
|
property ModifySQL: TStrings read GetModifySQL write SetModifySQL; |
473 |
|
property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll; |
474 |
|
property ParamCheck: Boolean read FParamCheck write FParamCheck default True; |
475 |
+ |
property Parser: TSelectSQLParser read GetParser; |
476 |
+ |
property BaseSQLSelect: TStrings read FBaseSQLSelect; |
477 |
|
|
478 |
|
property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect |
479 |
|
write FBeforeDatabaseDisconnect; |
487 |
|
write FAfterTransactionEnd; |
488 |
|
property TransactionFree: TNotifyEvent read FTransactionFree |
489 |
|
write FTransactionFree; |
490 |
+ |
property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost; |
491 |
|
|
492 |
|
public |
493 |
|
constructor Create(AOwner: TComponent); override; |
495 |
|
procedure ApplyUpdates; |
496 |
|
function CachedUpdateStatus: TCachedUpdateStatus; |
497 |
|
procedure CancelUpdates; |
498 |
+ |
function GetFieldPosition(AliasName: string): integer; |
499 |
|
procedure FetchAll; |
500 |
|
function LocateNext(const KeyFields: string; const KeyValues: Variant; |
501 |
|
Options: TLocateOptions): Boolean; |
502 |
|
procedure RecordModified(Value: Boolean); |
503 |
|
procedure RevertRecord; |
504 |
|
procedure Undelete; |
505 |
+ |
procedure ResetParser; |
506 |
+ |
function HasParser: boolean; |
507 |
|
|
508 |
|
{ TDataSet support methods } |
509 |
|
function BookmarkValid(Bookmark: TBookmark): Boolean; override; |
514 |
|
function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*) |
515 |
|
function GetFieldData(Field : TField; Buffer : Pointer; |
516 |
|
NativeFormat : Boolean) : Boolean; overload; override; |
517 |
+ |
property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames; |
518 |
|
function Locate(const KeyFields: string; const KeyValues: Variant; |
519 |
|
Options: TLocateOptions): Boolean; override; |
520 |
|
function Lookup(const KeyFields: string; const KeyValues: Variant; |
521 |
|
const ResultFields: string): Variant; override; |
522 |
|
function UpdateStatus: TUpdateStatus; override; |
523 |
|
function IsSequenced: Boolean; override; |
524 |
+ |
procedure Post; override; |
525 |
|
function ParamByName(ParamName: String): TIBXSQLVAR; |
526 |
|
property DBHandle: PISC_DB_HANDLE read GetDBHandle; |
527 |
|
property TRHandle: PISC_TR_HANDLE read GetTRHandle; |
529 |
|
property UpdatesPending: Boolean read FUpdatesPending; |
530 |
|
property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes |
531 |
|
write SetUpdateRecordTypes; |
532 |
+ |
property DataSetCloseAction: TDataSetCloseAction |
533 |
+ |
read FDataSetCloseAction write FDataSetCloseAction; |
534 |
|
|
535 |
|
published |
536 |
|
property Database: TIBDatabase read GetDatabase write SetDatabase; |
569 |
|
write FOnUpdateRecord; |
570 |
|
end; |
571 |
|
|
572 |
< |
TIBDataSet = class(TIBCustomDataSet) |
572 |
> |
TIBParserDataSet = class(TIBCustomDataSet) |
573 |
> |
public |
574 |
> |
property Parser; |
575 |
> |
end; |
576 |
> |
|
577 |
> |
TIBDataSet = class(TIBParserDataSet) |
578 |
|
private |
579 |
|
function GetPrepared: Boolean; |
580 |
|
|
599 |
|
property QModify; |
600 |
|
property StatementType; |
601 |
|
property SelectStmtHandle; |
602 |
+ |
property BaseSQLSelect; |
603 |
|
|
604 |
|
published |
605 |
|
{ TIBCustomDataSet } |
606 |
+ |
property AutoCommit; |
607 |
|
property BufferChunks; |
608 |
|
property CachedUpdates; |
609 |
|
property DeleteSQL; |
612 |
|
property SelectSQL; |
613 |
|
property ModifySQL; |
614 |
|
property GeneratorField; |
615 |
+ |
property GenerateParamNames; |
616 |
|
property ParamCheck; |
617 |
|
property UniDirectional; |
618 |
|
property Filtered; |
619 |
+ |
property DataSetCloseAction; |
620 |
|
|
621 |
|
property BeforeDatabaseDisconnect; |
622 |
|
property AfterDatabaseDisconnect; |
652 |
|
property OnFilterRecord; |
653 |
|
property OnNewRecord; |
654 |
|
property OnPostError; |
655 |
+ |
property OnValidatePost; |
656 |
|
end; |
657 |
|
|
658 |
|
{ TIBDSBlobStream } |
659 |
|
TIBDSBlobStream = class(TStream) |
660 |
+ |
private |
661 |
+ |
FHasWritten: boolean; |
662 |
|
protected |
663 |
|
FField: TField; |
664 |
|
FBlobStream: TIBBlobStream; |
665 |
|
public |
666 |
|
constructor Create(AField: TField; ABlobStream: TIBBlobStream; |
667 |
|
Mode: TBlobStreamMode); |
668 |
+ |
destructor Destroy; override; |
669 |
|
function Read(var Buffer; Count: Longint): Longint; override; |
670 |
|
function Seek(Offset: Longint; Origin: Word): Longint; override; |
671 |
|
procedure SetSize(NewSize: Longint); override; |
753 |
|
NextRelation : TRelationNode; |
754 |
|
end; |
755 |
|
|
756 |
+ |
{ TIBControlLink } |
757 |
+ |
|
758 |
+ |
destructor TIBControlLink.Destroy; |
759 |
+ |
begin |
760 |
+ |
IBDataSet := nil; |
761 |
+ |
inherited Destroy; |
762 |
+ |
end; |
763 |
+ |
|
764 |
+ |
procedure TIBControlLink.UpdateParams(Sender: TObject); |
765 |
+ |
begin |
766 |
+ |
|
767 |
+ |
end; |
768 |
+ |
|
769 |
+ |
procedure TIBControlLink.UpdateSQL(Sender: TObject); |
770 |
+ |
begin |
771 |
+ |
|
772 |
+ |
end; |
773 |
+ |
|
774 |
+ |
procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet); |
775 |
+ |
begin |
776 |
+ |
if FTIBDataSet = AValue then Exit; |
777 |
+ |
if IBDataSet <> nil then |
778 |
+ |
IBDataSet.UnRegisterIBLink(self); |
779 |
+ |
FTIBDataSet := AValue; |
780 |
+ |
if IBDataSet <> nil then |
781 |
+ |
IBDataSet.RegisterIBLink(self); |
782 |
+ |
end; |
783 |
+ |
|
784 |
|
|
785 |
|
{ TIBStringField} |
786 |
|
|
787 |
< |
constructor TIBStringField.Create(AOwner: TComponent); |
787 |
> |
constructor TIBStringField.create(AOwner: TComponent); |
788 |
|
begin |
789 |
|
inherited Create(AOwner); |
790 |
|
end; |
841 |
|
end; |
842 |
|
end; |
843 |
|
|
844 |
+ |
procedure TIBStringField.SetSize(AValue: Integer); |
845 |
+ |
var FieldSize: integer; |
846 |
+ |
begin |
847 |
+ |
if csLoading in ComponentState then |
848 |
+ |
FInitialised := true; |
849 |
+ |
if FInitialised then |
850 |
+ |
inherited SetSize(AValue) |
851 |
+ |
else |
852 |
+ |
begin |
853 |
+ |
{IBCustomDataSet encodes the CharWidth size in the size} |
854 |
+ |
FieldSize := AValue div 4; |
855 |
+ |
inherited SetSize(FieldSize); |
856 |
+ |
DisplayWidth := FieldSize div ((AValue mod 4) + 1); |
857 |
+ |
FInitialised := true; |
858 |
+ |
end; |
859 |
+ |
end; |
860 |
+ |
|
861 |
|
{ TIBBCDField } |
862 |
|
|
863 |
|
constructor TIBBCDField.Create(AOwner: TComponent); |
955 |
|
CheckIBLoaded; |
956 |
|
FIBLoaded := True; |
957 |
|
FBase := TIBBase.Create(Self); |
958 |
+ |
FIBLinks := TList.Create; |
959 |
|
FCurrentRecord := -1; |
960 |
|
FDeletedRecords := 0; |
961 |
|
FUniDirectional := False; |
980 |
|
FQModify.GoToFirstRecordOnExecute := False; |
981 |
|
FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted]; |
982 |
|
FParamCheck := True; |
983 |
+ |
FGenerateParamNames := False; |
984 |
|
FForcedRefresh := False; |
985 |
+ |
FAutoCommit:= acDisabled; |
986 |
+ |
FDataSetCloseAction := dcDiscardChanges; |
987 |
|
{Bookmark Size is Integer for IBX} |
988 |
|
BookmarkSize := SizeOf(Integer); |
989 |
|
FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect; |
997 |
|
else |
998 |
|
if AOwner is TIBTransaction then |
999 |
|
Transaction := TIBTransaction(AOwner); |
1000 |
+ |
FBaseSQLSelect := TStringList.Create; |
1001 |
|
end; |
1002 |
|
|
1003 |
|
destructor TIBCustomDataSet.Destroy; |
1009 |
|
FDataLink.Free; |
1010 |
|
FBase.Free; |
1011 |
|
ClearBlobCache; |
1012 |
+ |
ClearIBLinks; |
1013 |
+ |
FIBLinks.Free; |
1014 |
|
FBlobStreamList.Free; |
1015 |
|
FreeMem(FBufferCache); |
1016 |
|
FBufferCache := nil; |
1020 |
|
FOldCacheSize := 0; |
1021 |
|
FMappedFieldPosition := nil; |
1022 |
|
end; |
1023 |
+ |
if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free; |
1024 |
+ |
if assigned(FParser) then FParser.Free; |
1025 |
|
inherited Destroy; |
1026 |
|
end; |
1027 |
|
|
1063 |
|
|
1064 |
|
procedure TIBCustomDataSet.ApplyUpdates; |
1065 |
|
var |
1066 |
< |
{$IF FPC_FULLVERSION > 20602 } |
1066 |
> |
{$IF FPC_FULLVERSION >= 20700 } |
1067 |
|
CurBookmark: TBookmark; |
1068 |
|
{$ELSE} |
1069 |
|
CurBookmark: string; |
1265 |
|
end; |
1266 |
|
end; |
1267 |
|
|
1268 |
+ |
function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer; |
1269 |
+ |
var i: integer; |
1270 |
+ |
Prepared: boolean; |
1271 |
+ |
begin |
1272 |
+ |
Result := 0; |
1273 |
+ |
Prepared := FInternalPrepared; |
1274 |
+ |
if not Prepared then |
1275 |
+ |
InternalPrepare; |
1276 |
+ |
try |
1277 |
+ |
for i := 0 to Length(FAliasNameList) - 1 do |
1278 |
+ |
if FAliasNameList[i] = AliasName then |
1279 |
+ |
begin |
1280 |
+ |
Result := i + 1; |
1281 |
+ |
Exit |
1282 |
+ |
end; |
1283 |
+ |
finally |
1284 |
+ |
if not Prepared then |
1285 |
+ |
InternalUnPrepare; |
1286 |
+ |
end; |
1287 |
+ |
end; |
1288 |
+ |
|
1289 |
|
procedure TIBCustomDataSet.ActivateConnection; |
1290 |
|
begin |
1291 |
|
if not Assigned(Database) then |
1346 |
|
IBError(ibxeDatasetClosed, [nil]); |
1347 |
|
end; |
1348 |
|
|
1349 |
+ |
function TIBCustomDataSet.CreateParser: TSelectSQLParser; |
1350 |
+ |
begin |
1351 |
+ |
Result := TSelectSQLParser.Create(self,FBaseSQLSelect); |
1352 |
+ |
Result.OnSQLChanging := SQLChanging |
1353 |
+ |
end; |
1354 |
+ |
|
1355 |
|
procedure TIBCustomDataSet.CheckNotUniDirectional; |
1356 |
|
begin |
1357 |
|
if UniDirectional then |
1455 |
|
FDatabaseFree(Sender); |
1456 |
|
end; |
1457 |
|
|
1458 |
< |
procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject); |
1458 |
> |
procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject; |
1459 |
> |
Action: TTransactionAction); |
1460 |
|
begin |
1461 |
< |
if Active then |
1462 |
< |
Active := False; |
1461 |
> |
FCloseAction := Action; |
1462 |
> |
FInTransactionEnd := true; |
1463 |
> |
try |
1464 |
> |
if Active then |
1465 |
> |
Active := False; |
1466 |
> |
finally |
1467 |
> |
FInTransactionEnd := false; |
1468 |
> |
end; |
1469 |
|
if FQSelect <> nil then |
1470 |
|
FQSelect.FreeHandle; |
1471 |
|
if FQDelete <> nil then |
1503 |
|
LocalData: Pointer; |
1504 |
|
LocalDate, LocalDouble: Double; |
1505 |
|
LocalInt: Integer; |
1506 |
+ |
LocalBool: wordBool; |
1507 |
|
LocalInt64: Int64; |
1508 |
|
LocalCurrency: Currency; |
1509 |
|
FieldsLoaded: Integer; |
1648 |
|
end; |
1649 |
|
end; |
1650 |
|
end; |
1651 |
+ |
SQL_BOOLEAN: |
1652 |
+ |
begin |
1653 |
+ |
LocalBool:= false; |
1654 |
+ |
rdFields[j].fdDataSize := SizeOf(wordBool); |
1655 |
+ |
if RecordNumber >= 0 then |
1656 |
+ |
LocalBool := Qry.Current[i].AsBoolean; |
1657 |
+ |
LocalData := PChar(@LocalBool); |
1658 |
+ |
end; |
1659 |
|
else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD } |
1660 |
|
begin |
1661 |
|
rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen; |
1798 |
|
const KeyValues: Variant; Options: TLocateOptions): Boolean; |
1799 |
|
var |
1800 |
|
keyFieldList: TList; |
1801 |
< |
{$IF FPC_FULLVERSION > 20602 } |
1801 |
> |
{$IF FPC_FULLVERSION >= 20700 } |
1802 |
|
CurBookmark: TBookmark; |
1803 |
|
{$ELSE} |
1804 |
|
CurBookmark: string; |
1927 |
|
procedure TIBCustomDataSet.InternalRefreshRow; |
1928 |
|
var |
1929 |
|
Buff: PChar; |
1758 |
– |
SetCursor: Boolean; |
1930 |
|
ofs: DWORD; |
1931 |
|
Qry: TIBSQL; |
1932 |
|
begin |
1933 |
< |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
1763 |
< |
if SetCursor then |
1764 |
< |
Screen.Cursor := crHourGlass; |
1933 |
> |
FBase.SetCursor; |
1934 |
|
try |
1935 |
|
Buff := GetActiveBuf; |
1936 |
|
if CanRefresh then |
1974 |
|
else |
1975 |
|
IBError(ibxeCannotRefresh, [nil]); |
1976 |
|
finally |
1977 |
< |
if SetCursor and (Screen.Cursor = crHourGlass) then |
1809 |
< |
Screen.Cursor := crDefault; |
1977 |
> |
FBase.RestoreCursor; |
1978 |
|
end; |
1979 |
|
end; |
1980 |
|
|
2045 |
|
|
2046 |
|
procedure TIBCustomDataSet.InternalPrepare; |
2047 |
|
var |
1880 |
– |
SetCursor: Boolean; |
2048 |
|
DidActivate: Boolean; |
2049 |
|
begin |
2050 |
|
if FInternalPrepared then |
2051 |
|
Exit; |
2052 |
|
DidActivate := False; |
2053 |
< |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
1887 |
< |
if SetCursor then |
1888 |
< |
Screen.Cursor := crHourGlass; |
2053 |
> |
FBase.SetCursor; |
2054 |
|
try |
2055 |
|
ActivateConnection; |
2056 |
|
DidActivate := ActivateTransaction; |
2057 |
|
FBase.CheckDatabase; |
2058 |
|
FBase.CheckTransaction; |
2059 |
+ |
if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then |
2060 |
+ |
FQSelect.SQL.Text := FParser.SQLText; |
2061 |
+ |
// writeln( FQSelect.SQL.Text); |
2062 |
|
if FQSelect.SQL.Text <> '' then |
2063 |
|
begin |
2064 |
|
if not FQSelect.Prepared then |
2065 |
|
begin |
2066 |
+ |
FQSelect.GenerateParamNames := FGenerateParamNames; |
2067 |
|
FQSelect.ParamCheck := ParamCheck; |
2068 |
|
FQSelect.Prepare; |
2069 |
|
end; |
2070 |
+ |
FQDelete.GenerateParamNames := FGenerateParamNames; |
2071 |
|
if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then |
2072 |
|
FQDelete.Prepare; |
2073 |
+ |
FQInsert.GenerateParamNames := FGenerateParamNames; |
2074 |
|
if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then |
2075 |
|
FQInsert.Prepare; |
2076 |
+ |
FQRefresh.GenerateParamNames := FGenerateParamNames; |
2077 |
|
if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then |
2078 |
|
FQRefresh.Prepare; |
2079 |
+ |
FQModify.GenerateParamNames := FGenerateParamNames; |
2080 |
|
if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then |
2081 |
|
FQModify.Prepare; |
2082 |
|
FInternalPrepared := True; |
2086 |
|
finally |
2087 |
|
if DidActivate then |
2088 |
|
DeactivateTransaction; |
2089 |
< |
if SetCursor and (Screen.Cursor = crHourGlass) then |
1917 |
< |
Screen.Cursor := crDefault; |
2089 |
> |
FBase.RestoreCursor; |
2090 |
|
end; |
2091 |
|
end; |
2092 |
|
|
2277 |
|
SQL_TIMESTAMP: |
2278 |
|
Qry.Params[i].AsDateTime := |
2279 |
|
TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^))); |
2280 |
+ |
SQL_BOOLEAN: |
2281 |
+ |
Qry.Params[i].AsBoolean := PWordBool(data)^; |
2282 |
|
end; |
2283 |
|
end; |
2284 |
|
end; |
2304 |
|
begin |
2305 |
|
Disconnect; |
2306 |
|
FQSelect.SQL.Assign(Value); |
2307 |
+ |
FBaseSQLSelect.assign(Value); |
2308 |
|
end; |
2309 |
|
end; |
2310 |
|
|
2365 |
|
end; |
2366 |
|
end; |
2367 |
|
|
2368 |
+ |
procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink); |
2369 |
+ |
begin |
2370 |
+ |
if FIBLinks.IndexOf(Sender) = -1 then |
2371 |
+ |
FIBLinks.Add(Sender); |
2372 |
+ |
end; |
2373 |
+ |
|
2374 |
|
|
2375 |
|
procedure TIBCustomDataSet.SQLChanging(Sender: TObject); |
2376 |
|
begin |
2377 |
< |
if FOpen then |
2378 |
< |
InternalClose; |
2377 |
> |
Active := false; |
2378 |
> |
{ if FOpen then |
2379 |
> |
InternalClose;} |
2380 |
|
if FInternalPrepared then |
2381 |
|
InternalUnPrepare; |
2382 |
+ |
FieldDefs.Clear; |
2383 |
+ |
FieldDefs.Updated := false; |
2384 |
|
end; |
2385 |
|
|
2386 |
|
{ I can "undelete" uninserted records (make them "inserted" again). |
2409 |
|
end; |
2410 |
|
end; |
2411 |
|
|
2412 |
+ |
procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink); |
2413 |
+ |
begin |
2414 |
+ |
FIBLinks.Remove(Sender); |
2415 |
+ |
end; |
2416 |
+ |
|
2417 |
|
function TIBCustomDataSet.UpdateStatus: TUpdateStatus; |
2418 |
|
begin |
2419 |
|
if Active then |
2643 |
|
inherited DoBeforeDelete; |
2644 |
|
end; |
2645 |
|
|
2646 |
+ |
procedure TIBCustomDataSet.DoAfterDelete; |
2647 |
+ |
begin |
2648 |
+ |
inherited DoAfterDelete; |
2649 |
+ |
FBase.DoAfterDelete(self); |
2650 |
+ |
InternalAutoCommit; |
2651 |
+ |
end; |
2652 |
+ |
|
2653 |
|
procedure TIBCustomDataSet.DoBeforeEdit; |
2654 |
|
var |
2655 |
|
Buff: PRecordData; |
2664 |
|
inherited DoBeforeEdit; |
2665 |
|
end; |
2666 |
|
|
2667 |
+ |
procedure TIBCustomDataSet.DoAfterEdit; |
2668 |
+ |
begin |
2669 |
+ |
inherited DoAfterEdit; |
2670 |
+ |
FBase.DoAfterEdit(self); |
2671 |
+ |
end; |
2672 |
+ |
|
2673 |
|
procedure TIBCustomDataSet.DoBeforeInsert; |
2674 |
|
begin |
2675 |
|
if not CanInsert then |
2682 |
|
if GeneratorField.ApplyOnEvent = gaeOnNewRecord then |
2683 |
|
GeneratorField.Apply; |
2684 |
|
inherited DoAfterInsert; |
2685 |
+ |
FBase.DoAfterInsert(self); |
2686 |
+ |
end; |
2687 |
+ |
|
2688 |
+ |
procedure TIBCustomDataSet.DoBeforeClose; |
2689 |
+ |
begin |
2690 |
+ |
inherited DoBeforeClose; |
2691 |
+ |
if State in [dsInsert,dsEdit] then |
2692 |
+ |
begin |
2693 |
+ |
if FInTransactionEnd and (FCloseAction = TARollback) then |
2694 |
+ |
Exit; |
2695 |
+ |
|
2696 |
+ |
if DataSetCloseAction = dcSaveChanges then |
2697 |
+ |
Post; |
2698 |
+ |
{Note this can fail with an exception e.g. due to |
2699 |
+ |
database validation error. In which case the dataset remains open } |
2700 |
+ |
end; |
2701 |
+ |
end; |
2702 |
+ |
|
2703 |
+ |
procedure TIBCustomDataSet.DoBeforeOpen; |
2704 |
+ |
var i: integer; |
2705 |
+ |
begin |
2706 |
+ |
if assigned(FParser) then |
2707 |
+ |
FParser.Reset; |
2708 |
+ |
for i := 0 to FIBLinks.Count - 1 do |
2709 |
+ |
TIBControlLink(FIBLinks[i]).UpdateSQL(self); |
2710 |
+ |
inherited DoBeforeOpen; |
2711 |
+ |
for i := 0 to FIBLinks.Count - 1 do |
2712 |
+ |
TIBControlLink(FIBLinks[i]).UpdateParams(self); |
2713 |
|
end; |
2714 |
|
|
2715 |
|
procedure TIBCustomDataSet.DoBeforePost; |
2720 |
|
GeneratorField.Apply |
2721 |
|
end; |
2722 |
|
|
2723 |
+ |
procedure TIBCustomDataSet.DoAfterPost; |
2724 |
+ |
begin |
2725 |
+ |
inherited DoAfterPost; |
2726 |
+ |
FBase.DoAfterPost(self); |
2727 |
+ |
InternalAutoCommit; |
2728 |
+ |
end; |
2729 |
+ |
|
2730 |
|
procedure TIBCustomDataSet.FetchAll; |
2731 |
|
var |
2732 |
< |
SetCursor: Boolean; |
2496 |
< |
{$IF FPC_FULLVERSION > 20602 } |
2732 |
> |
{$IF FPC_FULLVERSION >= 20700 } |
2733 |
|
CurBookmark: TBookmark; |
2734 |
|
{$ELSE} |
2735 |
|
CurBookmark: string; |
2736 |
|
{$ENDIF} |
2737 |
|
begin |
2738 |
< |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
2739 |
< |
if SetCursor then |
2504 |
< |
Screen.Cursor := crHourGlass; |
2505 |
< |
try |
2738 |
> |
FBase.SetCursor; |
2739 |
> |
try |
2740 |
|
if FQSelect.EOF or not FQSelect.Open then |
2741 |
|
exit; |
2742 |
|
DisableControls; |
2748 |
|
EnableControls; |
2749 |
|
end; |
2750 |
|
finally |
2751 |
< |
if SetCursor and (Screen.Cursor = crHourGlass) then |
2518 |
< |
Screen.Cursor := crDefault; |
2751 |
> |
FBase.RestoreCursor; |
2752 |
|
end; |
2753 |
|
end; |
2754 |
|
|
2796 |
|
result := FDataLink.DataSource; |
2797 |
|
end; |
2798 |
|
|
2799 |
+ |
function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string; |
2800 |
+ |
begin |
2801 |
+ |
Result := FAliasNameMap[FieldNo-1] |
2802 |
+ |
end; |
2803 |
+ |
|
2804 |
+ |
function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef; |
2805 |
+ |
var |
2806 |
+ |
i: integer; |
2807 |
+ |
begin |
2808 |
+ |
Result := nil; |
2809 |
+ |
for i := 0 to Length(FAliasNameMap) - 1 do |
2810 |
+ |
if FAliasNameMap[i] = aliasName then |
2811 |
+ |
begin |
2812 |
+ |
Result := FieldDefs[i]; |
2813 |
+ |
Exit |
2814 |
+ |
end; |
2815 |
+ |
end; |
2816 |
+ |
|
2817 |
|
function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass; |
2818 |
|
begin |
2819 |
|
Result := DefaultFieldClasses[FieldType]; |
2854 |
|
Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs; |
2855 |
|
if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then |
2856 |
|
begin |
2857 |
< |
if fdDataLength <= Field.Size then |
2857 |
> |
if fdDataLength < Field.DataSize then |
2858 |
|
begin |
2859 |
|
Move(Data^, Buffer^, fdDataLength); |
2860 |
|
PChar(Buffer)[fdDataLength] := #0; |
2903 |
|
if not Accept and (GetMode = gmCurrent) then |
2904 |
|
GetMode := gmPrior; |
2905 |
|
except |
2906 |
< |
// Application.HandleException(Self); |
2906 |
> |
// FBase.HandleException(Self); |
2907 |
|
end; |
2908 |
|
end; |
2909 |
|
RestoreState(SaveState); |
2997 |
|
result := FRecordBufferSize; |
2998 |
|
end; |
2999 |
|
|
3000 |
+ |
procedure TIBCustomDataSet.InternalAutoCommit; |
3001 |
+ |
begin |
3002 |
+ |
with Transaction do |
3003 |
+ |
if InTransaction and (FAutoCommit = acCommitRetaining) then |
3004 |
+ |
begin |
3005 |
+ |
if CachedUpdates then ApplyUpdates; |
3006 |
+ |
CommitRetaining; |
3007 |
+ |
end; |
3008 |
+ |
end; |
3009 |
+ |
|
3010 |
|
procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean); |
3011 |
|
begin |
3012 |
|
CheckEditState; |
3084 |
|
procedure TIBCustomDataSet.InternalDelete; |
3085 |
|
var |
3086 |
|
Buff: PChar; |
2826 |
– |
SetCursor: Boolean; |
3087 |
|
begin |
3088 |
< |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
2829 |
< |
if SetCursor then |
2830 |
< |
Screen.Cursor := crHourGlass; |
3088 |
> |
FBase.SetCursor; |
3089 |
|
try |
3090 |
|
Buff := GetActiveBuf; |
3091 |
|
if CanDelete then |
3110 |
|
end else |
3111 |
|
IBError(ibxeCannotDelete, [nil]); |
3112 |
|
finally |
3113 |
< |
if SetCursor and (Screen.Cursor = crHourGlass) then |
2856 |
< |
Screen.Cursor := crDefault; |
3113 |
> |
FBase.RestoreCursor; |
3114 |
|
end; |
3115 |
|
end; |
3116 |
|
|
3126 |
|
|
3127 |
|
procedure TIBCustomDataSet.InternalHandleException; |
3128 |
|
begin |
3129 |
< |
Application.HandleException(Self) |
3129 |
> |
FBase.HandleException(Self) |
3130 |
|
end; |
3131 |
|
|
3132 |
|
procedure TIBCustomDataSet.InternalInitFieldDefs; |
3133 |
+ |
begin |
3134 |
+ |
if not InternalPrepared then |
3135 |
+ |
begin |
3136 |
+ |
InternalPrepare; |
3137 |
+ |
exit; |
3138 |
+ |
end; |
3139 |
+ |
FieldDefsFromQuery(FQSelect); |
3140 |
+ |
end; |
3141 |
+ |
|
3142 |
+ |
procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL); |
3143 |
|
const |
3144 |
|
DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize} |
3145 |
|
'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize} |
3151 |
|
var |
3152 |
|
FieldType: TFieldType; |
3153 |
|
FieldSize: Word; |
3154 |
+ |
CharSetSize: integer; |
3155 |
|
FieldNullable : Boolean; |
3156 |
|
i, FieldPosition, FieldPrecision: Integer; |
3157 |
< |
FieldAliasName: string; |
3157 |
> |
FieldAliasName, DBAliasName: string; |
3158 |
|
RelationName, FieldName: string; |
3159 |
|
Query : TIBSQL; |
3160 |
|
FieldIndex: Integer; |
3254 |
|
end; |
3255 |
|
|
3256 |
|
begin |
2989 |
– |
if not InternalPrepared then |
2990 |
– |
begin |
2991 |
– |
InternalPrepare; |
2992 |
– |
exit; |
2993 |
– |
end; |
3257 |
|
FRelationNodes := TRelationNode.Create; |
3258 |
|
FNeedsRefresh := False; |
3259 |
|
Database.InternalTransaction.StartTransaction; |
3264 |
|
FieldDefs.BeginUpdate; |
3265 |
|
FieldDefs.Clear; |
3266 |
|
FieldIndex := 0; |
3267 |
< |
if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then |
3268 |
< |
SetLength(FMappedFieldPosition, FQSelect.Current.Count); |
3267 |
> |
if (Length(FMappedFieldPosition) < SourceQuery.Current.Count) then |
3268 |
> |
SetLength(FMappedFieldPosition, SourceQuery.Current.Count); |
3269 |
|
Query.SQL.Text := DefaultSQL; |
3270 |
|
Query.Prepare; |
3271 |
< |
for i := 0 to FQSelect.Current.Count - 1 do |
3272 |
< |
with FQSelect.Current[i].Data^ do |
3271 |
> |
SetLength(FAliasNameMap, SourceQuery.Current.Count); |
3272 |
> |
SetLength(FAliasNameList, SourceQuery.Current.Count); |
3273 |
> |
for i := 0 to SourceQuery.Current.Count - 1 do |
3274 |
> |
with SourceQuery.Current[i].Data^ do |
3275 |
|
begin |
3276 |
|
{ Get the field name } |
3277 |
< |
SetString(FieldAliasName, aliasname, aliasname_length); |
3277 |
> |
FieldAliasName := SourceQuery.Current[i].Name; |
3278 |
> |
SetString(DBAliasName, aliasname, aliasname_length); |
3279 |
|
SetString(RelationName, relname, relname_length); |
3280 |
|
SetString(FieldName, sqlname, sqlname_length); |
3281 |
+ |
FAliasNameList[i] := DBAliasName; |
3282 |
|
FieldSize := 0; |
3283 |
|
FieldPrecision := 0; |
3284 |
< |
FieldNullable := FQSelect.Current[i].IsNullable; |
3284 |
> |
FieldNullable := SourceQuery.Current[i].IsNullable; |
3285 |
|
case sqltype and not 1 of |
3286 |
|
{ All VARCHAR's must be converted to strings before recording |
3287 |
|
their values } |
3288 |
|
SQL_VARYING, SQL_TEXT: |
3289 |
|
begin |
3290 |
< |
FieldSize := sqllen; |
3290 |
> |
CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF); |
3291 |
> |
{FieldSize is encoded for strings - see TIBStringField.SetSize for decode} |
3292 |
> |
FieldSize := sqllen * 4 + (CharSetSize - 1); |
3293 |
|
FieldType := ftString; |
3294 |
|
end; |
3295 |
|
{ All Doubles/Floats should be cast to doubles } |
3358 |
|
FieldSize := sizeof (TISC_QUAD); |
3359 |
|
FieldType := ftUnknown; |
3360 |
|
end; |
3361 |
+ |
SQL_BOOLEAN: |
3362 |
+ |
FieldType:= ftBoolean; |
3363 |
|
else |
3364 |
|
FieldType := ftUnknown; |
3365 |
|
end; |
3371 |
|
with FieldDefs.AddFieldDef do |
3372 |
|
begin |
3373 |
|
Name := FieldAliasName; |
3374 |
< |
(* FieldNo := FieldPosition;*) |
3374 |
> |
FAliasNameMap[FieldNo-1] := DBAliasName; |
3375 |
|
DataType := FieldType; |
3376 |
|
Size := FieldSize; |
3377 |
|
Precision := FieldPrecision; |
3456 |
|
else case cur_field.DataType of |
3457 |
|
ftString: |
3458 |
|
cur_param.AsString := cur_field.AsString; |
3459 |
< |
ftBoolean, ftSmallint, ftWord: |
3459 |
> |
ftBoolean: |
3460 |
> |
cur_param.AsBoolean := cur_field.AsBoolean; |
3461 |
> |
ftSmallint, ftWord: |
3462 |
|
cur_param.AsShort := cur_field.AsInteger; |
3463 |
|
ftInteger: |
3464 |
|
cur_param.AsLong := cur_field.AsInteger; |
3511 |
|
end; |
3512 |
|
|
3513 |
|
procedure TIBCustomDataSet.InternalOpen; |
3241 |
– |
var |
3242 |
– |
SetCursor: Boolean; |
3514 |
|
|
3515 |
|
function RecordDataLength(n: Integer): Long; |
3516 |
|
begin |
3518 |
|
end; |
3519 |
|
|
3520 |
|
begin |
3521 |
< |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
3251 |
< |
if SetCursor then |
3252 |
< |
Screen.Cursor := crHourGlass; |
3521 |
> |
FBase.SetCursor; |
3522 |
|
try |
3523 |
|
ActivateConnection; |
3524 |
|
ActivateTransaction; |
3579 |
|
else |
3580 |
|
FQSelect.ExecQuery; |
3581 |
|
finally |
3582 |
< |
if SetCursor and (Screen.Cursor = crHourGlass) then |
3314 |
< |
Screen.Cursor := crDefault; |
3582 |
> |
FBase.RestoreCursor; |
3583 |
|
end; |
3584 |
|
end; |
3585 |
|
|
3587 |
|
var |
3588 |
|
Qry: TIBSQL; |
3589 |
|
Buff: PChar; |
3322 |
– |
SetCursor: Boolean; |
3590 |
|
bInserting: Boolean; |
3591 |
|
begin |
3592 |
< |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
3326 |
< |
if SetCursor then |
3327 |
< |
Screen.Cursor := crHourGlass; |
3592 |
> |
FBase.SetCursor; |
3593 |
|
try |
3594 |
|
Buff := GetActiveBuf; |
3595 |
|
CheckEditState; |
3627 |
|
if bInserting then |
3628 |
|
Inc(FRecordCount); |
3629 |
|
finally |
3630 |
< |
if SetCursor and (Screen.Cursor = crHourGlass) then |
3366 |
< |
Screen.Cursor := crDefault; |
3630 |
> |
FBase.RestoreCursor; |
3631 |
|
end; |
3632 |
|
end; |
3633 |
|
|
3647 |
|
result := FOpen; |
3648 |
|
end; |
3649 |
|
|
3650 |
+ |
procedure TIBCustomDataSet.Loaded; |
3651 |
+ |
begin |
3652 |
+ |
if assigned(FQSelect) then |
3653 |
+ |
FBaseSQLSelect.assign(FQSelect.SQL); |
3654 |
+ |
inherited Loaded; |
3655 |
+ |
end; |
3656 |
+ |
|
3657 |
+ |
procedure TIBCustomDataSet.Post; |
3658 |
+ |
var CancelPost: boolean; |
3659 |
+ |
begin |
3660 |
+ |
CancelPost := false; |
3661 |
+ |
if assigned(FOnValidatePost) then |
3662 |
+ |
OnValidatePost(self,CancelPost); |
3663 |
+ |
if CancelPost then |
3664 |
+ |
Cancel |
3665 |
+ |
else |
3666 |
+ |
inherited Post; |
3667 |
+ |
end; |
3668 |
+ |
|
3669 |
|
function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant; |
3670 |
|
Options: TLocateOptions): Boolean; |
3671 |
|
var |
3672 |
< |
{$IF FPC_FULLVERSION > 20602 } |
3672 |
> |
{$IF FPC_FULLVERSION >= 20700 } |
3673 |
|
CurBookmark: TBookmark; |
3674 |
|
{$ELSE} |
3675 |
|
CurBookmark: string; |
3691 |
|
const ResultFields: string): Variant; |
3692 |
|
var |
3693 |
|
fl: TList; |
3694 |
< |
{$IF FPC_FULLVERSION > 20602 } |
3694 |
> |
{$IF FPC_FULLVERSION >= 20700 } |
3695 |
|
CurBookmark: TBookmark; |
3696 |
|
{$ELSE} |
3697 |
|
CurBookmark: string; |
3748 |
|
procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer); |
3749 |
|
var |
3750 |
|
Buff, TmpBuff: PChar; |
3751 |
+ |
MappedFieldPos: integer; |
3752 |
|
begin |
3753 |
|
Buff := GetActiveBuf; |
3754 |
|
if Field.FieldNo < 0 then |
3765 |
|
begin |
3766 |
|
{ If inserting, Adjust record position } |
3767 |
|
AdjustRecordOnInsert(Buff); |
3768 |
< |
if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and |
3769 |
< |
(FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then |
3768 |
> |
MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1]; |
3769 |
> |
if (MappedFieldPos > 0) and |
3770 |
> |
(MappedFieldPos <= rdFieldCount) then |
3771 |
|
begin |
3772 |
|
Field.Validate(Buffer); |
3773 |
|
if (Buffer = nil) or |
3774 |
|
(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then |
3775 |
< |
rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True |
3775 |
> |
rdFields[MappedFieldPos].fdIsNull := True |
3776 |
|
else begin |
3777 |
< |
Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs], |
3778 |
< |
rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize); |
3779 |
< |
if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or |
3780 |
< |
(rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then |
3781 |
< |
rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer)); |
3782 |
< |
rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False; |
3777 |
> |
Move(Buffer^, Buff[rdFields[MappedFieldPos].fdDataOfs], |
3778 |
> |
rdFields[MappedFieldPos].fdDataSize); |
3779 |
> |
if (rdFields[MappedFieldPos].fdDataType = SQL_TEXT) or |
3780 |
> |
(rdFields[MappedFieldPos].fdDataType = SQL_VARYING) then |
3781 |
> |
rdFields[MappedFieldPos].fdDataLength := StrLen(PChar(Buffer)); |
3782 |
> |
rdFields[MappedFieldPos].fdIsNull := False; |
3783 |
|
if rdUpdateStatus = usUnmodified then |
3784 |
|
begin |
3785 |
|
if CachedUpdates then |
3867 |
|
FillChar(Buffer[FRecordSize], CalcFieldsSize, 0); |
3868 |
|
end; |
3869 |
|
|
3870 |
+ |
procedure TIBCustomDataSet.ClearIBLinks; |
3871 |
+ |
var i: integer; |
3872 |
+ |
begin |
3873 |
+ |
for i := FIBLinks.Count - 1 downto 0 do |
3874 |
+ |
TIBControlLink(FIBLinks[i]).IBDataSet := nil; |
3875 |
+ |
end; |
3876 |
+ |
|
3877 |
|
|
3878 |
|
procedure TIBCustomDataSet.InternalUnPrepare; |
3879 |
|
begin |
3881 |
|
begin |
3882 |
|
CheckDatasetClosed; |
3883 |
|
FieldDefs.Clear; |
3884 |
+ |
FieldDefs.Updated := false; |
3885 |
|
FInternalPrepared := False; |
3886 |
+ |
Setlength(FAliasNameList,0); |
3887 |
|
end; |
3888 |
|
end; |
3889 |
|
|
3890 |
|
procedure TIBCustomDataSet.InternalExecQuery; |
3891 |
|
var |
3892 |
|
DidActivate: Boolean; |
3599 |
– |
SetCursor: Boolean; |
3893 |
|
begin |
3894 |
|
DidActivate := False; |
3895 |
< |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
3603 |
< |
if SetCursor then |
3604 |
< |
Screen.Cursor := crHourGlass; |
3895 |
> |
FBase.SetCursor; |
3896 |
|
try |
3897 |
|
ActivateConnection; |
3898 |
|
DidActivate := ActivateTransaction; |
3909 |
|
finally |
3910 |
|
if DidActivate then |
3911 |
|
DeactivateTransaction; |
3912 |
< |
if SetCursor and (Screen.Cursor = crHourGlass) then |
3622 |
< |
Screen.Cursor := crDefault; |
3912 |
> |
FBase.RestoreCursor; |
3913 |
|
end; |
3914 |
|
end; |
3915 |
|
|
3918 |
|
Result := FQSelect.Handle; |
3919 |
|
end; |
3920 |
|
|
3921 |
+ |
function TIBCustomDataSet.GetParser: TSelectSQLParser; |
3922 |
+ |
begin |
3923 |
+ |
if not assigned(FParser) then |
3924 |
+ |
FParser := CreateParser; |
3925 |
+ |
Result := FParser |
3926 |
+ |
end; |
3927 |
+ |
|
3928 |
+ |
procedure TIBCustomDataSet.ResetParser; |
3929 |
+ |
begin |
3930 |
+ |
if assigned(FParser) then |
3931 |
+ |
begin |
3932 |
+ |
FParser.Free; |
3933 |
+ |
FParser := nil; |
3934 |
+ |
SQLChanging(nil) |
3935 |
+ |
end; |
3936 |
+ |
end; |
3937 |
+ |
|
3938 |
+ |
function TIBCustomDataSet.HasParser: boolean; |
3939 |
+ |
begin |
3940 |
+ |
Result := not (csDesigning in ComponentState) and (FParser <> nil) |
3941 |
+ |
end; |
3942 |
+ |
|
3943 |
+ |
procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean); |
3944 |
+ |
begin |
3945 |
+ |
if FGenerateParamNames = AValue then Exit; |
3946 |
+ |
FGenerateParamNames := AValue; |
3947 |
+ |
Disconnect |
3948 |
+ |
end; |
3949 |
+ |
|
3950 |
|
procedure TIBCustomDataSet.InitRecord(Buffer: PChar); |
3951 |
|
begin |
3952 |
|
inherited InitRecord(Buffer); |
4281 |
|
FBlobStream.Truncate; |
4282 |
|
end; |
4283 |
|
|
4284 |
+ |
destructor TIBDSBlobStream.Destroy; |
4285 |
+ |
begin |
4286 |
+ |
if FHasWritten then |
4287 |
+ |
TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField)); |
4288 |
+ |
inherited Destroy; |
4289 |
+ |
end; |
4290 |
+ |
|
4291 |
|
function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint; |
4292 |
|
begin |
4293 |
|
result := FBlobStream.Read(Buffer, Count); |
4310 |
|
TIBCustomDataSet(FField.DataSet).RecordModified(True); |
4311 |
|
TBlobField(FField).Modified := true; |
4312 |
|
result := FBlobStream.Write(Buffer, Count); |
4313 |
< |
TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField)); |
4313 |
> |
FHasWritten := true; |
4314 |
> |
{ TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField)); |
4315 |
> |
Removed as this caused a seek to beginning of the blob stream thus corrupting |
4316 |
> |
the blob stream. Moved to the destructor i.e. called after blob written} |
4317 |
|
end; |
4318 |
|
|
4319 |
|
{ TIBGenerator } |