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 263 by tony, Thu Dec 6 15:55:01 2018 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 134 | Line 138 | type
138
139		TFBArray = class(TActivityReporter,IArray)
140		private
141	+	FFirebirdClientAPI: TFBClientAPI;
142		FMetaData: IArrayMetaData;
143		FIsNew: boolean;
144		FLoaded: boolean;
#	Line 149 | Line 154 | type
154		FEventHandlers: array of TArrayEventHandler;
155		procedure GetArraySlice;
156		procedure PutArraySlice(Force: boolean=false);
157	<	function GetOffset(index: array of integer): PChar;
157	>	function GetOffset(index: array of integer): PByte;
158		function GetDataLength: short;
159		protected
160	<	FBuffer: PChar;
160	>	FBuffer: PByte;
161		FBufSize: ISC_LONG;
162		FArrayID: TISC_QUAD;
163		procedure AllocateBuffer; virtual;
#	Line 173 | Line 178 | type
178		public
179		{IArrayMetaData}
180		function GetSQLType: cardinal;
181	<	function GetSQLTypeName: string;
181	>	function GetSQLTypeName: AnsiString;
182		function GetScale: integer;
183		function GetSize: cardinal;
184		function GetCharSetID: cardinal;
185	<	function GetTableName: string;
186	<	function GetColumnName: string;
185	>	function GetTableName: AnsiString;
186	>	function GetColumnName: AnsiString;
187		function GetDimensions: integer;
188		function GetBounds: TArrayBounds;
189		{IArray}
#	Line 197 | Line 202 | type
202		function GetAsFloat(index: array of integer): Float;
203		function GetAsLong(index: array of integer): Long;
204		function GetAsShort(index: array of integer): Short;
205	<	function GetAsString(index: array of integer): String;
205	>	function GetAsString(index: array of integer): AnsiString;
206		function GetAsVariant(index: array of integer): Variant;
207		procedure SetAsInteger(index: array of integer; AValue: integer);
208		procedure SetAsBoolean(index: array of integer; AValue: boolean);
#	Line 210 | Line 215 | type
215		procedure SetAsDouble(index: array of integer; Value: Double);
216		procedure SetAsFloat(index: array of integer; Value: Float);
217		procedure SetAsShort(index: array of integer; Value: Short);
218	<	procedure SetAsString(index: array of integer; Value: String);
218	>	procedure SetAsString(index: array of integer; Value: AnsiString);
219		procedure SetAsVariant(index: array of integer; Value: Variant);
220		procedure SetBounds(dim, UpperBound, LowerBound: integer);
221		function GetAttachment: IAttachment;
#	Line 242 | Line 247 | begin
247		FArray.Changed;
248		end;
249
250	<	function TFBArrayElement.SQLData: PChar;
250	>	function TFBArrayElement.SQLData: PByte;
251		begin
252		Result := FBufPtr;
253		end;
#	Line 268 | Line 273 | begin
273		IBError(ibxeArrayElementOverFlow,[nil]);
274		end;
275
276	<	constructor TFBArrayElement.Create(anArray: TFBArray; P: PChar);
276	>	constructor TFBArrayElement.Create(anArray: TFBArray; P: PByte);
277		begin
278	<	inherited Create;
278	>	inherited Create(anArray.FFirebirdClientAPI);
279		FArray := anArray;
280		FBufPtr := P;
281		end;
#	Line 280 | Line 285 | begin
285		Result :=  FArray.FMetaData.GetSQLType;
286		end;
287
288	<	function TFBArrayElement.GetName: string;
288	>	function TFBArrayElement.GetName: AnsiString;
289		begin
290		Result := FArray.FMetaData.GetColumnName;
291		end;
#	Line 295 | Line 300 | begin
300		Result := GetDataLength;
301		end;
302
303	<	function TFBArrayElement.GetAsString: string;
303	>	function TFBArrayElement.GetAsString: AnsiString;
304		var rs: RawByteString;
305		begin
306		case GetSQLType of
307		SQL_VARYING:
308		begin
309	<	rs := strpas(FBufPtr);
309	>	rs := strpas(PAnsiChar(FBufPtr));
310		SetCodePage(rs,GetCodePage,false);
311		Result := rs;
312		end;
313		SQL_TEXT:
314		begin
315	<	SetString(rs,FBufPtr,GetDataLength);
315	>	SetString(rs,PAnsiChar(FBufPtr),GetDataLength);
316		SetCodePage(rs,GetCodePage,false);
317		Result := rs;
318		end
#	Line 349 | Line 354 | begin
354		Changed;
355		end;
356
357	<	procedure TFBArrayElement.SetAsString(Value: String);
357	>	procedure TFBArrayElement.SetAsString(Value: AnsiString);
358		var len: integer;
359		ElementSize: integer;
360		begin
361		CheckActive;
362		case GetSQLType of
363		SQL_BOOLEAN:
364	<	if CompareText(Value,STrue) = 0 then
364	>	if AnsiCompareText(Value,STrue) = 0 then
365		AsBoolean := true
366		else
367	<	if CompareText(Value,SFalse) = 0 then
367	>	if AnsiCompareText(Value,SFalse) = 0 then
368		AsBoolean := false
369		else
370		IBError(ibxeInvalidDataConversion,[nil]);
#	Line 374 | Line 379 | begin
379		if Len > 0 then
380		Move(Value[1],FBufPtr^,len);
381		if Len < ElementSize - 2 then
382	<	(FBufPtr+len)^ := #0;
382	>	(FBufPtr+len)^ := 0;
383		Changed;
384		end;
385
#	Line 395 | Line 400 | begin
400		if trim(Value) = '' then
401		SetAsInt64(0)
402		else
403	<	SetAsInt64(StrToInt(Value));
403	>	SetAsInt64(AdjustScaleFromCurrency(StrToCurr(Value),GetScale));
404
405		SQL_D_FLOAT,
406		SQL_DOUBLE,
#	Line 480 | Line 485 | end;
485		{TFBArrayMetaData}
486
487		constructor TFBArrayMetaData.Create(aAttachment: IAttachment;
488	<	aTransaction: ITransaction; relationName, columnName: string);
488	>	aTransaction: ITransaction; relationName, columnName: AnsiString);
489		begin
490		inherited Create;
491	+	FAttachment := aAttachment;
492		LoadMetaData(aAttachment,aTransaction,relationName, columnName);
493		end;
494
495	<	constructor TFBArrayMetaData.Create(SQLType: cardinal; tableName: string;
496	<	columnName: string; Scale: integer; size: cardinal; charSetID: cardinal;
497	<	dimensions: cardinal; bounds: TArrayBounds);
495	>	constructor TFBArrayMetaData.Create(aAttachment: IAttachment;
496	>	SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
497	>	Scale: integer; size: cardinal; charSetID: cardinal; dimensions: cardinal;
498	>	bounds: TArrayBounds);
499		var i: integer;
500		begin
501		inherited Create;
502	+	FAttachment := aAttachment;
503		with FArrayDesc do
504		begin
505		array_desc_dtype := GetDType(SQLType);
506	<	array_desc_scale := char(Scale);
506	>	array_desc_scale := Scale;
507		array_desc_length := UShort(size);
508		StrPLCopy(array_desc_field_name,columnName,sizeof(array_desc_field_name));
509		StrPLCopy(array_desc_relation_name,tableName,sizeof(array_desc_relation_name));
#	Line 540 | Line 548 | begin
548		end;
549		end;
550
551	<	function TFBArrayMetaData.GetSQLTypeName: string;
551	>	function TFBArrayMetaData.GetSQLTypeName: AnsiString;
552		begin
553		Result := TSQLDataItem.GetSQLTypeName(GetSQLType);
554		end;
#	Line 555 | Line 563 | begin
563		Result := FArrayDesc.array_desc_length;
564		end;
565
566	<	function TFBArrayMetaData.GetTableName: string;
566	>	function TFBArrayMetaData.GetTableName: AnsiString;
567		begin
568		with FArrayDesc do
569	<	SetString(Result,PChar(@array_desc_relation_name),sizeof(array_desc_relation_name));
569	>	SetString(Result,PAnsiChar(@array_desc_relation_name),sizeof(array_desc_relation_name));
570		Result := trim(Result);
571		end;
572
573	<	function TFBArrayMetaData.GetColumnName: string;
573	>	function TFBArrayMetaData.GetColumnName: AnsiString;
574		begin
575		with FArrayDesc do
576	<	SetString(Result,PChar(@FArrayDesc.array_desc_field_name),sizeof(array_desc_field_name));
576	>	SetString(Result,PAnsiChar(@FArrayDesc.array_desc_field_name),sizeof(array_desc_field_name));
577		Result := trim(Result);
578		end;
579
#	Line 620 | Line 628 | begin
628		Result := 1;
629		Bounds := GetBounds;
630		for i := 0 to Length(Bounds) - 1 do
631	<	Result *= (Bounds[i].UpperBound - Bounds[i].LowerBound + 1);
631	>	Result := Result * (Bounds[i].UpperBound - Bounds[i].LowerBound + 1);
632		end;
633
634
#	Line 643 | Line 651 | begin
651		FElementSize := FArrayDesc.array_desc_length;
652		case GetSQLType of
653		SQL_VARYING:
654	<	FElementSize += 2;
654	>	FElementSize := FElementSize + 2;
655		SQL_TEXT:
656	<	FElementSize += 1;
656	>	FElementSize := FElementSize + 1;
657		end;
658		FBufSize := FElementSize * l;
659
660	<	with FirebirdClientAPI do
660	>	with FFirebirdClientAPI do
661		IBAlloc(FBuffer,0,FBufSize);
662
663		Dims := GetDimensions;
#	Line 703 | Line 711 | begin
711		FIsNew := false;
712		end;
713
714	<	function TFBArray.GetOffset(index: array of integer): PChar;
714	>	function TFBArray.GetOffset(index: array of integer): PByte;
715		var i: integer;
716		Bounds: TArrayBounds;
717		FlatIndex: integer;
#	Line 718 | Line 726 | begin
726		if (index[i] < Bounds[i].LowerBound) or (index[i] > Bounds[i].UpperBound) then
727		IBError(ibxeInvalidSubscript,[index[i],i]);
728
729	<	FlatIndex += FOffsets[i]*(index[i] - Bounds[i].LowerBound);
729	>	FlatIndex := FlatIndex + FOffsets[i]*(index[i] - Bounds[i].LowerBound);
730		end;
731		Result := FBuffer + FlatIndex*FElementSize;
732		end;
#	Line 738 | Line 746 | begin
746		inherited Create(aTransaction);
747		FMetaData := aField;
748		FAttachment := aAttachment;
749	+	FFirebirdClientAPI := aTransaction.FirebirdAPI;
750		FTransactionIntf :=  aTransaction;
751		FTransactionSeqNo := aTransaction.TransactionSeqNo;
752		FIsNew := true;
#	Line 826 | Line 835 | begin
835		Result := FMetaData.GetSQLType;
836		end;
837
838	<	function TFBArray.GetSQLTypeName: string;
838	>	function TFBArray.GetSQLTypeName: AnsiString;
839		begin
840		Result := FMetaData.GetSQLTypeName;
841		end;
#	Line 846 | Line 855 | begin
855		Result := FMetaData.GetCharSetID;
856		end;
857
858	<	function TFBArray.GetTableName: string;
858	>	function TFBArray.GetTableName: AnsiString;
859		begin
860		Result := FMetaData.GetTableName;
861		end;
862
863	<	function TFBArray.GetColumnName: string;
863	>	function TFBArray.GetColumnName: AnsiString;
864		begin
865		Result := FMetaData.GetColumnName;
866		end;
#	Line 929 | Line 938 | begin
938		Result := FElement.GetAsShort;
939		end;
940
941	<	function TFBArray.GetAsString(index: array of integer): String;
941	>	function TFBArray.GetAsString(index: array of integer): AnsiString;
942		begin
943		GetArraySlice;
944		FElement.FBufPtr := GetOffset(index);
#	Line 1009 | Line 1018 | begin
1018		FElement.SetAsShort(Value);
1019		end;
1020
1021	<	procedure TFBArray.SetAsString(index: array of integer; Value: String);
1021	>	procedure TFBArray.SetAsString(index: array of integer; Value: AnsiString);
1022		begin
1023		FElement.FBufPtr := GetOffset(index);
1024		FElement.SetAsString(Value);
#	Line 1062 | Line 1071 | procedure TFBArray.RemoveEventHandler(Ha
1071		var i,j : integer;
1072		begin
1073		for i := Length(FEventHandlers) - 1 downto 0 do
1074	<	if FEventHandlers[i] = Handler then
1074	>	if (TMethod(FEventHandlers[i]).Code = TMethod(Handler).Code) and
1075	>	(TMethod(FEventHandlers[i]).Data = TMethod(Handler).Data) then
1076		begin
1077		for j := i to Length(FEventHandlers) - 2 do
1078		FEventHandlers[i] := FEventHandlers[i+1];

Diff Legend

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