ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/runtime/IBCustomDataSet.pas

Comparing ibx/trunk/runtime/IBCustomDataSet.pas (file contents):
Revision 33 by tony, Sat Jul 18 12:30:52 2015 UTC vs.
Revision 41 by tony, Sat Jul 16 12:25:48 2016 UTC

#	Line 33 | Line 33
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}
#	Line 120 | Line 126 | type
126
127		TIBStringField = class(TStringField)
128		private
129	<	FInitialised: boolean;
129	>	FCharacterSetName: RawByteString;
130	>	FCharacterSetSize: integer;
131		protected
132	<	procedure SetSize(AValue: Integer); override;
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 }
#	Line 152 | Line 178 | type
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;
#	Line 341 | Line 418 | type
418		procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
419		procedure SetUniDirectional(Value: Boolean);
420		procedure RefreshParams;
344	–	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;
#	Line 371 | Line 447 | type
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;
#	Line 502 | Line 580 | type
580		procedure RecordModified(Value: Boolean);
581		procedure RevertRecord;
582		procedure Undelete;
583	<	procedure ResetParser;
583	>	procedure ResetParser; virtual;
584		function HasParser: boolean;
585
586		{ TDataSet support methods }
#	Line 662 | Line 740 | type
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);
#	Line 690 | Line 769 | DefaultFieldClasses: array[TFieldType] o
769		TVarBytesField,     { ftVarBytes }
770		TAutoIncField,      { ftAutoInc }
771		TBlobField,         { ftBlob }
772	<	TMemoField,         { ftMemo }
772	>	TIBMemoField,       { ftMemo }
773		TGraphicField,      { ftGraphic }
774		TBlobField,         { ftFmtMemo }
775		TBlobField,         { ftParadoxOle }
#	Line 698 | Line 777 | DefaultFieldClasses: array[TFieldType] o
777		TBlobField,         { ftTypedBinary }
778		nil,                { ftCursor }
779		TStringField,       { ftFixedChar }
780	<	TWideStringField,    { ftWideString }
780	>	TIBWideStringField,    { ftWideString }
781		TLargeIntField,     { ftLargeInt }
782		nil,          { ftADT }
783		nil,        { ftArray }
#	Line 713 | Line 792 | DefaultFieldClasses: array[TFieldType] o
792		TDateTimeField,    {ftTimestamp}
793		TIBBCDField,       {ftFMTBcd}
794		nil,  {ftFixedWideChar}
795	<	TWideMemoField);   {ftWideMemo}
795	>	TIBWideMemoField);   {ftWideMemo}
796		(*
797		TADTField,          { ftADT }
798		TArrayField,        { ftArray }
#	Line 730 | Line 809 | DefaultFieldClasses: array[TFieldType] o
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;
#	Line 753 | Line 832 | type
832		NextRelation : TRelationNode;
833		end;
834
835	+	{Extended Field Def for character set info}
836	+
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	+	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;
#	Line 784 | Line 1042 | end;
1042
1043		{ TIBStringField}
1044
1045	<	constructor TIBStringField.create(AOwner: TComponent);
1045	>	function TIBStringField.GetDefaultWidth: Longint;
1046		begin
1047	<	inherited Create(AOwner);
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);
#	Line 809 | Line 1076 | end;
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);
#	Line 816 | Line 1084 | begin
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
#	Line 828 | Line 1103 | 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);
#	Line 841 | Line 1122 | begin
1122		end;
1123		end;
1124
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;
1125
1126		{ TIBBCDField }
1127
#	Line 974 | Line 1239 | begin
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;
#	Line 1063 | Line 1329 | end;
1329
1330		procedure TIBCustomDataSet.ApplyUpdates;
1331		var
1332	<	{$IF FPC_FULLVERSION >= 20700 }
1332	>	{$IFDEF NEW_TBOOKMARK }
1333		CurBookmark: TBookmark;
1334		{$ELSE}
1335		CurBookmark: string;
#	Line 1798 | Line 2064 | function TIBCustomDataSet.InternalLocate
2064		const KeyValues: Variant; Options: TLocateOptions): Boolean;
2065		var
2066		keyFieldList: TList;
2067	<	{$IF FPC_FULLVERSION >= 20700 }
2067	>	{$IFDEF NEW_TBOOKMARK }
2068		CurBookmark: TBookmark;
2069		{$ELSE}
2070		CurBookmark: string;
#	Line 2057 | Line 2323 | begin
2323		FBase.CheckDatabase;
2324		FBase.CheckTransaction;
2325		if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2326	<	FQSelect.SQL.Text := FParser.SQLText;
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
#	Line 2304 | Line 2577 | begin
2577		begin
2578		Disconnect;
2579		FQSelect.SQL.Assign(Value);
2307	–	FBaseSQLSelect.assign(Value);
2580		end;
2581		end;
2582
#	Line 2383 | Line 2655 | begin
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).
2664		I can "undelete" cached deleted (the deletion hasn't yet occurred) }
2665		procedure TIBCustomDataSet.Undelete;
#	Line 2729 | Line 3006 | end;
3006
3007		procedure TIBCustomDataSet.FetchAll;
3008		var
3009	<	{$IF FPC_FULLVERSION >= 20700 }
3009	>	{$IFDEF NEW_TBOOKMARK }
3010		CurBookmark: TBookmark;
3011		{$ELSE}
3012		CurBookmark: string;
#	Line 3078 | Line 3355 | begin
3355		FreeMem(FOldBufferCache);
3356		FOldBufferCache := nil;
3357		BindFields(False);
3358	+	ResetParser;
3359		if DefaultFields then DestroyFields;
3360		end;
3361
#	Line 3151 | Line 3429 | const
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, DBAliasName: string;
#	Line 3282 | Line 3565 | begin
3565		FieldSize := 0;
3566		FieldPrecision := 0;
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 * 4 + (CharSetSize - 1);
3585	<	FieldType := ftString;
3584	>	FieldSize := sqllen;
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:
#	Line 3349 | Line 3644 | begin
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;
#	Line 3368 | Line 3695 | begin
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		FAliasNameMap[FieldNo-1] := DBAliasName;
3375	–	DataType := FieldType;
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
#	Line 3517 | Line 3848 | procedure TIBCustomDataSet.InternalOpen;
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		FBase.SetCursor;
3924		try
#	Line 3531 | Line 3933 | begin
3933		if DefaultFields then
3934		CreateFields;
3935		BindFields(True);
3936	+	SetExtendedProperties;
3937		FCurrentRecord := -1;
3938		FQSelect.ExecQuery;
3939		FOpen := FQSelect.Open;
#	Line 3669 | Line 4072 | end;
4072		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
4073		Options: TLocateOptions): Boolean;
4074		var
4075	<	{$IF FPC_FULLVERSION >= 20700 }
4075	>	{$IFDEF NEW_TBOOKMARK }
4076		CurBookmark: TBookmark;
4077		{$ELSE}
4078		CurBookmark: string;
#	Line 3691 | Line 4094 | function TIBCustomDataSet.Lookup(const K
4094		const ResultFields: string): Variant;
4095		var
4096		fl: TList;
4097	<	{$IF FPC_FULLVERSION >= 20700 }
4097	>	{$IFDEF NEW_TBOOKMARK }
4098		CurBookmark: TBookmark;
4099		{$ELSE}
4100		CurBookmark: string;
#	Line 3931 | Line 4334 | begin
4334		begin
4335		FParser.Free;
4336		FParser := nil;
4337	<	SQLChanging(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
#	Line 4270 | Line 4678 | begin
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);
#	Line 4278 | Line 4691 | begin
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;
#	Line 4364 | Line 4782 | begin
4782		Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4783		end;
4784
4785	+
4786		end.

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines