ViewVC Help

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

root/public/ibx/trunk/fbintf/client/FBArray.pas

Comparing ibx/trunk/fbintf/client/FBArray.pas (file contents):
Revision 47 by tony, Mon Jan 9 15:31:51 2017 UTC vs.
Revision 60 by tony, Mon Mar 27 15:21:02 2017 UTC

#	Line 25 | Line 25
25		*
26		*)
27		unit FBArray;
28	+	{$IFDEF MSWINDOWS}
29	+	{$DEFINE WINDOWS}
30	+	{$ENDIF}
31
32		{$IFDEF FPC}
33	<	{$mode objfpc}{$H+}
33	>	{$mode delphi}
34		{$codepage UTF8}
35		{$interfaces COM}
36		{$ENDIF}
#	Line 69 | Line 72 | type
72
73		TFBArrayElement = class(TSQLDataItem)
74		private
75	<	FBufPtr: PChar;
75	>	FBufPtr: PByte;
76		FArray: TFBArray;
77		protected
78		function GetSQLDialect: integer; override;
79		procedure Changing; override;
80		procedure Changed; override;
81	<	function SQLData: PChar; override;
81	>	function SQLData: PByte; override;
82		function GetDataLength: cardinal; override;
83		function GetCodePage: TSystemCodePage; override;
84		function getCharSetID: cardinal; override;
85		procedure SetDataLength(len: cardinal); override;
86		procedure SetSQLType(aValue: cardinal); override;
87		public
88	<	constructor Create(anArray: TFBArray; P: PChar);
88	>	constructor Create(anArray: TFBArray; P: PByte);
89		function GetSQLType: cardinal; override;
90	<	function GetName: string; override;
90	>	function GetName: AnsiString; override;
91		function GetScale: integer; override;
92		function GetSize: integer;
93	<	function GetAsString: string; override;
93	>	function GetAsString: AnsiString; override;
94		procedure SetAsLong(Value: Long); override;
95		procedure SetAsShort(Value: Short); override;
96		procedure SetAsInt64(Value: Int64); override;
97	<	procedure SetAsString(Value: String); override;
97	>	procedure SetAsString(Value: AnsiString); override;
98		procedure SetAsDouble(Value: Double); override;
99		procedure SetAsFloat(Value: Float); override;
100		procedure SetAsCurrency(Value: Currency); override;
#	Line 105 | Line 108 | type
108		protected
109		FArrayDesc: TISC_ARRAY_DESC;
110		FCharSetID: integer;
111	+	FAttachment: IAttachment;
112		procedure LoadMetaData(aAttachment: IAttachment; aTransaction: ITransaction;
113	<	relationName, columnName: string); virtual; abstract;
113	>	relationName, columnName: AnsiString); virtual; abstract;
114		function NumOfElements: integer;
115		public
116		constructor Create(aAttachment: IAttachment; aTransaction: ITransaction;
117	<	relationName, columnName: string); overload;
118	<	constructor Create(SQLType: cardinal; tableName: string; columnName: string;
117	>	relationName, columnName: AnsiString); overload;
118	>	constructor Create(aAttachment: IAttachment;SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
119		Scale: integer; size: cardinal; charSetID: cardinal;
120		dimensions: cardinal; bounds: TArrayBounds); overload;
121		function GetCodePage: TSystemCodePage; virtual; abstract;
#	Line 119 | Line 123 | type
123		public
124		{IArrayMetaData}
125		function GetSQLType: cardinal;
126	<	function GetSQLTypeName: string;
126	>	function GetSQLTypeName: AnsiString;
127		function GetScale: integer;
128		function GetSize: cardinal;
129		function GetCharSetID: cardinal; virtual; abstract;
130	<	function GetTableName: string;
131	<	function GetColumnName: string;
130	>	function GetTableName: AnsiString;
131	>	function GetColumnName: AnsiString;
132		function GetDimensions: integer;
133		function GetBounds: TArrayBounds;
134		end;
#	Line 149 | Line 153 | type
153		FEventHandlers: array of TArrayEventHandler;
154		procedure GetArraySlice;
155		procedure PutArraySlice(Force: boolean=false);
156	<	function GetOffset(index: array of integer): PChar;
156	>	function GetOffset(index: array of integer): PByte;
157		function GetDataLength: short;
158		protected
159	<	FBuffer: PChar;
159	>	FBuffer: PByte;
160		FBufSize: ISC_LONG;
161		FArrayID: TISC_QUAD;
162		procedure AllocateBuffer; virtual;
#	Line 173 | Line 177 | type
177		public
178		{IArrayMetaData}
179		function GetSQLType: cardinal;
180	<	function GetSQLTypeName: string;
180	>	function GetSQLTypeName: AnsiString;
181		function GetScale: integer;
182		function GetSize: cardinal;
183		function GetCharSetID: cardinal;
184	<	function GetTableName: string;
185	<	function GetColumnName: string;
184	>	function GetTableName: AnsiString;
185	>	function GetColumnName: AnsiString;
186		function GetDimensions: integer;
187		function GetBounds: TArrayBounds;
188		{IArray}
#	Line 197 | Line 201 | type
201		function GetAsFloat(index: array of integer): Float;
202		function GetAsLong(index: array of integer): Long;
203		function GetAsShort(index: array of integer): Short;
204	<	function GetAsString(index: array of integer): String;
204	>	function GetAsString(index: array of integer): AnsiString;
205		function GetAsVariant(index: array of integer): Variant;
206		procedure SetAsInteger(index: array of integer; AValue: integer);
207		procedure SetAsBoolean(index: array of integer; AValue: boolean);
#	Line 210 | Line 214 | type
214		procedure SetAsDouble(index: array of integer; Value: Double);
215		procedure SetAsFloat(index: array of integer; Value: Float);
216		procedure SetAsShort(index: array of integer; Value: Short);
217	<	procedure SetAsString(index: array of integer; Value: String);
217	>	procedure SetAsString(index: array of integer; Value: AnsiString);
218		procedure SetAsVariant(index: array of integer; Value: Variant);
219		procedure SetBounds(dim, UpperBound, LowerBound: integer);
220		function GetAttachment: IAttachment;
#	Line 242 | Line 246 | begin
246		FArray.Changed;
247		end;
248
249	<	function TFBArrayElement.SQLData: PChar;
249	>	function TFBArrayElement.SQLData: PByte;
250		begin
251		Result := FBufPtr;
252		end;
#	Line 268 | Line 272 | begin
272		IBError(ibxeArrayElementOverFlow,[nil]);
273		end;
274
275	<	constructor TFBArrayElement.Create(anArray: TFBArray; P: PChar);
275	>	constructor TFBArrayElement.Create(anArray: TFBArray; P: PByte);
276		begin
277		inherited Create;
278		FArray := anArray;
#	Line 280 | Line 284 | begin
284		Result :=  FArray.FMetaData.GetSQLType;
285		end;
286
287	<	function TFBArrayElement.GetName: string;
287	>	function TFBArrayElement.GetName: AnsiString;
288		begin
289		Result := FArray.FMetaData.GetColumnName;
290		end;
#	Line 295 | Line 299 | begin
299		Result := GetDataLength;
300		end;
301
302	<	function TFBArrayElement.GetAsString: string;
302	>	function TFBArrayElement.GetAsString: AnsiString;
303		var rs: RawByteString;
304		begin
305		case GetSQLType of
306		SQL_VARYING:
307		begin
308	<	rs := strpas(FBufPtr);
308	>	rs := strpas(PAnsiChar(FBufPtr));
309		SetCodePage(rs,GetCodePage,false);
310		Result := rs;
311		end;
312		SQL_TEXT:
313		begin
314	<	SetString(rs,FBufPtr,GetDataLength);
314	>	SetString(rs,PAnsiChar(FBufPtr),GetDataLength);
315		SetCodePage(rs,GetCodePage,false);
316		Result := rs;
317		end
#	Line 349 | Line 353 | begin
353		Changed;
354		end;
355
356	<	procedure TFBArrayElement.SetAsString(Value: String);
356	>	procedure TFBArrayElement.SetAsString(Value: AnsiString);
357		var len: integer;
358		ElementSize: integer;
359		begin
360		CheckActive;
361		case GetSQLType of
362		SQL_BOOLEAN:
363	<	if CompareText(Value,STrue) = 0 then
363	>	if AnsiCompareText(Value,STrue) = 0 then
364		AsBoolean := true
365		else
366	<	if CompareText(Value,SFalse) = 0 then
366	>	if AnsiCompareText(Value,SFalse) = 0 then
367		AsBoolean := false
368		else
369		IBError(ibxeInvalidDataConversion,[nil]);
#	Line 374 | Line 378 | begin
378		if Len > 0 then
379		Move(Value[1],FBufPtr^,len);
380		if Len < ElementSize - 2 then
381	<	(FBufPtr+len)^ := #0;
381	>	(FBufPtr+len)^ := 0;
382		Changed;
383		end;
384
#	Line 395 | Line 399 | begin
399		if trim(Value) = '' then
400		SetAsInt64(0)
401		else
402	<	SetAsInt64(StrToInt(Value));
402	>	SetAsInt64(AdjustScaleFromCurrency(StrToCurr(Value),GetScale));
403
404		SQL_D_FLOAT,
405		SQL_DOUBLE,
#	Line 480 | Line 484 | end;
484		{TFBArrayMetaData}
485
486		constructor TFBArrayMetaData.Create(aAttachment: IAttachment;
487	<	aTransaction: ITransaction; relationName, columnName: string);
487	>	aTransaction: ITransaction; relationName, columnName: AnsiString);
488		begin
489		inherited Create;
490	+	FAttachment := aAttachment;
491		LoadMetaData(aAttachment,aTransaction,relationName, columnName);
492		end;
493
494	<	constructor TFBArrayMetaData.Create(SQLType: cardinal; tableName: string;
495	<	columnName: string; Scale: integer; size: cardinal; charSetID: cardinal;
496	<	dimensions: cardinal; bounds: TArrayBounds);
494	>	constructor TFBArrayMetaData.Create(aAttachment: IAttachment;
495	>	SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
496	>	Scale: integer; size: cardinal; charSetID: cardinal; dimensions: cardinal;
497	>	bounds: TArrayBounds);
498		var i: integer;
499		begin
500		inherited Create;
501	+	FAttachment := aAttachment;
502		with FArrayDesc do
503		begin
504		array_desc_dtype := GetDType(SQLType);
505	<	array_desc_scale := char(Scale);
505	>	array_desc_scale := Scale;
506		array_desc_length := UShort(size);
507		StrPLCopy(array_desc_field_name,columnName,sizeof(array_desc_field_name));
508		StrPLCopy(array_desc_relation_name,tableName,sizeof(array_desc_relation_name));
#	Line 540 | Line 547 | begin
547		end;
548		end;
549
550	<	function TFBArrayMetaData.GetSQLTypeName: string;
550	>	function TFBArrayMetaData.GetSQLTypeName: AnsiString;
551		begin
552		Result := TSQLDataItem.GetSQLTypeName(GetSQLType);
553		end;
#	Line 555 | Line 562 | begin
562		Result := FArrayDesc.array_desc_length;
563		end;
564
565	<	function TFBArrayMetaData.GetTableName: string;
565	>	function TFBArrayMetaData.GetTableName: AnsiString;
566		begin
567		with FArrayDesc do
568	<	SetString(Result,PChar(@array_desc_relation_name),sizeof(array_desc_relation_name));
568	>	SetString(Result,PAnsiChar(@array_desc_relation_name),sizeof(array_desc_relation_name));
569		Result := trim(Result);
570		end;
571
572	<	function TFBArrayMetaData.GetColumnName: string;
572	>	function TFBArrayMetaData.GetColumnName: AnsiString;
573		begin
574		with FArrayDesc do
575	<	SetString(Result,PChar(@FArrayDesc.array_desc_field_name),sizeof(array_desc_field_name));
575	>	SetString(Result,PAnsiChar(@FArrayDesc.array_desc_field_name),sizeof(array_desc_field_name));
576		Result := trim(Result);
577		end;
578
#	Line 620 | Line 627 | begin
627		Result := 1;
628		Bounds := GetBounds;
629		for i := 0 to Length(Bounds) - 1 do
630	<	Result *= (Bounds[i].UpperBound - Bounds[i].LowerBound + 1);
630	>	Result := Result * (Bounds[i].UpperBound - Bounds[i].LowerBound + 1);
631		end;
632
633
#	Line 643 | Line 650 | begin
650		FElementSize := FArrayDesc.array_desc_length;
651		case GetSQLType of
652		SQL_VARYING:
653	<	FElementSize += 2;
653	>	FElementSize := FElementSize + 2;
654		SQL_TEXT:
655	<	FElementSize += 1;
655	>	FElementSize := FElementSize + 1;
656		end;
657		FBufSize := FElementSize * l;
658
#	Line 703 | Line 710 | begin
710		FIsNew := false;
711		end;
712
713	<	function TFBArray.GetOffset(index: array of integer): PChar;
713	>	function TFBArray.GetOffset(index: array of integer): PByte;
714		var i: integer;
715		Bounds: TArrayBounds;
716		FlatIndex: integer;
#	Line 718 | Line 725 | begin
725		if (index[i] < Bounds[i].LowerBound) or (index[i] > Bounds[i].UpperBound) then
726		IBError(ibxeInvalidSubscript,[index[i],i]);
727
728	<	FlatIndex += FOffsets[i]*(index[i] - Bounds[i].LowerBound);
728	>	FlatIndex := FlatIndex + FOffsets[i]*(index[i] - Bounds[i].LowerBound);
729		end;
730		Result := FBuffer + FlatIndex*FElementSize;
731		end;
#	Line 826 | Line 833 | begin
833		Result := FMetaData.GetSQLType;
834		end;
835
836	<	function TFBArray.GetSQLTypeName: string;
836	>	function TFBArray.GetSQLTypeName: AnsiString;
837		begin
838		Result := FMetaData.GetSQLTypeName;
839		end;
#	Line 846 | Line 853 | begin
853		Result := FMetaData.GetCharSetID;
854		end;
855
856	<	function TFBArray.GetTableName: string;
856	>	function TFBArray.GetTableName: AnsiString;
857		begin
858		Result := FMetaData.GetTableName;
859		end;
860
861	<	function TFBArray.GetColumnName: string;
861	>	function TFBArray.GetColumnName: AnsiString;
862		begin
863		Result := FMetaData.GetColumnName;
864		end;
#	Line 929 | Line 936 | begin
936		Result := FElement.GetAsShort;
937		end;
938
939	<	function TFBArray.GetAsString(index: array of integer): String;
939	>	function TFBArray.GetAsString(index: array of integer): AnsiString;
940		begin
941		GetArraySlice;
942		FElement.FBufPtr := GetOffset(index);
#	Line 1009 | Line 1016 | begin
1016		FElement.SetAsShort(Value);
1017		end;
1018
1019	<	procedure TFBArray.SetAsString(index: array of integer; Value: String);
1019	>	procedure TFBArray.SetAsString(index: array of integer; Value: AnsiString);
1020		begin
1021		FElement.FBufPtr := GetOffset(index);
1022		FElement.SetAsString(Value);
#	Line 1062 | Line 1069 | procedure TFBArray.RemoveEventHandler(Ha
1069		var i,j : integer;
1070		begin
1071		for i := Length(FEventHandlers) - 1 downto 0 do
1072	<	if FEventHandlers[i] = Handler then
1072	>	if (TMethod(FEventHandlers[i]).Code = TMethod(Handler).Code) and
1073	>	(TMethod(FEventHandlers[i]).Data = TMethod(Handler).Data) then
1074		begin
1075		for j := i to Length(FEventHandlers) - 2 do
1076		FEventHandlers[i] := FEventHandlers[i+1];

Diff Legend

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