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 |
+ |
{$IF FPC_FULLVERSION >= 20700 } |
37 |
+ |
{$codepage UTF8} |
38 |
+ |
{$DEFINE HAS_ANSISTRING_CODEPAGE} |
39 |
+ |
{$DEFINE NEW_TBOOKMARK} |
40 |
+ |
{$ENDIF} |
41 |
+ |
|
42 |
+ |
{$R-} |
43 |
+ |
|
44 |
|
{$Mode Delphi} |
45 |
|
|
46 |
|
{$IFDEF DELPHI} |
55 |
|
{$ELSE} |
56 |
|
unix, |
57 |
|
{$ENDIF} |
58 |
< |
SysUtils, Classes, Forms, Controls, IBDatabase, |
59 |
< |
IBExternals, IB, IBHeader, IBSQL, Db, |
52 |
< |
IBUtils, IBBlob; |
58 |
> |
SysUtils, Classes, IBDatabase, IBExternals, IB, IBHeader, IBSQL, Db, |
59 |
> |
IBUtils, IBBlob, IBSQLParser; |
60 |
|
|
61 |
|
const |
62 |
|
BufferCacheSize = 1000; { Allocate cache in this many record chunks} |
125 |
|
{ TIBStringField allows us to have strings longer than 8196 } |
126 |
|
|
127 |
|
TIBStringField = class(TStringField) |
128 |
+ |
private |
129 |
+ |
FCharacterSetName: RawByteString; |
130 |
+ |
FCharacterSetSize: integer; |
131 |
+ |
protected |
132 |
+ |
function GetDefaultWidth: Longint; override; |
133 |
|
public |
134 |
< |
constructor create(AOwner: TComponent); override; |
134 |
> |
constructor Create(aOwner: TComponent); override; |
135 |
|
class procedure CheckTypeSize(Value: Integer); override; |
136 |
|
function GetAsString: string; override; |
137 |
|
function GetAsVariant: Variant; override; |
138 |
|
function GetValue(var Value: string): Boolean; |
139 |
|
procedure SetAsString(const Value: string); override; |
140 |
+ |
property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName; |
141 |
+ |
property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize; |
142 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
143 |
+ |
private |
144 |
+ |
FCodePage: TSystemCodePage; |
145 |
+ |
public |
146 |
+ |
property CodePage: TSystemCodePage read FCodePage write FCodePage; |
147 |
+ |
{$ENDIF} |
148 |
+ |
end; |
149 |
+ |
|
150 |
+ |
{ TIBWideStringField } |
151 |
+ |
|
152 |
+ |
TIBWideStringField = class(TWideStringField) |
153 |
+ |
private |
154 |
+ |
FCharacterSetName: RawByteString; |
155 |
+ |
FCharacterSetSize: integer; |
156 |
+ |
public |
157 |
+ |
property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName; |
158 |
+ |
property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize; |
159 |
|
end; |
160 |
|
|
161 |
|
{ TIBBCDField } |
178 |
|
property Size default 8; |
179 |
|
end; |
180 |
|
|
181 |
+ |
{TIBMemoField} |
182 |
+ |
{Allows us to show truncated text in DBGrids and anything else that uses |
183 |
+ |
DisplayText} |
184 |
+ |
|
185 |
+ |
TIBMemoField = class(TMemoField) |
186 |
+ |
private |
187 |
+ |
FCharacterSetName: RawByteString; |
188 |
+ |
FCharacterSetSize: integer; |
189 |
+ |
FDisplayTextAsClassName: boolean; |
190 |
+ |
function GetTruncatedText: string; |
191 |
+ |
protected |
192 |
+ |
function GetAsString: string; override; |
193 |
+ |
function GetDefaultWidth: Longint; override; |
194 |
+ |
procedure GetText(var AText: string; ADisplayText: Boolean); override; |
195 |
+ |
procedure SetAsString(const AValue: string); override; |
196 |
+ |
public |
197 |
+ |
constructor Create(AOwner: TComponent); override; |
198 |
+ |
property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName; |
199 |
+ |
property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize; |
200 |
+ |
published |
201 |
+ |
property DisplayTextAsClassName: boolean read FDisplayTextAsClassName |
202 |
+ |
write FDisplayTextAsClassName; |
203 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
204 |
+ |
private |
205 |
+ |
FCodePage: TSystemCodePage; |
206 |
+ |
FFCodePage: TSystemCodePage; |
207 |
+ |
public |
208 |
+ |
property CodePage: TSystemCodePage read FFCodePage write FFCodePage; |
209 |
+ |
{$ENDIF} |
210 |
+ |
end; |
211 |
+ |
|
212 |
+ |
{ TIBWideMemoField } |
213 |
+ |
|
214 |
+ |
TIBWideMemoField = class(TWideMemoField) |
215 |
+ |
private |
216 |
+ |
FCharacterSetName: RawByteString; |
217 |
+ |
FCharacterSetSize: integer; |
218 |
+ |
FDisplayTextAsClassName: boolean; |
219 |
+ |
function GetTruncatedText: string; |
220 |
+ |
protected |
221 |
+ |
function GetDefaultWidth: Longint; override; |
222 |
+ |
procedure GetText(var AText: string; ADisplayText: Boolean); override; |
223 |
+ |
public |
224 |
+ |
constructor Create(AOwner: TComponent); override; |
225 |
+ |
property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName; |
226 |
+ |
property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize; |
227 |
+ |
published |
228 |
+ |
property DisplayTextAsClassName: boolean read FDisplayTextAsClassName |
229 |
+ |
write FDisplayTextAsClassName; |
230 |
+ |
end; |
231 |
+ |
|
232 |
|
TIBDataLink = class(TDetailDataLink) |
233 |
|
private |
234 |
|
FDataSet: TIBCustomDataSet; |
267 |
|
property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent; |
268 |
|
end; |
269 |
|
|
270 |
+ |
{TIBControlLink - Allows IB Aware controls to react to dataset state changes} |
271 |
+ |
|
272 |
+ |
TIBControlLink = class |
273 |
+ |
private |
274 |
+ |
FTIBDataSet: TIBCustomDataSet; |
275 |
+ |
procedure SetIBDataSet(AValue: TIBCustomDataSet); |
276 |
+ |
protected |
277 |
+ |
procedure UpdateSQL(Sender: TObject); virtual; |
278 |
+ |
procedure UpdateParams(Sender: TObject); virtual; |
279 |
+ |
public |
280 |
+ |
destructor Destroy; override; |
281 |
+ |
property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet; |
282 |
+ |
end; |
283 |
+ |
|
284 |
+ |
TIBAutoCommit = (acDisabled, acCommitRetaining); |
285 |
+ |
|
286 |
|
{ TIBCustomDataSet } |
287 |
|
TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied); |
288 |
|
|
289 |
|
TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError; |
290 |
< |
UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction) |
290 |
> |
UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction) |
291 |
|
of object; |
292 |
|
TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind; |
293 |
|
var UpdateAction: TIBUpdateAction) of object; |
294 |
|
|
295 |
|
TIBUpdateRecordTypes = set of TCachedUpdateStatus; |
296 |
|
|
297 |
+ |
TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges); |
298 |
+ |
|
299 |
+ |
TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object; |
300 |
+ |
|
301 |
|
TIBCustomDataSet = class(TDataset) |
302 |
|
private |
303 |
+ |
FAutoCommit: TIBAutoCommit; |
304 |
+ |
FGenerateParamNames: Boolean; |
305 |
|
FGeneratorField: TIBGenerator; |
306 |
|
FNeedsRefresh: Boolean; |
307 |
|
FForcedRefresh: Boolean; |
327 |
|
FDeletedRecords: Long; |
328 |
|
FModelBuffer, |
329 |
|
FOldBuffer: PChar; |
330 |
+ |
FOnValidatePost: TOnValidatePost; |
331 |
|
FOpen: Boolean; |
332 |
|
FInternalPrepared: Boolean; |
333 |
|
FQDelete, |
338 |
|
FRecordBufferSize: Integer; |
339 |
|
FRecordCount: Integer; |
340 |
|
FRecordSize: Integer; |
341 |
+ |
FDataSetCloseAction: TDataSetCloseAction; |
342 |
|
FUniDirectional: Boolean; |
343 |
|
FUpdateMode: TUpdateMode; |
344 |
|
FUpdateObject: TIBDataSetUpdateObject; |
356 |
|
FBeforeTransactionEnd, |
357 |
|
FAfterTransactionEnd, |
358 |
|
FTransactionFree: TNotifyEvent; |
359 |
< |
|
359 |
> |
FAliasNameMap: array of string; |
360 |
> |
FAliasNameList: array of string; |
361 |
> |
FBaseSQLSelect: TStrings; |
362 |
> |
FParser: TSelectSQLParser; |
363 |
> |
FCloseAction: TTransactionAction; |
364 |
> |
FInTransactionEnd: boolean; |
365 |
> |
FIBLinks: TList; |
366 |
|
function GetSelectStmtHandle: TISC_STMT_HANDLE; |
367 |
|
procedure SetUpdateMode(const Value: TUpdateMode); |
368 |
|
procedure SetUpdateObject(Value: TIBDataSetUpdateObject); |
375 |
|
function CanRefresh: Boolean; |
376 |
|
procedure CheckEditState; |
377 |
|
procedure ClearBlobCache; |
378 |
+ |
procedure ClearIBLinks; |
379 |
|
procedure CopyRecordBuffer(Source, Dest: Pointer); |
380 |
|
procedure DoBeforeDatabaseDisconnect(Sender: TObject); |
381 |
|
procedure DoAfterDatabaseDisconnect(Sender: TObject); |
382 |
|
procedure DoDatabaseFree(Sender: TObject); |
383 |
< |
procedure DoBeforeTransactionEnd(Sender: TObject); |
383 |
> |
procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction); |
384 |
|
procedure DoAfterTransactionEnd(Sender: TObject); |
385 |
|
procedure DoTransactionFree(Sender: TObject); |
386 |
|
procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer; |
396 |
|
function GetModifySQL: TStrings; |
397 |
|
function GetTransaction: TIBTransaction; |
398 |
|
function GetTRHandle: PISC_TR_HANDLE; |
399 |
+ |
function GetParser: TSelectSQLParser; |
400 |
|
procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual; |
401 |
|
function InternalLocate(const KeyFields: string; const KeyValues: Variant; |
402 |
|
Options: TLocateOptions): Boolean; virtual; |
403 |
|
procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual; |
404 |
|
procedure InternalRevertRecord(RecordNumber: Integer); virtual; |
405 |
|
function IsVisible(Buffer: PChar): Boolean; |
406 |
+ |
procedure RegisterIBLink(Sender: TIBControlLink); |
407 |
+ |
procedure UnRegisterIBLink(Sender: TIBControlLink); |
408 |
|
procedure SaveOldBuffer(Buffer: PChar); |
409 |
|
procedure SetBufferChunks(Value: Integer); |
410 |
|
procedure SetDatabase(Value: TIBDatabase); |
418 |
|
procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes); |
419 |
|
procedure SetUniDirectional(Value: Boolean); |
420 |
|
procedure RefreshParams; |
305 |
– |
procedure SQLChanging(Sender: TObject); virtual; |
421 |
|
function AdjustPosition(FCache: PChar; Offset: DWORD; |
422 |
|
Origin: Integer): DWORD; |
423 |
|
procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer; |
436 |
|
procedure DeactivateTransaction; |
437 |
|
procedure CheckDatasetClosed; |
438 |
|
procedure CheckDatasetOpen; |
439 |
+ |
function CreateParser: TSelectSQLParser; virtual; |
440 |
+ |
procedure FieldDefsFromQuery(SourceQuery: TIBSQL); |
441 |
|
function GetActiveBuf: PChar; |
442 |
|
procedure InternalBatchInput(InputObject: TIBBatchInput); virtual; |
443 |
|
procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual; |
447 |
|
procedure InternalRefreshRow; virtual; |
448 |
|
procedure InternalSetParamsFromCursor; virtual; |
449 |
|
procedure CheckNotUniDirectional; |
450 |
+ |
procedure SQLChanging(Sender: TObject); virtual; |
451 |
+ |
procedure SQLChanged(Sender: TObject); virtual; |
452 |
|
|
453 |
|
(* { IProviderSupport } |
454 |
|
procedure PSEndTransaction(Commit: Boolean); override; |
472 |
|
procedure ClearCalcFields(Buffer: PChar); override; |
473 |
|
function AllocRecordBuffer: PChar; override; |
474 |
|
procedure DoBeforeDelete; override; |
475 |
+ |
procedure DoAfterDelete; override; |
476 |
|
procedure DoBeforeEdit; override; |
477 |
+ |
procedure DoAfterEdit; override; |
478 |
|
procedure DoBeforeInsert; override; |
479 |
|
procedure DoAfterInsert; override; |
480 |
+ |
procedure DoBeforeClose; override; |
481 |
+ |
procedure DoBeforeOpen; override; |
482 |
|
procedure DoBeforePost; override; |
483 |
+ |
procedure DoAfterPost; override; |
484 |
|
procedure FreeRecordBuffer(var Buffer: PChar); override; |
485 |
|
procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override; |
486 |
|
function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override; |
487 |
|
function GetCanModify: Boolean; override; |
488 |
|
function GetDataSource: TDataSource; override; |
489 |
+ |
function GetDBAliasName(FieldNo: integer): string; |
490 |
+ |
function GetFieldDefFromAlias(aliasName: string): TFieldDef; |
491 |
|
function GetFieldClass(FieldType: TFieldType): TFieldClass; override; |
492 |
|
function GetRecNo: Integer; override; |
493 |
|
function GetRecord(Buffer: PChar; GetMode: TGetMode; |
494 |
|
DoCheck: Boolean): TGetResult; override; |
495 |
|
function GetRecordCount: Integer; override; |
496 |
|
function GetRecordSize: Word; override; |
497 |
+ |
procedure InternalAutoCommit; |
498 |
|
procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override; |
499 |
|
procedure InternalCancel; override; |
500 |
|
procedure InternalClose; override; |
512 |
|
procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual; |
513 |
|
procedure InternalSetToRecord(Buffer: PChar); override; |
514 |
|
function IsCursorOpen: Boolean; override; |
515 |
+ |
procedure Loaded; override; |
516 |
|
procedure ReQuery; |
517 |
|
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override; |
518 |
|
procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override; |
519 |
|
procedure SetCachedUpdates(Value: Boolean); |
520 |
|
procedure SetDataSource(Value: TDataSource); |
521 |
+ |
procedure SetGenerateParamNames(AValue: Boolean); virtual; |
522 |
|
procedure SetFieldData(Field : TField; Buffer : Pointer); override; |
523 |
|
procedure SetFieldData(Field : TField; Buffer : Pointer; |
524 |
|
NativeFormat : Boolean); overload; override; |
526 |
|
|
527 |
|
protected |
528 |
|
{Likely to be made public by descendant classes} |
529 |
+ |
property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled; |
530 |
|
property SQLParams: TIBXSQLDA read GetSQLParams; |
531 |
|
property Params: TIBXSQLDA read GetSQLParams; |
532 |
|
property InternalPrepared: Boolean read FInternalPrepared; |
550 |
|
property ModifySQL: TStrings read GetModifySQL write SetModifySQL; |
551 |
|
property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll; |
552 |
|
property ParamCheck: Boolean read FParamCheck write FParamCheck default True; |
553 |
+ |
property Parser: TSelectSQLParser read GetParser; |
554 |
+ |
property BaseSQLSelect: TStrings read FBaseSQLSelect; |
555 |
|
|
556 |
|
property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect |
557 |
|
write FBeforeDatabaseDisconnect; |
565 |
|
write FAfterTransactionEnd; |
566 |
|
property TransactionFree: TNotifyEvent read FTransactionFree |
567 |
|
write FTransactionFree; |
568 |
+ |
property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost; |
569 |
|
|
570 |
|
public |
571 |
|
constructor Create(AOwner: TComponent); override; |
573 |
|
procedure ApplyUpdates; |
574 |
|
function CachedUpdateStatus: TCachedUpdateStatus; |
575 |
|
procedure CancelUpdates; |
576 |
+ |
function GetFieldPosition(AliasName: string): integer; |
577 |
|
procedure FetchAll; |
578 |
|
function LocateNext(const KeyFields: string; const KeyValues: Variant; |
579 |
|
Options: TLocateOptions): Boolean; |
580 |
|
procedure RecordModified(Value: Boolean); |
581 |
|
procedure RevertRecord; |
582 |
|
procedure Undelete; |
583 |
+ |
procedure ResetParser; virtual; |
584 |
+ |
function HasParser: boolean; |
585 |
|
|
586 |
|
{ TDataSet support methods } |
587 |
|
function BookmarkValid(Bookmark: TBookmark): Boolean; override; |
592 |
|
function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*) |
593 |
|
function GetFieldData(Field : TField; Buffer : Pointer; |
594 |
|
NativeFormat : Boolean) : Boolean; overload; override; |
595 |
+ |
property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames; |
596 |
|
function Locate(const KeyFields: string; const KeyValues: Variant; |
597 |
|
Options: TLocateOptions): Boolean; override; |
598 |
|
function Lookup(const KeyFields: string; const KeyValues: Variant; |
599 |
|
const ResultFields: string): Variant; override; |
600 |
|
function UpdateStatus: TUpdateStatus; override; |
601 |
|
function IsSequenced: Boolean; override; |
602 |
+ |
procedure Post; override; |
603 |
|
function ParamByName(ParamName: String): TIBXSQLVAR; |
604 |
|
property DBHandle: PISC_DB_HANDLE read GetDBHandle; |
605 |
|
property TRHandle: PISC_TR_HANDLE read GetTRHandle; |
607 |
|
property UpdatesPending: Boolean read FUpdatesPending; |
608 |
|
property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes |
609 |
|
write SetUpdateRecordTypes; |
610 |
+ |
property DataSetCloseAction: TDataSetCloseAction |
611 |
+ |
read FDataSetCloseAction write FDataSetCloseAction; |
612 |
|
|
613 |
|
published |
614 |
|
property Database: TIBDatabase read GetDatabase write SetDatabase; |
647 |
|
write FOnUpdateRecord; |
648 |
|
end; |
649 |
|
|
650 |
< |
TIBDataSet = class(TIBCustomDataSet) |
650 |
> |
TIBParserDataSet = class(TIBCustomDataSet) |
651 |
> |
public |
652 |
> |
property Parser; |
653 |
> |
end; |
654 |
> |
|
655 |
> |
TIBDataSet = class(TIBParserDataSet) |
656 |
|
private |
657 |
|
function GetPrepared: Boolean; |
658 |
|
|
677 |
|
property QModify; |
678 |
|
property StatementType; |
679 |
|
property SelectStmtHandle; |
680 |
+ |
property BaseSQLSelect; |
681 |
|
|
682 |
|
published |
683 |
|
{ TIBCustomDataSet } |
684 |
+ |
property AutoCommit; |
685 |
|
property BufferChunks; |
686 |
|
property CachedUpdates; |
687 |
|
property DeleteSQL; |
690 |
|
property SelectSQL; |
691 |
|
property ModifySQL; |
692 |
|
property GeneratorField; |
693 |
+ |
property GenerateParamNames; |
694 |
|
property ParamCheck; |
695 |
|
property UniDirectional; |
696 |
|
property Filtered; |
697 |
+ |
property DataSetCloseAction; |
698 |
|
|
699 |
|
property BeforeDatabaseDisconnect; |
700 |
|
property AfterDatabaseDisconnect; |
730 |
|
property OnFilterRecord; |
731 |
|
property OnNewRecord; |
732 |
|
property OnPostError; |
733 |
+ |
property OnValidatePost; |
734 |
|
end; |
735 |
|
|
736 |
|
{ TIBDSBlobStream } |
737 |
|
TIBDSBlobStream = class(TStream) |
738 |
+ |
private |
739 |
+ |
FHasWritten: boolean; |
740 |
|
protected |
741 |
|
FField: TField; |
742 |
|
FBlobStream: TIBBlobStream; |
743 |
+ |
function GetSize: Int64; override; |
744 |
|
public |
745 |
|
constructor Create(AField: TField; ABlobStream: TIBBlobStream; |
746 |
|
Mode: TBlobStreamMode); |
747 |
+ |
destructor Destroy; override; |
748 |
|
function Read(var Buffer; Count: Longint): Longint; override; |
749 |
|
function Seek(Offset: Longint; Origin: Word): Longint; override; |
750 |
|
procedure SetSize(NewSize: Longint); override; |
769 |
|
TVarBytesField, { ftVarBytes } |
770 |
|
TAutoIncField, { ftAutoInc } |
771 |
|
TBlobField, { ftBlob } |
772 |
< |
TMemoField, { ftMemo } |
772 |
> |
TIBMemoField, { ftMemo } |
773 |
|
TGraphicField, { ftGraphic } |
774 |
|
TBlobField, { ftFmtMemo } |
775 |
|
TBlobField, { ftParadoxOle } |
777 |
|
TBlobField, { ftTypedBinary } |
778 |
|
nil, { ftCursor } |
779 |
|
TStringField, { ftFixedChar } |
780 |
< |
TWideStringField, { ftWideString } |
780 |
> |
TIBWideStringField, { ftWideString } |
781 |
|
TLargeIntField, { ftLargeInt } |
782 |
|
nil, { ftADT } |
783 |
|
nil, { ftArray } |
792 |
|
TDateTimeField, {ftTimestamp} |
793 |
|
TIBBCDField, {ftFMTBcd} |
794 |
|
nil, {ftFixedWideChar} |
795 |
< |
TWideMemoField); {ftWideMemo} |
795 |
> |
TIBWideMemoField); {ftWideMemo} |
796 |
|
(* |
797 |
|
TADTField, { ftADT } |
798 |
|
TArrayField, { ftArray } |
809 |
|
|
810 |
|
implementation |
811 |
|
|
812 |
< |
uses IBIntf, Variants, FmtBCD; |
812 |
> |
uses IBIntf, Variants, FmtBCD, LazUTF8; |
813 |
|
|
814 |
|
const FILE_BEGIN = 0; |
815 |
|
FILE_CURRENT = 1; |
832 |
|
NextRelation : TRelationNode; |
833 |
|
end; |
834 |
|
|
835 |
+ |
{Extended Field Def for character set info} |
836 |
|
|
837 |
< |
{ TIBStringField} |
837 |
> |
{ TIBFieldDef } |
838 |
> |
|
839 |
> |
TIBFieldDef = class(TFieldDef) |
840 |
> |
private |
841 |
> |
FCharacterSetName: RawByteString; |
842 |
> |
FCharacterSetSize: integer; |
843 |
> |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
844 |
> |
FCodePage: TSystemCodePage; |
845 |
> |
{$ENDIF} |
846 |
> |
published |
847 |
> |
property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName; |
848 |
> |
property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize; |
849 |
> |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
850 |
> |
property CodePage: TSystemCodePage read FCodePage write FCodePage; |
851 |
> |
{$ENDIF} |
852 |
> |
end; |
853 |
> |
|
854 |
> |
|
855 |
> |
{ Copied from LCLProc in order to avoid LCL dependency |
856 |
> |
|
857 |
> |
Ensures the covenient look of multiline string |
858 |
> |
when displaying it in the single line |
859 |
> |
* Replaces CR and LF with spaces |
860 |
> |
* Removes duplicate spaces |
861 |
> |
} |
862 |
> |
function TextToSingleLine(const AText: string): string; |
863 |
> |
var |
864 |
> |
str: string; |
865 |
> |
i, wstart, wlen: Integer; |
866 |
> |
begin |
867 |
> |
str := Trim(AText); |
868 |
> |
wstart := 0; |
869 |
> |
wlen := 0; |
870 |
> |
i := 1; |
871 |
> |
while i < Length(str) - 1 do |
872 |
> |
begin |
873 |
> |
if (str[i] in [' ', #13, #10]) then |
874 |
> |
begin |
875 |
> |
if (wstart = 0) then |
876 |
> |
begin |
877 |
> |
wstart := i; |
878 |
> |
wlen := 1; |
879 |
> |
end else |
880 |
> |
Inc(wlen); |
881 |
> |
end else |
882 |
> |
begin |
883 |
> |
if wstart > 0 then |
884 |
> |
begin |
885 |
> |
str[wstart] := ' '; |
886 |
> |
Delete(str, wstart+1, wlen-1); |
887 |
> |
Dec(i, wlen-1); |
888 |
> |
wstart := 0; |
889 |
> |
end; |
890 |
> |
end; |
891 |
> |
Inc(i); |
892 |
> |
end; |
893 |
> |
Result := str; |
894 |
> |
end; |
895 |
> |
|
896 |
> |
{ TIBWideMemoField } |
897 |
> |
|
898 |
> |
function TIBWideMemoField.GetTruncatedText: string; |
899 |
> |
begin |
900 |
> |
Result := GetAsString; |
901 |
> |
|
902 |
> |
if Result <> '' then |
903 |
> |
if DisplayWidth = 0 then |
904 |
> |
Result := TextToSingleLine(Result) |
905 |
> |
else |
906 |
> |
if Length(Result) > DisplayWidth then {Show truncation with elipses} |
907 |
> |
Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...'; |
908 |
> |
end; |
909 |
> |
|
910 |
> |
function TIBWideMemoField.GetDefaultWidth: Longint; |
911 |
> |
begin |
912 |
> |
Result := 128; |
913 |
> |
end; |
914 |
> |
|
915 |
> |
procedure TIBWideMemoField.GetText(var AText: string; ADisplayText: Boolean); |
916 |
> |
begin |
917 |
> |
if ADisplayText then |
918 |
> |
begin |
919 |
> |
if not DisplayTextAsClassName and (CharacterSetName<> '') then |
920 |
> |
AText := GetTruncatedText |
921 |
> |
else |
922 |
> |
inherited GetText(AText, ADisplayText); |
923 |
> |
end |
924 |
> |
else |
925 |
> |
AText := GetAsString; |
926 |
> |
end; |
927 |
> |
|
928 |
> |
constructor TIBWideMemoField.Create(AOwner: TComponent); |
929 |
> |
begin |
930 |
> |
inherited Create(AOwner); |
931 |
> |
BlobType := ftWideMemo; |
932 |
> |
end; |
933 |
> |
|
934 |
> |
{ TIBMemoField } |
935 |
> |
|
936 |
> |
function TIBMemoField.GetTruncatedText: string; |
937 |
> |
begin |
938 |
> |
Result := GetAsString; |
939 |
> |
|
940 |
> |
if Result <> '' then |
941 |
> |
begin |
942 |
> |
case CharacterSetSize of |
943 |
> |
1: |
944 |
> |
if DisplayWidth = 0 then |
945 |
> |
Result := TextToSingleLine(Result) |
946 |
> |
else |
947 |
> |
if Length(Result) > DisplayWidth then {Show truncation with elipses} |
948 |
> |
Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...'; |
949 |
> |
|
950 |
> |
{2: case 2 ignored. This should be handled by TIBWideMemo} |
951 |
> |
|
952 |
> |
3, {Assume UNICODE_FSS is really UTF8} |
953 |
> |
4: {Include GB18030 - assuming UTF8 routine work for this codeset} |
954 |
> |
if DisplayWidth = 0 then |
955 |
> |
Result := ValidUTF8String(TextToSingleLine(Result)) |
956 |
> |
else |
957 |
> |
if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses} |
958 |
> |
Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...'; |
959 |
> |
end; |
960 |
> |
end |
961 |
> |
end; |
962 |
> |
|
963 |
> |
function TIBMemoField.GetAsString: string; |
964 |
> |
var s: RawByteString; |
965 |
> |
begin |
966 |
> |
s := inherited GetAsString; |
967 |
> |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
968 |
> |
SetCodePage(s,CodePage,false); |
969 |
> |
{$ENDIF} |
970 |
> |
Result := s; |
971 |
> |
end; |
972 |
> |
|
973 |
> |
function TIBMemoField.GetDefaultWidth: Longint; |
974 |
> |
begin |
975 |
> |
if DisplayTextAsClassName then |
976 |
> |
Result := inherited |
977 |
> |
else |
978 |
> |
Result := 128; |
979 |
> |
end; |
980 |
|
|
981 |
< |
constructor TIBStringField.Create(AOwner: TComponent); |
981 |
> |
procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean); |
982 |
> |
begin |
983 |
> |
if ADisplayText then |
984 |
> |
begin |
985 |
> |
if not DisplayTextAsClassName and (CharacterSetName <> '') then |
986 |
> |
AText := GetTruncatedText |
987 |
> |
else |
988 |
> |
inherited GetText(AText, ADisplayText); |
989 |
> |
end |
990 |
> |
else |
991 |
> |
AText := GetAsString; |
992 |
> |
end; |
993 |
> |
|
994 |
> |
procedure TIBMemoField.SetAsString(const AValue: string); |
995 |
> |
var s: RawByteString; |
996 |
> |
begin |
997 |
> |
s := AValue; |
998 |
> |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
999 |
> |
if StringCodePage(Value) <> CodePage then |
1000 |
> |
SetCodePage(s,CodePage,true); |
1001 |
> |
{$ENDIF} |
1002 |
> |
inherited SetAsString(s); |
1003 |
> |
end; |
1004 |
> |
|
1005 |
> |
constructor TIBMemoField.Create(AOwner: TComponent); |
1006 |
|
begin |
1007 |
|
inherited Create(AOwner); |
1008 |
+ |
BlobType := ftMemo; |
1009 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
1010 |
+ |
FCodePage := CP_NONE; |
1011 |
+ |
{$ENDIF} |
1012 |
+ |
end; |
1013 |
+ |
|
1014 |
+ |
{ TIBControlLink } |
1015 |
+ |
|
1016 |
+ |
destructor TIBControlLink.Destroy; |
1017 |
+ |
begin |
1018 |
+ |
IBDataSet := nil; |
1019 |
+ |
inherited Destroy; |
1020 |
+ |
end; |
1021 |
+ |
|
1022 |
+ |
procedure TIBControlLink.UpdateParams(Sender: TObject); |
1023 |
+ |
begin |
1024 |
+ |
|
1025 |
+ |
end; |
1026 |
+ |
|
1027 |
+ |
procedure TIBControlLink.UpdateSQL(Sender: TObject); |
1028 |
+ |
begin |
1029 |
+ |
|
1030 |
+ |
end; |
1031 |
+ |
|
1032 |
+ |
procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet); |
1033 |
+ |
begin |
1034 |
+ |
if FTIBDataSet = AValue then Exit; |
1035 |
+ |
if IBDataSet <> nil then |
1036 |
+ |
IBDataSet.UnRegisterIBLink(self); |
1037 |
+ |
FTIBDataSet := AValue; |
1038 |
+ |
if IBDataSet <> nil then |
1039 |
+ |
IBDataSet.RegisterIBLink(self); |
1040 |
+ |
end; |
1041 |
+ |
|
1042 |
+ |
|
1043 |
+ |
{ TIBStringField} |
1044 |
+ |
|
1045 |
+ |
function TIBStringField.GetDefaultWidth: Longint; |
1046 |
+ |
begin |
1047 |
+ |
Result := Size div CharacterSetSize; |
1048 |
+ |
end; |
1049 |
+ |
|
1050 |
+ |
constructor TIBStringField.Create(aOwner: TComponent); |
1051 |
+ |
begin |
1052 |
+ |
inherited Create(aOwner); |
1053 |
+ |
FCharacterSetSize := 1; |
1054 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
1055 |
+ |
FCodePage := CP_NONE; |
1056 |
+ |
{$ENDIF} |
1057 |
|
end; |
1058 |
|
|
1059 |
|
class procedure TIBStringField.CheckTypeSize(Value: Integer); |
1076 |
|
function TIBStringField.GetValue(var Value: string): Boolean; |
1077 |
|
var |
1078 |
|
Buffer: PChar; |
1079 |
+ |
s: RawByteString; |
1080 |
|
begin |
1081 |
|
Buffer := nil; |
1082 |
|
IBAlloc(Buffer, 0, Size + 1); |
1084 |
|
Result := GetData(Buffer); |
1085 |
|
if Result then |
1086 |
|
begin |
1087 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
1088 |
+ |
s := string(Buffer); |
1089 |
+ |
SetCodePage(s,CodePage,false); |
1090 |
+ |
Value := s; |
1091 |
+ |
// writeln(FieldName,': ', StringCodePage(Value),', ',Value); |
1092 |
+ |
{$ELSE} |
1093 |
|
Value := string(Buffer); |
1094 |
+ |
{$ENDIF} |
1095 |
|
if Transliterate and (Value <> '') then |
1096 |
|
DataSet.Translate(PChar(Value), PChar(Value), False); |
1097 |
|
end |
1103 |
|
procedure TIBStringField.SetAsString(const Value: string); |
1104 |
|
var |
1105 |
|
Buffer: PChar; |
1106 |
+ |
s: RawByteString; |
1107 |
|
begin |
1108 |
|
Buffer := nil; |
1109 |
|
IBAlloc(Buffer, 0, Size + 1); |
1110 |
|
try |
1111 |
< |
StrLCopy(Buffer, PChar(Value), Size); |
1111 |
> |
s := Value; |
1112 |
> |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
1113 |
> |
if StringCodePage(s) <> CodePage then |
1114 |
> |
SetCodePage(s,CodePage,true); |
1115 |
> |
{$ENDIF} |
1116 |
> |
StrLCopy(Buffer, PChar(s), Size); |
1117 |
|
if Transliterate then |
1118 |
|
DataSet.Translate(Buffer, Buffer, True); |
1119 |
|
SetData(Buffer); |
1122 |
|
end; |
1123 |
|
end; |
1124 |
|
|
1125 |
+ |
|
1126 |
|
{ TIBBCDField } |
1127 |
|
|
1128 |
|
constructor TIBBCDField.Create(AOwner: TComponent); |
1220 |
|
CheckIBLoaded; |
1221 |
|
FIBLoaded := True; |
1222 |
|
FBase := TIBBase.Create(Self); |
1223 |
+ |
FIBLinks := TList.Create; |
1224 |
|
FCurrentRecord := -1; |
1225 |
|
FDeletedRecords := 0; |
1226 |
|
FUniDirectional := False; |
1239 |
|
FQRefresh.GoToFirstRecordOnExecute := False; |
1240 |
|
FQSelect := TIBSQL.Create(Self); |
1241 |
|
FQSelect.OnSQLChanging := SQLChanging; |
1242 |
+ |
FQSelect.OnSQLChanged := SQLChanged; |
1243 |
|
FQSelect.GoToFirstRecordOnExecute := False; |
1244 |
|
FQModify := TIBSQL.Create(Self); |
1245 |
|
FQModify.OnSQLChanging := SQLChanging; |
1246 |
|
FQModify.GoToFirstRecordOnExecute := False; |
1247 |
|
FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted]; |
1248 |
|
FParamCheck := True; |
1249 |
+ |
FGenerateParamNames := False; |
1250 |
|
FForcedRefresh := False; |
1251 |
+ |
FAutoCommit:= acDisabled; |
1252 |
+ |
FDataSetCloseAction := dcDiscardChanges; |
1253 |
|
{Bookmark Size is Integer for IBX} |
1254 |
|
BookmarkSize := SizeOf(Integer); |
1255 |
|
FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect; |
1263 |
|
else |
1264 |
|
if AOwner is TIBTransaction then |
1265 |
|
Transaction := TIBTransaction(AOwner); |
1266 |
+ |
FBaseSQLSelect := TStringList.Create; |
1267 |
|
end; |
1268 |
|
|
1269 |
|
destructor TIBCustomDataSet.Destroy; |
1275 |
|
FDataLink.Free; |
1276 |
|
FBase.Free; |
1277 |
|
ClearBlobCache; |
1278 |
+ |
ClearIBLinks; |
1279 |
+ |
FIBLinks.Free; |
1280 |
|
FBlobStreamList.Free; |
1281 |
|
FreeMem(FBufferCache); |
1282 |
|
FBufferCache := nil; |
1286 |
|
FOldCacheSize := 0; |
1287 |
|
FMappedFieldPosition := nil; |
1288 |
|
end; |
1289 |
+ |
if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free; |
1290 |
+ |
if assigned(FParser) then FParser.Free; |
1291 |
|
inherited Destroy; |
1292 |
|
end; |
1293 |
|
|
1329 |
|
|
1330 |
|
procedure TIBCustomDataSet.ApplyUpdates; |
1331 |
|
var |
1332 |
< |
{$IF FPC_FULLVERSION > 20600 } |
1332 |
> |
{$IFDEF NEW_TBOOKMARK } |
1333 |
|
CurBookmark: TBookmark; |
1334 |
|
{$ELSE} |
1335 |
|
CurBookmark: string; |
1531 |
|
end; |
1532 |
|
end; |
1533 |
|
|
1534 |
+ |
function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer; |
1535 |
+ |
var i: integer; |
1536 |
+ |
Prepared: boolean; |
1537 |
+ |
begin |
1538 |
+ |
Result := 0; |
1539 |
+ |
Prepared := FInternalPrepared; |
1540 |
+ |
if not Prepared then |
1541 |
+ |
InternalPrepare; |
1542 |
+ |
try |
1543 |
+ |
for i := 0 to Length(FAliasNameList) - 1 do |
1544 |
+ |
if FAliasNameList[i] = AliasName then |
1545 |
+ |
begin |
1546 |
+ |
Result := i + 1; |
1547 |
+ |
Exit |
1548 |
+ |
end; |
1549 |
+ |
finally |
1550 |
+ |
if not Prepared then |
1551 |
+ |
InternalUnPrepare; |
1552 |
+ |
end; |
1553 |
+ |
end; |
1554 |
+ |
|
1555 |
|
procedure TIBCustomDataSet.ActivateConnection; |
1556 |
|
begin |
1557 |
|
if not Assigned(Database) then |
1612 |
|
IBError(ibxeDatasetClosed, [nil]); |
1613 |
|
end; |
1614 |
|
|
1615 |
+ |
function TIBCustomDataSet.CreateParser: TSelectSQLParser; |
1616 |
+ |
begin |
1617 |
+ |
Result := TSelectSQLParser.Create(self,FBaseSQLSelect); |
1618 |
+ |
Result.OnSQLChanging := SQLChanging |
1619 |
+ |
end; |
1620 |
+ |
|
1621 |
|
procedure TIBCustomDataSet.CheckNotUniDirectional; |
1622 |
|
begin |
1623 |
|
if UniDirectional then |
1721 |
|
FDatabaseFree(Sender); |
1722 |
|
end; |
1723 |
|
|
1724 |
< |
procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject); |
1724 |
> |
procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject; |
1725 |
> |
Action: TTransactionAction); |
1726 |
|
begin |
1727 |
< |
if Active then |
1728 |
< |
Active := False; |
1727 |
> |
FCloseAction := Action; |
1728 |
> |
FInTransactionEnd := true; |
1729 |
> |
try |
1730 |
> |
if Active then |
1731 |
> |
Active := False; |
1732 |
> |
finally |
1733 |
> |
FInTransactionEnd := false; |
1734 |
> |
end; |
1735 |
|
if FQSelect <> nil then |
1736 |
|
FQSelect.FreeHandle; |
1737 |
|
if FQDelete <> nil then |
1769 |
|
LocalData: Pointer; |
1770 |
|
LocalDate, LocalDouble: Double; |
1771 |
|
LocalInt: Integer; |
1772 |
+ |
LocalBool: wordBool; |
1773 |
|
LocalInt64: Int64; |
1774 |
|
LocalCurrency: Currency; |
1775 |
|
FieldsLoaded: Integer; |
1914 |
|
end; |
1915 |
|
end; |
1916 |
|
end; |
1917 |
+ |
SQL_BOOLEAN: |
1918 |
+ |
begin |
1919 |
+ |
LocalBool:= false; |
1920 |
+ |
rdFields[j].fdDataSize := SizeOf(wordBool); |
1921 |
+ |
if RecordNumber >= 0 then |
1922 |
+ |
LocalBool := Qry.Current[i].AsBoolean; |
1923 |
+ |
LocalData := PChar(@LocalBool); |
1924 |
+ |
end; |
1925 |
|
else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD } |
1926 |
|
begin |
1927 |
|
rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen; |
2064 |
|
const KeyValues: Variant; Options: TLocateOptions): Boolean; |
2065 |
|
var |
2066 |
|
keyFieldList: TList; |
2067 |
< |
{$IF FPC_FULLVERSION > 20600 } |
2067 |
> |
{$IFDEF NEW_TBOOKMARK } |
2068 |
|
CurBookmark: TBookmark; |
2069 |
|
{$ELSE} |
2070 |
|
CurBookmark: string; |
2193 |
|
procedure TIBCustomDataSet.InternalRefreshRow; |
2194 |
|
var |
2195 |
|
Buff: PChar; |
1758 |
– |
SetCursor: Boolean; |
2196 |
|
ofs: DWORD; |
2197 |
|
Qry: TIBSQL; |
2198 |
|
begin |
2199 |
< |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
1763 |
< |
if SetCursor then |
1764 |
< |
Screen.Cursor := crHourGlass; |
2199 |
> |
FBase.SetCursor; |
2200 |
|
try |
2201 |
|
Buff := GetActiveBuf; |
2202 |
|
if CanRefresh then |
2240 |
|
else |
2241 |
|
IBError(ibxeCannotRefresh, [nil]); |
2242 |
|
finally |
2243 |
< |
if SetCursor and (Screen.Cursor = crHourGlass) then |
1809 |
< |
Screen.Cursor := crDefault; |
2243 |
> |
FBase.RestoreCursor; |
2244 |
|
end; |
2245 |
|
end; |
2246 |
|
|
2311 |
|
|
2312 |
|
procedure TIBCustomDataSet.InternalPrepare; |
2313 |
|
var |
1880 |
– |
SetCursor: Boolean; |
2314 |
|
DidActivate: Boolean; |
2315 |
|
begin |
2316 |
|
if FInternalPrepared then |
2317 |
|
Exit; |
2318 |
|
DidActivate := False; |
2319 |
< |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
1887 |
< |
if SetCursor then |
1888 |
< |
Screen.Cursor := crHourGlass; |
2319 |
> |
FBase.SetCursor; |
2320 |
|
try |
2321 |
|
ActivateConnection; |
2322 |
|
DidActivate := ActivateTransaction; |
2323 |
|
FBase.CheckDatabase; |
2324 |
|
FBase.CheckTransaction; |
2325 |
+ |
if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then |
2326 |
+ |
begin |
2327 |
+ |
FQSelect.OnSQLChanged := nil; {Do not react to change} |
2328 |
+ |
try |
2329 |
+ |
FQSelect.SQL.Text := FParser.SQLText; |
2330 |
+ |
finally |
2331 |
+ |
FQSelect.OnSQLChanged := SQLChanged; |
2332 |
+ |
end; |
2333 |
+ |
end; |
2334 |
+ |
// writeln( FQSelect.SQL.Text); |
2335 |
|
if FQSelect.SQL.Text <> '' then |
2336 |
|
begin |
2337 |
|
if not FQSelect.Prepared then |
2338 |
|
begin |
2339 |
+ |
FQSelect.GenerateParamNames := FGenerateParamNames; |
2340 |
|
FQSelect.ParamCheck := ParamCheck; |
2341 |
|
FQSelect.Prepare; |
2342 |
|
end; |
2343 |
+ |
FQDelete.GenerateParamNames := FGenerateParamNames; |
2344 |
|
if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then |
2345 |
|
FQDelete.Prepare; |
2346 |
+ |
FQInsert.GenerateParamNames := FGenerateParamNames; |
2347 |
|
if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then |
2348 |
|
FQInsert.Prepare; |
2349 |
+ |
FQRefresh.GenerateParamNames := FGenerateParamNames; |
2350 |
|
if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then |
2351 |
|
FQRefresh.Prepare; |
2352 |
+ |
FQModify.GenerateParamNames := FGenerateParamNames; |
2353 |
|
if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then |
2354 |
|
FQModify.Prepare; |
2355 |
|
FInternalPrepared := True; |
2359 |
|
finally |
2360 |
|
if DidActivate then |
2361 |
|
DeactivateTransaction; |
2362 |
< |
if SetCursor and (Screen.Cursor = crHourGlass) then |
1917 |
< |
Screen.Cursor := crDefault; |
2362 |
> |
FBase.RestoreCursor; |
2363 |
|
end; |
2364 |
|
end; |
2365 |
|
|
2550 |
|
SQL_TIMESTAMP: |
2551 |
|
Qry.Params[i].AsDateTime := |
2552 |
|
TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^))); |
2553 |
+ |
SQL_BOOLEAN: |
2554 |
+ |
Qry.Params[i].AsBoolean := PWordBool(data)^; |
2555 |
|
end; |
2556 |
|
end; |
2557 |
|
end; |
2637 |
|
end; |
2638 |
|
end; |
2639 |
|
|
2640 |
+ |
procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink); |
2641 |
+ |
begin |
2642 |
+ |
if FIBLinks.IndexOf(Sender) = -1 then |
2643 |
+ |
FIBLinks.Add(Sender); |
2644 |
+ |
end; |
2645 |
+ |
|
2646 |
|
|
2647 |
|
procedure TIBCustomDataSet.SQLChanging(Sender: TObject); |
2648 |
|
begin |
2649 |
< |
if FOpen then |
2650 |
< |
InternalClose; |
2649 |
> |
Active := false; |
2650 |
> |
{ if FOpen then |
2651 |
> |
InternalClose;} |
2652 |
|
if FInternalPrepared then |
2653 |
|
InternalUnPrepare; |
2654 |
+ |
FieldDefs.Clear; |
2655 |
+ |
FieldDefs.Updated := false; |
2656 |
+ |
end; |
2657 |
+ |
|
2658 |
+ |
procedure TIBCustomDataSet.SQLChanged(Sender: TObject); |
2659 |
+ |
begin |
2660 |
+ |
FBaseSQLSelect.assign(FQSelect.SQL); |
2661 |
|
end; |
2662 |
|
|
2663 |
|
{ I can "undelete" uninserted records (make them "inserted" again). |
2686 |
|
end; |
2687 |
|
end; |
2688 |
|
|
2689 |
+ |
procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink); |
2690 |
+ |
begin |
2691 |
+ |
FIBLinks.Remove(Sender); |
2692 |
+ |
end; |
2693 |
+ |
|
2694 |
|
function TIBCustomDataSet.UpdateStatus: TUpdateStatus; |
2695 |
|
begin |
2696 |
|
if Active then |
2920 |
|
inherited DoBeforeDelete; |
2921 |
|
end; |
2922 |
|
|
2923 |
+ |
procedure TIBCustomDataSet.DoAfterDelete; |
2924 |
+ |
begin |
2925 |
+ |
inherited DoAfterDelete; |
2926 |
+ |
FBase.DoAfterDelete(self); |
2927 |
+ |
InternalAutoCommit; |
2928 |
+ |
end; |
2929 |
+ |
|
2930 |
|
procedure TIBCustomDataSet.DoBeforeEdit; |
2931 |
|
var |
2932 |
|
Buff: PRecordData; |
2941 |
|
inherited DoBeforeEdit; |
2942 |
|
end; |
2943 |
|
|
2944 |
+ |
procedure TIBCustomDataSet.DoAfterEdit; |
2945 |
+ |
begin |
2946 |
+ |
inherited DoAfterEdit; |
2947 |
+ |
FBase.DoAfterEdit(self); |
2948 |
+ |
end; |
2949 |
+ |
|
2950 |
|
procedure TIBCustomDataSet.DoBeforeInsert; |
2951 |
|
begin |
2952 |
|
if not CanInsert then |
2959 |
|
if GeneratorField.ApplyOnEvent = gaeOnNewRecord then |
2960 |
|
GeneratorField.Apply; |
2961 |
|
inherited DoAfterInsert; |
2962 |
+ |
FBase.DoAfterInsert(self); |
2963 |
+ |
end; |
2964 |
+ |
|
2965 |
+ |
procedure TIBCustomDataSet.DoBeforeClose; |
2966 |
+ |
begin |
2967 |
+ |
inherited DoBeforeClose; |
2968 |
+ |
if State in [dsInsert,dsEdit] then |
2969 |
+ |
begin |
2970 |
+ |
if FInTransactionEnd and (FCloseAction = TARollback) then |
2971 |
+ |
Exit; |
2972 |
+ |
|
2973 |
+ |
if DataSetCloseAction = dcSaveChanges then |
2974 |
+ |
Post; |
2975 |
+ |
{Note this can fail with an exception e.g. due to |
2976 |
+ |
database validation error. In which case the dataset remains open } |
2977 |
+ |
end; |
2978 |
+ |
end; |
2979 |
+ |
|
2980 |
+ |
procedure TIBCustomDataSet.DoBeforeOpen; |
2981 |
+ |
var i: integer; |
2982 |
+ |
begin |
2983 |
+ |
if assigned(FParser) then |
2984 |
+ |
FParser.Reset; |
2985 |
+ |
for i := 0 to FIBLinks.Count - 1 do |
2986 |
+ |
TIBControlLink(FIBLinks[i]).UpdateSQL(self); |
2987 |
+ |
inherited DoBeforeOpen; |
2988 |
+ |
for i := 0 to FIBLinks.Count - 1 do |
2989 |
+ |
TIBControlLink(FIBLinks[i]).UpdateParams(self); |
2990 |
|
end; |
2991 |
|
|
2992 |
|
procedure TIBCustomDataSet.DoBeforePost; |
2997 |
|
GeneratorField.Apply |
2998 |
|
end; |
2999 |
|
|
3000 |
+ |
procedure TIBCustomDataSet.DoAfterPost; |
3001 |
+ |
begin |
3002 |
+ |
inherited DoAfterPost; |
3003 |
+ |
FBase.DoAfterPost(self); |
3004 |
+ |
InternalAutoCommit; |
3005 |
+ |
end; |
3006 |
+ |
|
3007 |
|
procedure TIBCustomDataSet.FetchAll; |
3008 |
|
var |
3009 |
< |
SetCursor: Boolean; |
2496 |
< |
{$IF FPC_FULLVERSION > 20600 } |
3009 |
> |
{$IFDEF NEW_TBOOKMARK } |
3010 |
|
CurBookmark: TBookmark; |
3011 |
|
{$ELSE} |
3012 |
|
CurBookmark: string; |
3013 |
|
{$ENDIF} |
3014 |
|
begin |
3015 |
< |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
3016 |
< |
if SetCursor then |
2504 |
< |
Screen.Cursor := crHourGlass; |
2505 |
< |
try |
3015 |
> |
FBase.SetCursor; |
3016 |
> |
try |
3017 |
|
if FQSelect.EOF or not FQSelect.Open then |
3018 |
|
exit; |
3019 |
|
DisableControls; |
3025 |
|
EnableControls; |
3026 |
|
end; |
3027 |
|
finally |
3028 |
< |
if SetCursor and (Screen.Cursor = crHourGlass) then |
2518 |
< |
Screen.Cursor := crDefault; |
3028 |
> |
FBase.RestoreCursor; |
3029 |
|
end; |
3030 |
|
end; |
3031 |
|
|
3073 |
|
result := FDataLink.DataSource; |
3074 |
|
end; |
3075 |
|
|
3076 |
+ |
function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string; |
3077 |
+ |
begin |
3078 |
+ |
Result := FAliasNameMap[FieldNo-1] |
3079 |
+ |
end; |
3080 |
+ |
|
3081 |
+ |
function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef; |
3082 |
+ |
var |
3083 |
+ |
i: integer; |
3084 |
+ |
begin |
3085 |
+ |
Result := nil; |
3086 |
+ |
for i := 0 to Length(FAliasNameMap) - 1 do |
3087 |
+ |
if FAliasNameMap[i] = aliasName then |
3088 |
+ |
begin |
3089 |
+ |
Result := FieldDefs[i]; |
3090 |
+ |
Exit |
3091 |
+ |
end; |
3092 |
+ |
end; |
3093 |
+ |
|
3094 |
|
function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass; |
3095 |
|
begin |
3096 |
|
Result := DefaultFieldClasses[FieldType]; |
3131 |
|
Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs; |
3132 |
|
if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then |
3133 |
|
begin |
3134 |
< |
if fdDataLength <= Field.Size then |
3134 |
> |
if fdDataLength < Field.DataSize then |
3135 |
|
begin |
3136 |
|
Move(Data^, Buffer^, fdDataLength); |
3137 |
|
PChar(Buffer)[fdDataLength] := #0; |
3180 |
|
if not Accept and (GetMode = gmCurrent) then |
3181 |
|
GetMode := gmPrior; |
3182 |
|
except |
3183 |
< |
// Application.HandleException(Self); |
3183 |
> |
// FBase.HandleException(Self); |
3184 |
|
end; |
3185 |
|
end; |
3186 |
|
RestoreState(SaveState); |
3274 |
|
result := FRecordBufferSize; |
3275 |
|
end; |
3276 |
|
|
3277 |
+ |
procedure TIBCustomDataSet.InternalAutoCommit; |
3278 |
+ |
begin |
3279 |
+ |
with Transaction do |
3280 |
+ |
if InTransaction and (FAutoCommit = acCommitRetaining) then |
3281 |
+ |
begin |
3282 |
+ |
if CachedUpdates then ApplyUpdates; |
3283 |
+ |
CommitRetaining; |
3284 |
+ |
end; |
3285 |
+ |
end; |
3286 |
+ |
|
3287 |
|
procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean); |
3288 |
|
begin |
3289 |
|
CheckEditState; |
3355 |
|
FreeMem(FOldBufferCache); |
3356 |
|
FOldBufferCache := nil; |
3357 |
|
BindFields(False); |
3358 |
+ |
ResetParser; |
3359 |
|
if DefaultFields then DestroyFields; |
3360 |
|
end; |
3361 |
|
|
3362 |
|
procedure TIBCustomDataSet.InternalDelete; |
3363 |
|
var |
3364 |
|
Buff: PChar; |
2826 |
– |
SetCursor: Boolean; |
3365 |
|
begin |
3366 |
< |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
2829 |
< |
if SetCursor then |
2830 |
< |
Screen.Cursor := crHourGlass; |
3366 |
> |
FBase.SetCursor; |
3367 |
|
try |
3368 |
|
Buff := GetActiveBuf; |
3369 |
|
if CanDelete then |
3388 |
|
end else |
3389 |
|
IBError(ibxeCannotDelete, [nil]); |
3390 |
|
finally |
3391 |
< |
if SetCursor and (Screen.Cursor = crHourGlass) then |
2856 |
< |
Screen.Cursor := crDefault; |
3391 |
> |
FBase.RestoreCursor; |
3392 |
|
end; |
3393 |
|
end; |
3394 |
|
|
3404 |
|
|
3405 |
|
procedure TIBCustomDataSet.InternalHandleException; |
3406 |
|
begin |
3407 |
< |
Application.HandleException(Self) |
3407 |
> |
FBase.HandleException(Self) |
3408 |
|
end; |
3409 |
|
|
3410 |
|
procedure TIBCustomDataSet.InternalInitFieldDefs; |
3411 |
+ |
begin |
3412 |
+ |
if not InternalPrepared then |
3413 |
+ |
begin |
3414 |
+ |
InternalPrepare; |
3415 |
+ |
exit; |
3416 |
+ |
end; |
3417 |
+ |
FieldDefsFromQuery(FQSelect); |
3418 |
+ |
end; |
3419 |
+ |
|
3420 |
+ |
procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL); |
3421 |
|
const |
3422 |
|
DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize} |
3423 |
|
'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize} |
3429 |
|
var |
3430 |
|
FieldType: TFieldType; |
3431 |
|
FieldSize: Word; |
3432 |
+ |
charSetID: short; |
3433 |
+ |
CharSetSize: integer; |
3434 |
+ |
CharSetName: RawByteString; |
3435 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
3436 |
+ |
FieldCodePage: TSystemCodePage; |
3437 |
+ |
{$ENDIF} |
3438 |
|
FieldNullable : Boolean; |
3439 |
|
i, FieldPosition, FieldPrecision: Integer; |
3440 |
< |
FieldAliasName: string; |
3440 |
> |
FieldAliasName, DBAliasName: string; |
3441 |
|
RelationName, FieldName: string; |
3442 |
|
Query : TIBSQL; |
3443 |
|
FieldIndex: Integer; |
3537 |
|
end; |
3538 |
|
|
3539 |
|
begin |
2989 |
– |
if not InternalPrepared then |
2990 |
– |
begin |
2991 |
– |
InternalPrepare; |
2992 |
– |
exit; |
2993 |
– |
end; |
3540 |
|
FRelationNodes := TRelationNode.Create; |
3541 |
|
FNeedsRefresh := False; |
3542 |
|
Database.InternalTransaction.StartTransaction; |
3547 |
|
FieldDefs.BeginUpdate; |
3548 |
|
FieldDefs.Clear; |
3549 |
|
FieldIndex := 0; |
3550 |
< |
if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then |
3551 |
< |
SetLength(FMappedFieldPosition, FQSelect.Current.Count); |
3550 |
> |
if (Length(FMappedFieldPosition) < SourceQuery.Current.Count) then |
3551 |
> |
SetLength(FMappedFieldPosition, SourceQuery.Current.Count); |
3552 |
|
Query.SQL.Text := DefaultSQL; |
3553 |
|
Query.Prepare; |
3554 |
< |
for i := 0 to FQSelect.Current.Count - 1 do |
3555 |
< |
with FQSelect.Current[i].Data^ do |
3554 |
> |
SetLength(FAliasNameMap, SourceQuery.Current.Count); |
3555 |
> |
SetLength(FAliasNameList, SourceQuery.Current.Count); |
3556 |
> |
for i := 0 to SourceQuery.Current.Count - 1 do |
3557 |
> |
with SourceQuery.Current[i].Data^ do |
3558 |
|
begin |
3559 |
|
{ Get the field name } |
3560 |
< |
SetString(FieldAliasName, aliasname, aliasname_length); |
3560 |
> |
FieldAliasName := SourceQuery.Current[i].Name; |
3561 |
> |
SetString(DBAliasName, aliasname, aliasname_length); |
3562 |
|
SetString(RelationName, relname, relname_length); |
3563 |
|
SetString(FieldName, sqlname, sqlname_length); |
3564 |
+ |
FAliasNameList[i] := DBAliasName; |
3565 |
|
FieldSize := 0; |
3566 |
|
FieldPrecision := 0; |
3567 |
< |
FieldNullable := FQSelect.Current[i].IsNullable; |
3567 |
> |
FieldNullable := SourceQuery.Current[i].IsNullable; |
3568 |
> |
CharSetSize := 0; |
3569 |
> |
CharSetName := ''; |
3570 |
> |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
3571 |
> |
FieldCodePage := CP_NONE; |
3572 |
> |
{$ENDIF} |
3573 |
|
case sqltype and not 1 of |
3574 |
|
{ All VARCHAR's must be converted to strings before recording |
3575 |
|
their values } |
3576 |
|
SQL_VARYING, SQL_TEXT: |
3577 |
|
begin |
3578 |
+ |
CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF); |
3579 |
+ |
CharSetName := FBase.GetCharSetName(sqlsubtype and $FF); |
3580 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
3581 |
+ |
FieldCodePage := FBase.GetCodePage(sqlsubtype and $FF); |
3582 |
+ |
{$ENDIF} |
3583 |
+ |
{FieldSize is encoded for strings - see TIBStringField.SetSize for decode} |
3584 |
|
FieldSize := sqllen; |
3585 |
< |
FieldType := ftString; |
3585 |
> |
if CharSetSize = 2 then |
3586 |
> |
FieldType := ftWideString |
3587 |
> |
else |
3588 |
> |
FieldType := ftString; |
3589 |
|
end; |
3590 |
|
{ All Doubles/Floats should be cast to doubles } |
3591 |
|
SQL_DOUBLE, SQL_FLOAT: |
3644 |
|
begin |
3645 |
|
FieldSize := sizeof (TISC_QUAD); |
3646 |
|
if (sqlsubtype = 1) then |
3647 |
< |
FieldType := ftmemo |
3647 |
> |
begin |
3648 |
> |
if FBase.GetDefaultCharSetName <> '' then |
3649 |
> |
begin |
3650 |
> |
CharSetSize := FBase.GetDefaultCharSetSize; |
3651 |
> |
CharSetName := FBase.GetDefaultCharSetName; |
3652 |
> |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
3653 |
> |
FieldCodePage := FBase.GetDefaultCodePage; |
3654 |
> |
{$ENDIF} |
3655 |
> |
end |
3656 |
> |
else |
3657 |
> |
if strpas(sqlname) <> '' then |
3658 |
> |
begin |
3659 |
> |
charSetID := GetBlobCharSetID(Database.Handle,Database.InternalTransaction.Handle, |
3660 |
> |
@relname,@sqlname); |
3661 |
> |
CharSetSize := FBase.GetCharSetSize(charSetID); |
3662 |
> |
CharSetName := FBase.GetCharSetName(charSetID); |
3663 |
> |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
3664 |
> |
FieldCodePage := FBase.GetCodePage(charSetID); |
3665 |
> |
{$ENDIF} |
3666 |
> |
end |
3667 |
> |
else {Complex SQL with no identifiable column and no connection default} |
3668 |
> |
begin |
3669 |
> |
CharSetName := ''; |
3670 |
> |
CharSetSize := 1; |
3671 |
> |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
3672 |
> |
FieldCodePage := CP_NONE; |
3673 |
> |
{$ENDIF} |
3674 |
> |
end; |
3675 |
> |
if CharSetSize = 2 then |
3676 |
> |
FieldType := ftWideMemo |
3677 |
> |
else |
3678 |
> |
FieldType := ftMemo; |
3679 |
> |
end |
3680 |
|
else |
3681 |
|
FieldType := ftBlob; |
3682 |
|
end; |
3685 |
|
FieldSize := sizeof (TISC_QUAD); |
3686 |
|
FieldType := ftUnknown; |
3687 |
|
end; |
3688 |
+ |
SQL_BOOLEAN: |
3689 |
+ |
FieldType:= ftBoolean; |
3690 |
|
else |
3691 |
|
FieldType := ftUnknown; |
3692 |
|
end; |
3695 |
|
begin |
3696 |
|
FMappedFieldPosition[FieldIndex] := FieldPosition; |
3697 |
|
Inc(FieldIndex); |
3698 |
< |
with FieldDefs.AddFieldDef do |
3698 |
> |
with TIBFieldDef.Create(FieldDefs,'',FieldType,0,False,FieldDefs.Count+1) do |
3699 |
|
begin |
3700 |
|
Name := FieldAliasName; |
3701 |
< |
(* FieldNo := FieldPosition;*) |
3104 |
< |
DataType := FieldType; |
3701 |
> |
FAliasNameMap[FieldNo-1] := DBAliasName; |
3702 |
|
Size := FieldSize; |
3703 |
|
Precision := FieldPrecision; |
3704 |
|
Required := not FieldNullable; |
3705 |
|
InternalCalcField := False; |
3706 |
+ |
CharacterSetSize := CharSetSize; |
3707 |
+ |
CharacterSetName := CharSetName; |
3708 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
3709 |
+ |
CodePage := FieldCodePage; |
3710 |
+ |
{$ENDIF} |
3711 |
|
if (FieldName <> '') and (RelationName <> '') then |
3712 |
|
begin |
3713 |
|
if Has_COMPUTED_BLR(RelationName, FieldName) then |
3787 |
|
else case cur_field.DataType of |
3788 |
|
ftString: |
3789 |
|
cur_param.AsString := cur_field.AsString; |
3790 |
< |
ftBoolean, ftSmallint, ftWord: |
3790 |
> |
ftBoolean: |
3791 |
> |
cur_param.AsBoolean := cur_field.AsBoolean; |
3792 |
> |
ftSmallint, ftWord: |
3793 |
|
cur_param.AsShort := cur_field.AsInteger; |
3794 |
|
ftInteger: |
3795 |
|
cur_param.AsLong := cur_field.AsInteger; |
3842 |
|
end; |
3843 |
|
|
3844 |
|
procedure TIBCustomDataSet.InternalOpen; |
3241 |
– |
var |
3242 |
– |
SetCursor: Boolean; |
3845 |
|
|
3846 |
|
function RecordDataLength(n: Integer): Long; |
3847 |
|
begin |
3848 |
|
result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData)); |
3849 |
|
end; |
3850 |
|
|
3851 |
+ |
function GetFieldDef(aFieldNo: integer): TIBFieldDef; |
3852 |
+ |
var i: integer; |
3853 |
+ |
begin |
3854 |
+ |
Result := nil; |
3855 |
+ |
for i := 0 to FieldDefs.Count - 1 do |
3856 |
+ |
if FieldDefs[i].FieldNo = aFieldNo then |
3857 |
+ |
begin |
3858 |
+ |
Result := TIBFieldDef(FieldDefs[i]); |
3859 |
+ |
break; |
3860 |
+ |
end; |
3861 |
+ |
end; |
3862 |
+ |
|
3863 |
+ |
procedure SetExtendedProperties; |
3864 |
+ |
var i: integer; |
3865 |
+ |
IBFieldDef: TIBFieldDef; |
3866 |
+ |
begin |
3867 |
+ |
for i := 0 to Fields.Count - 1 do |
3868 |
+ |
if Fields[i].FieldNo > 0 then |
3869 |
+ |
begin |
3870 |
+ |
if(Fields[i] is TIBStringField) then |
3871 |
+ |
with TIBStringField(Fields[i]) do |
3872 |
+ |
begin |
3873 |
+ |
IBFieldDef := GetFieldDef(FieldNo); |
3874 |
+ |
if IBFieldDef <> nil then |
3875 |
+ |
begin |
3876 |
+ |
CharacterSetSize := IBFieldDef.CharacterSetSize; |
3877 |
+ |
CharacterSetName := IBFieldDef.CharacterSetName; |
3878 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
3879 |
+ |
CodePage := IBFieldDef.CodePage; |
3880 |
+ |
{$ENDIF} |
3881 |
+ |
end; |
3882 |
+ |
end |
3883 |
+ |
else |
3884 |
+ |
if(Fields[i] is TIBWideStringField) then |
3885 |
+ |
with TIBWideStringField(Fields[i]) do |
3886 |
+ |
begin |
3887 |
+ |
IBFieldDef := GetFieldDef(FieldNo); |
3888 |
+ |
if IBFieldDef <> nil then |
3889 |
+ |
begin |
3890 |
+ |
CharacterSetSize := IBFieldDef.CharacterSetSize; |
3891 |
+ |
CharacterSetName := IBFieldDef.CharacterSetName; |
3892 |
+ |
end; |
3893 |
+ |
end |
3894 |
+ |
else |
3895 |
+ |
if(Fields[i] is TIBMemoField) then |
3896 |
+ |
with TIBMemoField(Fields[i]) do |
3897 |
+ |
begin |
3898 |
+ |
IBFieldDef := GetFieldDef(FieldNo); |
3899 |
+ |
if IBFieldDef <> nil then |
3900 |
+ |
begin |
3901 |
+ |
CharacterSetSize := IBFieldDef.CharacterSetSize; |
3902 |
+ |
CharacterSetName := IBFieldDef.CharacterSetName; |
3903 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
3904 |
+ |
CodePage := IBFieldDef.CodePage; |
3905 |
+ |
{$ENDIF} |
3906 |
+ |
end; |
3907 |
+ |
end |
3908 |
+ |
else |
3909 |
+ |
if(Fields[i] is TIBWideMemoField) then |
3910 |
+ |
with TIBWideMemoField(Fields[i]) do |
3911 |
+ |
begin |
3912 |
+ |
IBFieldDef := GetFieldDef(FieldNo); |
3913 |
+ |
if IBFieldDef <> nil then |
3914 |
+ |
begin |
3915 |
+ |
CharacterSetSize := IBFieldDef.CharacterSetSize; |
3916 |
+ |
CharacterSetName := IBFieldDef.CharacterSetName; |
3917 |
+ |
end; |
3918 |
+ |
end |
3919 |
+ |
end |
3920 |
+ |
end; |
3921 |
+ |
|
3922 |
|
begin |
3923 |
< |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
3251 |
< |
if SetCursor then |
3252 |
< |
Screen.Cursor := crHourGlass; |
3923 |
> |
FBase.SetCursor; |
3924 |
|
try |
3925 |
|
ActivateConnection; |
3926 |
|
ActivateTransaction; |
3933 |
|
if DefaultFields then |
3934 |
|
CreateFields; |
3935 |
|
BindFields(True); |
3936 |
+ |
SetExtendedProperties; |
3937 |
|
FCurrentRecord := -1; |
3938 |
|
FQSelect.ExecQuery; |
3939 |
|
FOpen := FQSelect.Open; |
3982 |
|
else |
3983 |
|
FQSelect.ExecQuery; |
3984 |
|
finally |
3985 |
< |
if SetCursor and (Screen.Cursor = crHourGlass) then |
3314 |
< |
Screen.Cursor := crDefault; |
3985 |
> |
FBase.RestoreCursor; |
3986 |
|
end; |
3987 |
|
end; |
3988 |
|
|
3990 |
|
var |
3991 |
|
Qry: TIBSQL; |
3992 |
|
Buff: PChar; |
3322 |
– |
SetCursor: Boolean; |
3993 |
|
bInserting: Boolean; |
3994 |
|
begin |
3995 |
< |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
3326 |
< |
if SetCursor then |
3327 |
< |
Screen.Cursor := crHourGlass; |
3995 |
> |
FBase.SetCursor; |
3996 |
|
try |
3997 |
|
Buff := GetActiveBuf; |
3998 |
|
CheckEditState; |
4030 |
|
if bInserting then |
4031 |
|
Inc(FRecordCount); |
4032 |
|
finally |
4033 |
< |
if SetCursor and (Screen.Cursor = crHourGlass) then |
3366 |
< |
Screen.Cursor := crDefault; |
4033 |
> |
FBase.RestoreCursor; |
4034 |
|
end; |
4035 |
|
end; |
4036 |
|
|
4050 |
|
result := FOpen; |
4051 |
|
end; |
4052 |
|
|
4053 |
+ |
procedure TIBCustomDataSet.Loaded; |
4054 |
+ |
begin |
4055 |
+ |
if assigned(FQSelect) then |
4056 |
+ |
FBaseSQLSelect.assign(FQSelect.SQL); |
4057 |
+ |
inherited Loaded; |
4058 |
+ |
end; |
4059 |
+ |
|
4060 |
+ |
procedure TIBCustomDataSet.Post; |
4061 |
+ |
var CancelPost: boolean; |
4062 |
+ |
begin |
4063 |
+ |
CancelPost := false; |
4064 |
+ |
if assigned(FOnValidatePost) then |
4065 |
+ |
OnValidatePost(self,CancelPost); |
4066 |
+ |
if CancelPost then |
4067 |
+ |
Cancel |
4068 |
+ |
else |
4069 |
+ |
inherited Post; |
4070 |
+ |
end; |
4071 |
+ |
|
4072 |
|
function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant; |
4073 |
|
Options: TLocateOptions): Boolean; |
4074 |
|
var |
4075 |
< |
{$IF FPC_FULLVERSION > 20600 } |
4075 |
> |
{$IFDEF NEW_TBOOKMARK } |
4076 |
|
CurBookmark: TBookmark; |
4077 |
|
{$ELSE} |
4078 |
|
CurBookmark: string; |
4094 |
|
const ResultFields: string): Variant; |
4095 |
|
var |
4096 |
|
fl: TList; |
4097 |
< |
{$IF FPC_FULLVERSION > 20600 } |
4097 |
> |
{$IFDEF NEW_TBOOKMARK } |
4098 |
|
CurBookmark: TBookmark; |
4099 |
|
{$ELSE} |
4100 |
|
CurBookmark: string; |
4151 |
|
procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer); |
4152 |
|
var |
4153 |
|
Buff, TmpBuff: PChar; |
4154 |
+ |
MappedFieldPos: integer; |
4155 |
|
begin |
4156 |
|
Buff := GetActiveBuf; |
4157 |
|
if Field.FieldNo < 0 then |
4168 |
|
begin |
4169 |
|
{ If inserting, Adjust record position } |
4170 |
|
AdjustRecordOnInsert(Buff); |
4171 |
< |
if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and |
4172 |
< |
(FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then |
4171 |
> |
MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1]; |
4172 |
> |
if (MappedFieldPos > 0) and |
4173 |
> |
(MappedFieldPos <= rdFieldCount) then |
4174 |
|
begin |
4175 |
|
Field.Validate(Buffer); |
4176 |
|
if (Buffer = nil) or |
4177 |
|
(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then |
4178 |
< |
rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True |
4178 |
> |
rdFields[MappedFieldPos].fdIsNull := True |
4179 |
|
else begin |
4180 |
< |
Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs], |
4181 |
< |
rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize); |
4182 |
< |
if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or |
4183 |
< |
(rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then |
4184 |
< |
rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer)); |
4185 |
< |
rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False; |
4180 |
> |
Move(Buffer^, Buff[rdFields[MappedFieldPos].fdDataOfs], |
4181 |
> |
rdFields[MappedFieldPos].fdDataSize); |
4182 |
> |
if (rdFields[MappedFieldPos].fdDataType = SQL_TEXT) or |
4183 |
> |
(rdFields[MappedFieldPos].fdDataType = SQL_VARYING) then |
4184 |
> |
rdFields[MappedFieldPos].fdDataLength := StrLen(PChar(Buffer)); |
4185 |
> |
rdFields[MappedFieldPos].fdIsNull := False; |
4186 |
|
if rdUpdateStatus = usUnmodified then |
4187 |
|
begin |
4188 |
|
if CachedUpdates then |
4270 |
|
FillChar(Buffer[FRecordSize], CalcFieldsSize, 0); |
4271 |
|
end; |
4272 |
|
|
4273 |
+ |
procedure TIBCustomDataSet.ClearIBLinks; |
4274 |
+ |
var i: integer; |
4275 |
+ |
begin |
4276 |
+ |
for i := FIBLinks.Count - 1 downto 0 do |
4277 |
+ |
TIBControlLink(FIBLinks[i]).IBDataSet := nil; |
4278 |
+ |
end; |
4279 |
+ |
|
4280 |
|
|
4281 |
|
procedure TIBCustomDataSet.InternalUnPrepare; |
4282 |
|
begin |
4284 |
|
begin |
4285 |
|
CheckDatasetClosed; |
4286 |
|
FieldDefs.Clear; |
4287 |
+ |
FieldDefs.Updated := false; |
4288 |
|
FInternalPrepared := False; |
4289 |
+ |
Setlength(FAliasNameList,0); |
4290 |
|
end; |
4291 |
|
end; |
4292 |
|
|
4293 |
|
procedure TIBCustomDataSet.InternalExecQuery; |
4294 |
|
var |
4295 |
|
DidActivate: Boolean; |
3599 |
– |
SetCursor: Boolean; |
4296 |
|
begin |
4297 |
|
DidActivate := False; |
4298 |
< |
SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault); |
3603 |
< |
if SetCursor then |
3604 |
< |
Screen.Cursor := crHourGlass; |
4298 |
> |
FBase.SetCursor; |
4299 |
|
try |
4300 |
|
ActivateConnection; |
4301 |
|
DidActivate := ActivateTransaction; |
4312 |
|
finally |
4313 |
|
if DidActivate then |
4314 |
|
DeactivateTransaction; |
4315 |
< |
if SetCursor and (Screen.Cursor = crHourGlass) then |
3622 |
< |
Screen.Cursor := crDefault; |
4315 |
> |
FBase.RestoreCursor; |
4316 |
|
end; |
4317 |
|
end; |
4318 |
|
|
4321 |
|
Result := FQSelect.Handle; |
4322 |
|
end; |
4323 |
|
|
4324 |
+ |
function TIBCustomDataSet.GetParser: TSelectSQLParser; |
4325 |
+ |
begin |
4326 |
+ |
if not assigned(FParser) then |
4327 |
+ |
FParser := CreateParser; |
4328 |
+ |
Result := FParser |
4329 |
+ |
end; |
4330 |
+ |
|
4331 |
+ |
procedure TIBCustomDataSet.ResetParser; |
4332 |
+ |
begin |
4333 |
+ |
if assigned(FParser) then |
4334 |
+ |
begin |
4335 |
+ |
FParser.Free; |
4336 |
+ |
FParser := nil; |
4337 |
+ |
FQSelect.OnSQLChanged := nil; {Do not react to change} |
4338 |
+ |
try |
4339 |
+ |
FQSelect.SQL.Assign(FBaseSQLSelect); |
4340 |
+ |
finally |
4341 |
+ |
FQSelect.OnSQLChanged := SQLChanged; |
4342 |
+ |
end; |
4343 |
+ |
end; |
4344 |
+ |
end; |
4345 |
+ |
|
4346 |
+ |
function TIBCustomDataSet.HasParser: boolean; |
4347 |
+ |
begin |
4348 |
+ |
Result := not (csDesigning in ComponentState) and (FParser <> nil) |
4349 |
+ |
end; |
4350 |
+ |
|
4351 |
+ |
procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean); |
4352 |
+ |
begin |
4353 |
+ |
if FGenerateParamNames = AValue then Exit; |
4354 |
+ |
FGenerateParamNames := AValue; |
4355 |
+ |
Disconnect |
4356 |
+ |
end; |
4357 |
+ |
|
4358 |
|
procedure TIBCustomDataSet.InitRecord(Buffer: PChar); |
4359 |
|
begin |
4360 |
|
inherited InitRecord(Buffer); |
4678 |
|
DataSet.SetInternalSQLParams(Query, buff); |
4679 |
|
end; |
4680 |
|
|
4681 |
+ |
function TIBDSBlobStream.GetSize: Int64; |
4682 |
+ |
begin |
4683 |
+ |
Result := FBlobStream.BlobSize; |
4684 |
+ |
end; |
4685 |
+ |
|
4686 |
|
{ TIBDSBlobStream } |
4687 |
|
constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream; |
4688 |
|
Mode: TBlobStreamMode); |
4691 |
|
FBlobStream := ABlobStream; |
4692 |
|
FBlobStream.Seek(0, soFromBeginning); |
4693 |
|
if (Mode = bmWrite) then |
4694 |
+ |
begin |
4695 |
|
FBlobStream.Truncate; |
4696 |
+ |
TIBCustomDataSet(FField.DataSet).RecordModified(True); |
4697 |
+ |
TBlobField(FField).Modified := true; |
4698 |
+ |
FHasWritten := true; |
4699 |
+ |
end; |
4700 |
+ |
end; |
4701 |
+ |
|
4702 |
+ |
destructor TIBDSBlobStream.Destroy; |
4703 |
+ |
begin |
4704 |
+ |
if FHasWritten then |
4705 |
+ |
TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField)); |
4706 |
+ |
inherited Destroy; |
4707 |
|
end; |
4708 |
|
|
4709 |
|
function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint; |
4728 |
|
TIBCustomDataSet(FField.DataSet).RecordModified(True); |
4729 |
|
TBlobField(FField).Modified := true; |
4730 |
|
result := FBlobStream.Write(Buffer, Count); |
4731 |
< |
TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField)); |
4731 |
> |
FHasWritten := true; |
4732 |
> |
{ TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField)); |
4733 |
> |
Removed as this caused a seek to beginning of the blob stream thus corrupting |
4734 |
> |
the blob stream. Moved to the destructor i.e. called after blob written} |
4735 |
|
end; |
4736 |
|
|
4737 |
|
{ TIBGenerator } |
4778 |
|
|
4779 |
|
procedure TIBGenerator.Apply; |
4780 |
|
begin |
4781 |
< |
if (FGeneratorName <> '') and (FFieldName <> '') then |
4781 |
> |
if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then |
4782 |
|
Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction); |
4783 |
|
end; |
4784 |
|
|
4785 |
+ |
|
4786 |
|
end. |