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 43 by tony, Thu Sep 22 17:10:15 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 92 | Line 98 | type
98		fdDataSize: Short;
99		fdDataLength: Short;
100		fdDataOfs: Integer;
101	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
102	+	fdCodePage: TSystemCodePage;
103	+	{$ENDIF}
104		end;
105		PFieldData = ^TFieldData;
106
#	Line 120 | Line 129 | type
129
130		TIBStringField = class(TStringField)
131		private
132	<	FInitialised: boolean;
132	>	FCharacterSetName: RawByteString;
133	>	FCharacterSetSize: integer;
134		protected
135	<	procedure SetSize(AValue: Integer); override;
135	>	function GetDefaultWidth: Longint; override;
136		public
137	<	constructor create(AOwner: TComponent); override;
137	>	constructor Create(aOwner: TComponent); override;
138		class procedure CheckTypeSize(Value: Integer); override;
139		function GetAsString: string; override;
140		function GetAsVariant: Variant; override;
141		function GetValue(var Value: string): Boolean;
142		procedure SetAsString(const Value: string); override;
143	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
144	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
145	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
146	+	private
147	+	FCodePage: TSystemCodePage;
148	+	public
149	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
150	+	{$ENDIF}
151		end;
152
153		{ TIBBCDField }
#	Line 152 | Line 170 | type
170		property Size default 8;
171		end;
172
173	+	{TIBMemoField}
174	+	{Allows us to show truncated text in DBGrids and anything else that uses
175	+	DisplayText}
176	+
177	+	TIBMemoField = class(TMemoField)
178	+	private
179	+	FCharacterSetName: RawByteString;
180	+	FCharacterSetSize: integer;
181	+	FDisplayTextAsClassName: boolean;
182	+	function GetTruncatedText: string;
183	+	protected
184	+	function GetAsString: string; override;
185	+	function GetDefaultWidth: Longint; override;
186	+	procedure GetText(var AText: string; ADisplayText: Boolean); override;
187	+	procedure SetAsString(const AValue: string); override;
188	+	public
189	+	constructor Create(AOwner: TComponent); override;
190	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
191	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
192	+	published
193	+	property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
194	+	write FDisplayTextAsClassName;
195	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
196	+	private
197	+	FCodePage: TSystemCodePage;
198	+	FFCodePage: TSystemCodePage;
199	+	public
200	+	property CodePage: TSystemCodePage read FFCodePage write FFCodePage;
201	+	{$ENDIF}
202	+	end;
203	+
204		TIBDataLink = class(TDetailDataLink)
205		private
206		FDataSet: TIBCustomDataSet;
#	Line 341 | Line 390 | type
390		procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
391		procedure SetUniDirectional(Value: Boolean);
392		procedure RefreshParams;
344	–	procedure SQLChanging(Sender: TObject); virtual;
393		function AdjustPosition(FCache: PChar; Offset: DWORD;
394		Origin: Integer): DWORD;
395		procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
#	Line 371 | Line 419 | type
419		procedure InternalRefreshRow; virtual;
420		procedure InternalSetParamsFromCursor; virtual;
421		procedure CheckNotUniDirectional;
422	+	procedure SQLChanging(Sender: TObject); virtual;
423	+	procedure SQLChanged(Sender: TObject); virtual;
424
425		(*    { IProviderSupport }
426		procedure PSEndTransaction(Commit: Boolean); override;
#	Line 502 | Line 552 | type
552		procedure RecordModified(Value: Boolean);
553		procedure RevertRecord;
554		procedure Undelete;
555	<	procedure ResetParser;
555	>	procedure ResetParser; virtual;
556		function HasParser: boolean;
557
558		{ TDataSet support methods }
#	Line 662 | Line 712 | type
712		protected
713		FField: TField;
714		FBlobStream: TIBBlobStream;
715	+	function  GetSize: Int64; override;
716		public
717		constructor Create(AField: TField; ABlobStream: TIBBlobStream;
718		Mode: TBlobStreamMode);
#	Line 690 | Line 741 | DefaultFieldClasses: array[TFieldType] o
741		TVarBytesField,     { ftVarBytes }
742		TAutoIncField,      { ftAutoInc }
743		TBlobField,         { ftBlob }
744	<	TMemoField,         { ftMemo }
744	>	TIBMemoField,       { ftMemo }
745		TGraphicField,      { ftGraphic }
746		TBlobField,         { ftFmtMemo }
747		TBlobField,         { ftParadoxOle }
#	Line 698 | Line 749 | DefaultFieldClasses: array[TFieldType] o
749		TBlobField,         { ftTypedBinary }
750		nil,                { ftCursor }
751		TStringField,       { ftFixedChar }
752	<	TWideStringField,    { ftWideString }
752	>	nil,    { ftWideString }
753		TLargeIntField,     { ftLargeInt }
754		nil,          { ftADT }
755		nil,        { ftArray }
#	Line 713 | Line 764 | DefaultFieldClasses: array[TFieldType] o
764		TDateTimeField,    {ftTimestamp}
765		TIBBCDField,       {ftFMTBcd}
766		nil,  {ftFixedWideChar}
767	<	TWideMemoField);   {ftWideMemo}
767	>	nil);   {ftWideMemo}
768		(*
769		TADTField,          { ftADT }
770		TArrayField,        { ftArray }
#	Line 730 | Line 781 | DefaultFieldClasses: array[TFieldType] o
781
782		implementation
783
784	<	uses IBIntf, Variants, FmtBCD;
784	>	uses IBIntf, Variants, FmtBCD, LazUTF8, IBCodePage;
785
786		const FILE_BEGIN = 0;
787		FILE_CURRENT = 1;
#	Line 753 | Line 804 | type
804		NextRelation : TRelationNode;
805		end;
806
807	+	{Extended Field Def for character set info}
808	+
809	+	{ TIBFieldDef }
810	+
811	+	TIBFieldDef = class(TFieldDef)
812	+	private
813	+	FCharacterSetName: RawByteString;
814	+	FCharacterSetSize: integer;
815	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
816	+	FCodePage: TSystemCodePage;
817	+	{$ENDIF}
818	+	published
819	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
820	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
821	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
822	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
823	+	{$ENDIF}
824	+	end;
825	+
826	+
827	+	{  Copied from LCLProc in order to avoid LCL dependency
828	+
829	+	Ensures the covenient look of multiline string
830	+	when displaying it in the single line
831	+	* Replaces CR and LF with spaces
832	+	* Removes duplicate spaces
833	+	}
834	+	function TextToSingleLine(const AText: string): string;
835	+	var
836	+	str: string;
837	+	i, wstart, wlen: Integer;
838	+	begin
839	+	str := Trim(AText);
840	+	wstart := 0;
841	+	wlen := 0;
842	+	i := 1;
843	+	while i < Length(str) - 1 do
844	+	begin
845	+	if (str[i] in [' ', #13, #10]) then
846	+	begin
847	+	if (wstart = 0) then
848	+	begin
849	+	wstart := i;
850	+	wlen := 1;
851	+	end else
852	+	Inc(wlen);
853	+	end else
854	+	begin
855	+	if wstart > 0 then
856	+	begin
857	+	str[wstart] := ' ';
858	+	Delete(str, wstart+1, wlen-1);
859	+	Dec(i, wlen-1);
860	+	wstart := 0;
861	+	end;
862	+	end;
863	+	Inc(i);
864	+	end;
865	+	Result := str;
866	+	end;
867	+
868	+	{ TIBMemoField }
869	+
870	+	function TIBMemoField.GetTruncatedText: string;
871	+	begin
872	+	Result := GetAsString;
873	+
874	+	if Result <> '' then
875	+	begin
876	+	case CharacterSetSize of
877	+	1:
878	+	if DisplayWidth = 0 then
879	+	Result := TextToSingleLine(Result)
880	+	else
881	+	if Length(Result) > DisplayWidth then {Show truncation with elipses}
882	+	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
883	+
884	+	{2: case 2 ignored. This should be handled by TIBWideMemo}
885	+
886	+	3, {Assume UNICODE_FSS is really UTF8}
887	+	4: {Include GB18030 - assuming UTF8 routine work for this codeset}
888	+	if DisplayWidth = 0 then
889	+	Result := ValidUTF8String(TextToSingleLine(Result))
890	+	else
891	+	if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
892	+	Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
893	+	end;
894	+	end
895	+	end;
896	+
897	+	function TIBMemoField.GetAsString: string;
898	+	var s: RawByteString;
899	+	begin
900	+	s := inherited GetAsString;
901	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
902	+	SetCodePage(s,CodePage,false);
903	+	if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
904	+	SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
905	+	{$ENDIF}
906	+	Result := s;
907	+	end;
908	+
909	+	function TIBMemoField.GetDefaultWidth: Longint;
910	+	begin
911	+	if DisplayTextAsClassName then
912	+	Result := inherited
913	+	else
914	+	Result := 128;
915	+	end;
916	+
917	+	procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean);
918	+	begin
919	+	if ADisplayText then
920	+	begin
921	+	if not DisplayTextAsClassName and (CharacterSetName <> '') then
922	+	AText := GetTruncatedText
923	+	else
924	+	inherited GetText(AText, ADisplayText);
925	+	end
926	+	else
927	+	AText := GetAsString;
928	+	end;
929	+
930	+	procedure TIBMemoField.SetAsString(const AValue: string);
931	+	var s: RawByteString;
932	+	begin
933	+	s := AValue;
934	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
935	+	if StringCodePage(Value) <> CodePage then
936	+	SetCodePage(s,CodePage,CodePage<>CP_NONE);
937	+	{$ENDIF}
938	+	inherited SetAsString(s);
939	+	end;
940	+
941	+	constructor TIBMemoField.Create(AOwner: TComponent);
942	+	begin
943	+	inherited Create(AOwner);
944	+	BlobType := ftMemo;
945	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
946	+	FCodePage := CP_NONE;
947	+	{$ENDIF}
948	+	end;
949	+
950		{ TIBControlLink }
951
952		destructor TIBControlLink.Destroy;
#	Line 784 | Line 978 | end;
978
979		{ TIBStringField}
980
981	<	constructor TIBStringField.create(AOwner: TComponent);
981	>	function TIBStringField.GetDefaultWidth: Longint;
982		begin
983	<	inherited Create(AOwner);
983	>	Result := Size div CharacterSetSize;
984	>	end;
985	>
986	>	constructor TIBStringField.Create(aOwner: TComponent);
987	>	begin
988	>	inherited Create(aOwner);
989	>	FCharacterSetSize := 1;
990	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
991	>	FCodePage := CP_NONE;
992	>	{$ENDIF}
993		end;
994
995		class procedure TIBStringField.CheckTypeSize(Value: Integer);
#	Line 809 | Line 1012 | end;
1012		function TIBStringField.GetValue(var Value: string): Boolean;
1013		var
1014		Buffer: PChar;
1015	+	s: RawByteString;
1016	+	//  i: integer;
1017		begin
1018		Buffer := nil;
1019		IBAlloc(Buffer, 0, Size + 1);
#	Line 816 | Line 1021 | begin
1021		Result := GetData(Buffer);
1022		if Result then
1023		begin
1024	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1025	+	s := string(Buffer);
1026	+	SetCodePage(s,CodePage,false);
1027	+	if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1028	+	SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
1029	+	Value := s;
1030	+	(*      write(FieldName,': ', StringCodePage(Value),', ',Value,' ');
1031	+	for i := 1 to Length(Value) do
1032	+	write(Format('%x ',[byte(Value[i])]));
1033	+	writeln;*)
1034	+	{$ELSE}
1035		Value := string(Buffer);
1036	+	{$ENDIF}
1037		if Transliterate and (Value <> '') then
1038		DataSet.Translate(PChar(Value), PChar(Value), False);
1039		end
#	Line 828 | Line 1045 | end;
1045		procedure TIBStringField.SetAsString(const Value: string);
1046		var
1047		Buffer: PChar;
1048	+	s: RawByteString;
1049		begin
1050		Buffer := nil;
1051		IBAlloc(Buffer, 0, Size + 1);
1052		try
1053	<	StrLCopy(Buffer, PChar(Value), Size);
1053	>	s := Value;
1054	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1055	>	if StringCodePage(s) <> CodePage then
1056	>	SetCodePage(s,CodePage,CodePage<>CP_NONE);
1057	>	{$ENDIF}
1058	>	StrLCopy(Buffer, PChar(s), Size);
1059		if Transliterate then
1060		DataSet.Translate(Buffer, Buffer, True);
1061		SetData(Buffer);
#	Line 841 | Line 1064 | begin
1064		end;
1065		end;
1066
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;
1067
1068		{ TIBBCDField }
1069
#	Line 974 | Line 1181 | begin
1181		FQRefresh.GoToFirstRecordOnExecute := False;
1182		FQSelect := TIBSQL.Create(Self);
1183		FQSelect.OnSQLChanging := SQLChanging;
1184	+	FQSelect.OnSQLChanged := SQLChanged;
1185		FQSelect.GoToFirstRecordOnExecute := False;
1186		FQModify := TIBSQL.Create(Self);
1187		FQModify.OnSQLChanging := SQLChanging;
#	Line 1063 | Line 1271 | end;
1271
1272		procedure TIBCustomDataSet.ApplyUpdates;
1273		var
1274	<	{$IF FPC_FULLVERSION >= 20700 }
1274	>	{$IFDEF NEW_TBOOKMARK }
1275		CurBookmark: TBookmark;
1276		{$ELSE}
1277		CurBookmark: string;
#	Line 1507 | Line 1715 | var
1715		LocalInt64: Int64;
1716		LocalCurrency: Currency;
1717		FieldsLoaded: Integer;
1510	–	temp: TIBXSQLVAR;
1718		begin
1719		p := PRecordData(Buffer);
1720		{ Make sure blob cache is empty }
#	Line 1556 | Line 1763 | begin
1763		(Qry.Current[i].Data^.sqltype and 1 = 1);
1764		rdFields[j].fdIsNull :=
1765		(rdFields[j].fdNullable and (Qry.Current[i].Data^.sqlind^ = -1));
1766	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1767	+	rdFields[j].fdCodePage := 0;
1768	+	{$ENDIF}
1769		LocalData := Qry.Current[i].Data^.sqldata;
1770		case rdFields[j].fdDataType of
1771		SQL_TIMESTAMP:
#	Line 1636 | Line 1846 | begin
1846		begin
1847		rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1848		rdFields[j].fdDataLength := isc_vax_integer(Qry.Current[i].Data^.sqldata, 2);
1849	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1850	+	TFirebirdCharacterSets.CharSetID2CodePage(Qry.Current[i].Data^.sqlsubtype and $FF,
1851	+	rdFields[j].fdCodePage);
1852	+	{$ENDIF}
1853		if RecordNumber >= 0 then
1854		begin
1855		if (rdFields[j].fdDataLength = 0) then
1856		LocalData := nil
1857		else
1858	<	begin
1645	<	temp :=  Qry.Current[i];
1646	<	LocalData := @temp.Data^.sqldata[2];
1647	<	(*              LocalData := @Qry.Current[i].Data^.sqldata[2];*)
1648	<	end;
1858	>	Inc(LocalData,2);
1859		end;
1860		end;
1861		SQL_BOOLEAN:
#	Line 1656 | Line 1866 | begin
1866		LocalBool := Qry.Current[i].AsBoolean;
1867		LocalData := PChar(@LocalBool);
1868		end;
1869	<	else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
1869	>	SQL_TEXT:
1870	>	begin
1871	>	rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1872	>	rdFields[j].fdDataLength := rdFields[j].fdDataSize;
1873	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1874	>	TFirebirdCharacterSets.CharSetID2CodePage(Qry.Current[i].Data^.sqlsubtype and $FF,
1875	>	rdFields[j].fdCodePage);
1876	>	{$ENDIF}
1877	>	end;
1878	>	else {  SQL_BLOB, SQL_ARRAY, SQL_QUAD }
1879		begin
1880		rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1662	–	if (rdFields[j].fdDataType = SQL_TEXT) then
1663	–	rdFields[j].fdDataLength := rdFields[j].fdDataSize;
1881		end;
1882		end;
1883		if RecordNumber < 0 then
#	Line 1798 | Line 2015 | function TIBCustomDataSet.InternalLocate
2015		const KeyValues: Variant; Options: TLocateOptions): Boolean;
2016		var
2017		keyFieldList: TList;
2018	<	{$IF FPC_FULLVERSION >= 20700 }
2018	>	{$IFDEF NEW_TBOOKMARK }
2019		CurBookmark: TBookmark;
2020		{$ELSE}
2021		CurBookmark: string;
#	Line 2057 | Line 2274 | begin
2274		FBase.CheckDatabase;
2275		FBase.CheckTransaction;
2276		if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2277	<	FQSelect.SQL.Text := FParser.SQLText;
2277	>	begin
2278	>	FQSelect.OnSQLChanged := nil; {Do not react to change}
2279	>	try
2280	>	FQSelect.SQL.Text := FParser.SQLText;
2281	>	finally
2282	>	FQSelect.OnSQLChanged := SQLChanged;
2283	>	end;
2284	>	end;
2285		//   writeln( FQSelect.SQL.Text);
2286		if FQSelect.SQL.Text <> '' then
2287		begin
#	Line 2188 | Line 2412 | procedure TIBCustomDataSet.SetInternalSQ
2412		var
2413		i, j: Integer;
2414		cr, data: PChar;
2415	<	fn, st: string;
2415	>	fn: string;
2416	>	st: RawByteString;
2417		OldBuffer: Pointer;
2418		ts: TTimeStamp;
2419		begin
#	Line 2236 | Line 2461 | begin
2461		SQL_TEXT, SQL_VARYING:
2462		begin
2463		SetString(st, data, rdFields[j].fdDataLength);
2464	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
2465	+	SetCodePage(st,rdFields[j].fdCodePage,false);
2466	+	{$ENDIF}
2467		Qry.Params[i].AsString := st;
2468		end;
2469		SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT:
#	Line 2304 | Line 2532 | begin
2532		begin
2533		Disconnect;
2534		FQSelect.SQL.Assign(Value);
2307	–	FBaseSQLSelect.assign(Value);
2535		end;
2536		end;
2537
#	Line 2383 | Line 2610 | begin
2610		FieldDefs.Updated := false;
2611		end;
2612
2613	+	procedure TIBCustomDataSet.SQLChanged(Sender: TObject);
2614	+	begin
2615	+	FBaseSQLSelect.assign(FQSelect.SQL);
2616	+	end;
2617	+
2618		{ I can "undelete" uninserted records (make them "inserted" again).
2619		I can "undelete" cached deleted (the deletion hasn't yet occurred) }
2620		procedure TIBCustomDataSet.Undelete;
#	Line 2729 | Line 2961 | end;
2961
2962		procedure TIBCustomDataSet.FetchAll;
2963		var
2964	<	{$IF FPC_FULLVERSION >= 20700 }
2964	>	{$IFDEF NEW_TBOOKMARK }
2965		CurBookmark: TBookmark;
2966		{$ELSE}
2967		CurBookmark: string;
#	Line 3078 | Line 3310 | begin
3310		FreeMem(FOldBufferCache);
3311		FOldBufferCache := nil;
3312		BindFields(False);
3313	+	ResetParser;
3314		if DefaultFields then DestroyFields;
3315		end;
3316
#	Line 3151 | Line 3384 | const
3384		var
3385		FieldType: TFieldType;
3386		FieldSize: Word;
3387	+	charSetID: integer;
3388		CharSetSize: integer;
3389	+	CharSetName: RawByteString;
3390	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3391	+	FieldCodePage: TSystemCodePage;
3392	+	{$ENDIF}
3393		FieldNullable : Boolean;
3394		i, FieldPosition, FieldPrecision: Integer;
3395		FieldAliasName, DBAliasName: string;
#	Line 3282 | Line 3520 | begin
3520		FieldSize := 0;
3521		FieldPrecision := 0;
3522		FieldNullable := SourceQuery.Current[i].IsNullable;
3523	+	CharSetSize := 0;
3524	+	CharSetName := '';
3525	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3526	+	FieldCodePage := CP_NONE;
3527	+	{$ENDIF}
3528		case sqltype and not 1 of
3529		{ All VARCHAR's must be converted to strings before recording
3530		their values }
3531		SQL_VARYING, SQL_TEXT:
3532		begin
3533	<	CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF);
3534	<	{FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3535	<	FieldSize := sqllen * 4 + (CharSetSize - 1);
3533	>	CharSetID := SourceQuery.Current[i].GetCharSetID;
3534	>	TFirebirdCharacterSets.CharSetWidth(CharSetID,CharSetSize);
3535	>	CharSetName := TFirebirdCharacterSets.GetCharsetName(CharSetID);
3536	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3537	>	TFirebirdCharacterSets.CharSetID2CodePage(CharSetID,FieldCodePage);
3538	>	{$ENDIF}
3539	>	FieldSize := sqllen;
3540		FieldType := ftString;
3541		end;
3542		{ All Doubles/Floats should be cast to doubles }
#	Line 3349 | Line 3596 | begin
3596		begin
3597		FieldSize := sizeof (TISC_QUAD);
3598		if (sqlsubtype = 1) then
3599	<	FieldType := ftmemo
3599	>	begin
3600	>	CharSetID := SourceQuery.Current[i].GetCharSetID;
3601	>	TFirebirdCharacterSets.CharSetWidth(CharSetID,CharSetSize);
3602	>	CharSetName := TFirebirdCharacterSets.GetCharsetName(CharSetID);
3603	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3604	>	TFirebirdCharacterSets.CharSetID2CodePage(CharSetID,FieldCodePage);
3605	>	{$ENDIF}
3606	>	FieldType := ftMemo;
3607	>	end
3608		else
3609		FieldType := ftBlob;
3610		end;
#	Line 3368 | Line 3623 | begin
3623		begin
3624		FMappedFieldPosition[FieldIndex] := FieldPosition;
3625		Inc(FieldIndex);
3626	<	with FieldDefs.AddFieldDef do
3626	>	with TIBFieldDef.Create(FieldDefs,'',FieldType,0,False,FieldDefs.Count+1) do
3627		begin
3628		Name := FieldAliasName;
3629		FAliasNameMap[FieldNo-1] := DBAliasName;
3375	–	DataType := FieldType;
3630		Size := FieldSize;
3631		Precision := FieldPrecision;
3632		Required := not FieldNullable;
3633		InternalCalcField := False;
3634	+	CharacterSetSize := CharSetSize;
3635	+	CharacterSetName := CharSetName;
3636	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3637	+	CodePage := FieldCodePage;
3638	+	{$ENDIF}
3639		if (FieldName <> '') and (RelationName <> '') then
3640		begin
3641		if Has_COMPUTED_BLR(RelationName, FieldName) then
#	Line 3517 | Line 3776 | procedure TIBCustomDataSet.InternalOpen;
3776		result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData));
3777		end;
3778
3779	+	function GetFieldDef(aFieldNo: integer): TIBFieldDef;
3780	+	var i: integer;
3781	+	begin
3782	+	Result := nil;
3783	+	for i := 0 to FieldDefs.Count - 1 do
3784	+	if FieldDefs[i].FieldNo = aFieldNo then
3785	+	begin
3786	+	Result := TIBFieldDef(FieldDefs[i]);
3787	+	break;
3788	+	end;
3789	+	end;
3790	+
3791	+	procedure SetExtendedProperties;
3792	+	var i: integer;
3793	+	IBFieldDef: TIBFieldDef;
3794	+	begin
3795	+	for i := 0 to Fields.Count - 1 do
3796	+	if Fields[i].FieldNo > 0 then
3797	+	begin
3798	+	if(Fields[i] is TIBStringField) then
3799	+	with TIBStringField(Fields[i]) do
3800	+	begin
3801	+	IBFieldDef := GetFieldDef(FieldNo);
3802	+	if IBFieldDef <> nil then
3803	+	begin
3804	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3805	+	CharacterSetName := IBFieldDef.CharacterSetName;
3806	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3807	+	CodePage := IBFieldDef.CodePage;
3808	+	{$ENDIF}
3809	+	end;
3810	+	end
3811	+	else
3812	+	if(Fields[i] is TIBMemoField) then
3813	+	with TIBMemoField(Fields[i]) do
3814	+	begin
3815	+	IBFieldDef := GetFieldDef(FieldNo);
3816	+	if IBFieldDef <> nil then
3817	+	begin
3818	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3819	+	CharacterSetName := IBFieldDef.CharacterSetName;
3820	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3821	+	CodePage := IBFieldDef.CodePage;
3822	+	{$ENDIF}
3823	+	end;
3824	+	end
3825	+	end
3826	+	end;
3827	+
3828		begin
3829		FBase.SetCursor;
3830		try
#	Line 3531 | Line 3839 | begin
3839		if DefaultFields then
3840		CreateFields;
3841		BindFields(True);
3842	+	SetExtendedProperties;
3843		FCurrentRecord := -1;
3844		FQSelect.ExecQuery;
3845		FOpen := FQSelect.Open;
#	Line 3669 | Line 3978 | end;
3978		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
3979		Options: TLocateOptions): Boolean;
3980		var
3981	<	{$IF FPC_FULLVERSION >= 20700 }
3981	>	{$IFDEF NEW_TBOOKMARK }
3982		CurBookmark: TBookmark;
3983		{$ELSE}
3984		CurBookmark: string;
#	Line 3691 | Line 4000 | function TIBCustomDataSet.Lookup(const K
4000		const ResultFields: string): Variant;
4001		var
4002		fl: TList;
4003	<	{$IF FPC_FULLVERSION >= 20700 }
4003	>	{$IFDEF NEW_TBOOKMARK }
4004		CurBookmark: TBookmark;
4005		{$ELSE}
4006		CurBookmark: string;
#	Line 3931 | Line 4240 | begin
4240		begin
4241		FParser.Free;
4242		FParser := nil;
4243	<	SQLChanging(nil)
4243	>	FQSelect.OnSQLChanged := nil; {Do not react to change}
4244	>	try
4245	>	FQSelect.SQL.Assign(FBaseSQLSelect);
4246	>	finally
4247	>	FQSelect.OnSQLChanged := SQLChanged;
4248	>	end;
4249		end;
4250		end;
4251
#	Line 4270 | Line 4584 | begin
4584		DataSet.SetInternalSQLParams(Query, buff);
4585		end;
4586
4587	+	function TIBDSBlobStream.GetSize: Int64;
4588	+	begin
4589	+	Result := FBlobStream.BlobSize;
4590	+	end;
4591	+
4592		{ TIBDSBlobStream }
4593		constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
4594		Mode: TBlobStreamMode);
#	Line 4278 | Line 4597 | begin
4597		FBlobStream := ABlobStream;
4598		FBlobStream.Seek(0, soFromBeginning);
4599		if (Mode = bmWrite) then
4600	+	begin
4601		FBlobStream.Truncate;
4602	+	TIBCustomDataSet(FField.DataSet).RecordModified(True);
4603	+	TBlobField(FField).Modified := true;
4604	+	FHasWritten := true;
4605	+	end;
4606		end;
4607
4608		destructor TIBDSBlobStream.Destroy;
#	Line 4364 | Line 4688 | begin
4688		Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4689		end;
4690
4691	+
4692		end.

Diff Legend

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