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 35 by tony, Tue Jan 26 14:38:47 2016 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	<	FCharacterSetName: string;
129	>	FCharacterSetName: RawByteString;
130		FCharacterSetSize: integer;
131		protected
132		function GetDefaultWidth: Longint; override;
#	Line 131 | Line 137 | type
137		function GetAsVariant: Variant; override;
138		function GetValue(var Value: string): Boolean;
139		procedure SetAsString(const Value: string); override;
140	<	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
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: string;
154	>	FCharacterSetName: RawByteString;
155		FCharacterSetSize: integer;
156		public
157	<	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
157	>	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
158		property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
159		end;
160
#	Line 172 | Line 184 | type
184
185		TIBMemoField = class(TMemoField)
186		private
187	<	FCharacterSetName: string;
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: string read FCharacterSetName write FCharacterSetName;
198	>	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
199		property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
200	<	published
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: string;
216	>	FCharacterSetName: RawByteString;
217		FCharacterSetSize: integer;
218		FDisplayTextAsClassName: boolean;
219		function GetTruncatedText: string;
#	Line 201 | Line 222 | type
222		procedure GetText(var AText: string; ADisplayText: Boolean); override;
223		public
224		constructor Create(AOwner: TComponent); override;
225	<	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
225	>	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
226		property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
227		published
228		property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
#	Line 719 | 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 787 | Line 809 | DefaultFieldClasses: array[TFieldType] o
809
810		implementation
811
812	<	uses IBIntf, Variants, FmtBCD, LCLProc, LazUTF8;
812	>	uses IBIntf, Variants, FmtBCD, LazUTF8;
813
814		const FILE_BEGIN = 0;
815		FILE_CURRENT = 1;
#	Line 816 | Line 838 | type
838
839		TIBFieldDef = class(TFieldDef)
840		private
841	<	FCharacterSetName: string;
841	>	FCharacterSetName: RawByteString;
842		FCharacterSetSize: integer;
843	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
844	+	FCodePage: TSystemCodePage;
845	+	{$ENDIF}
846		published
847	<	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
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 }
#	Line 846 | Line 916 | procedure TIBWideMemoField.GetText(var A
916		begin
917		if ADisplayText then
918		begin
919	<	if not DisplayTextAsClassName then
919	>	if not DisplayTextAsClassName and (CharacterSetName<> '') then
920		AText := GetTruncatedText
921		else
922		inherited GetText(AText, ADisplayText);
#	Line 890 | Line 960 | begin
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	<	Result := 128;
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 then
985	>	if not DisplayTextAsClassName and (CharacterSetName <> '') then
986		AText := GetTruncatedText
987		else
988		inherited GetText(AText, ADisplayText);
#	Line 908 | Line 991 | begin
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 }
#	Line 954 | Line 1051 | constructor TIBStringField.Create(aOwner
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 976 | 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 983 | 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 995 | 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 1215 | 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 1950 | 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 2892 | 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 3317 | Line 3431 | var
3431		FieldSize: Word;
3432		charSetID: short;
3433		CharSetSize: integer;
3434	<	CharSetName: string;
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 3450 | Line 3567 | begin
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 }
#	Line 3457 | Line 3577 | begin
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		if CharSetSize = 2 then
#	Line 3522 | Line 3645 | begin
3645		FieldSize := sizeof (TISC_QUAD);
3646		if (sqlsubtype = 1) then
3647		begin
3648	<	if strpas(sqlname) = '' then {Complex SQL with no identifiable column - use connection default}
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
#	Line 3567 | Line 3705 | begin
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 3734 | Line 3875 | procedure TIBCustomDataSet.InternalOpen;
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
#	Line 3756 | Line 3900 | procedure TIBCustomDataSet.InternalOpen;
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
#	Line 3925 | 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 3947 | 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 4531 | 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 4539 | 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;

Diff Legend

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