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 59 by tony, Mon Mar 13 09:51:56 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 106 | Line 109 | type
109		FArrayDesc: TISC_ARRAY_DESC;
110		FCharSetID: integer;
111		procedure LoadMetaData(aAttachment: IAttachment; aTransaction: ITransaction;
112	<	relationName, columnName: string); virtual; abstract;
112	>	relationName, columnName: AnsiString); virtual; abstract;
113		function NumOfElements: integer;
114		public
115		constructor Create(aAttachment: IAttachment; aTransaction: ITransaction;
116	<	relationName, columnName: string); overload;
117	<	constructor Create(SQLType: cardinal; tableName: string; columnName: string;
116	>	relationName, columnName: AnsiString); overload;
117	>	constructor Create(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
118		Scale: integer; size: cardinal; charSetID: cardinal;
119		dimensions: cardinal; bounds: TArrayBounds); overload;
120		function GetCodePage: TSystemCodePage; virtual; abstract;
#	Line 119 | Line 122 | type
122		public
123		{IArrayMetaData}
124		function GetSQLType: cardinal;
125	<	function GetSQLTypeName: string;
125	>	function GetSQLTypeName: AnsiString;
126		function GetScale: integer;
127		function GetSize: cardinal;
128		function GetCharSetID: cardinal; virtual; abstract;
129	<	function GetTableName: string;
130	<	function GetColumnName: string;
129	>	function GetTableName: AnsiString;
130	>	function GetColumnName: AnsiString;
131		function GetDimensions: integer;
132		function GetBounds: TArrayBounds;
133		end;
#	Line 149 | Line 152 | type
152		FEventHandlers: array of TArrayEventHandler;
153		procedure GetArraySlice;
154		procedure PutArraySlice(Force: boolean=false);
155	<	function GetOffset(index: array of integer): PChar;
155	>	function GetOffset(index: array of integer): PByte;
156		function GetDataLength: short;
157		protected
158	<	FBuffer: PChar;
158	>	FBuffer: PByte;
159		FBufSize: ISC_LONG;
160		FArrayID: TISC_QUAD;
161		procedure AllocateBuffer; virtual;
#	Line 173 | Line 176 | type
176		public
177		{IArrayMetaData}
178		function GetSQLType: cardinal;
179	<	function GetSQLTypeName: string;
179	>	function GetSQLTypeName: AnsiString;
180		function GetScale: integer;
181		function GetSize: cardinal;
182		function GetCharSetID: cardinal;
183	<	function GetTableName: string;
184	<	function GetColumnName: string;
183	>	function GetTableName: AnsiString;
184	>	function GetColumnName: AnsiString;
185		function GetDimensions: integer;
186		function GetBounds: TArrayBounds;
187		{IArray}
#	Line 197 | Line 200 | type
200		function GetAsFloat(index: array of integer): Float;
201		function GetAsLong(index: array of integer): Long;
202		function GetAsShort(index: array of integer): Short;
203	<	function GetAsString(index: array of integer): String;
203	>	function GetAsString(index: array of integer): AnsiString;
204		function GetAsVariant(index: array of integer): Variant;
205		procedure SetAsInteger(index: array of integer; AValue: integer);
206		procedure SetAsBoolean(index: array of integer; AValue: boolean);
#	Line 210 | Line 213 | type
213		procedure SetAsDouble(index: array of integer; Value: Double);
214		procedure SetAsFloat(index: array of integer; Value: Float);
215		procedure SetAsShort(index: array of integer; Value: Short);
216	<	procedure SetAsString(index: array of integer; Value: String);
216	>	procedure SetAsString(index: array of integer; Value: AnsiString);
217		procedure SetAsVariant(index: array of integer; Value: Variant);
218		procedure SetBounds(dim, UpperBound, LowerBound: integer);
219		function GetAttachment: IAttachment;
#	Line 242 | Line 245 | begin
245		FArray.Changed;
246		end;
247
248	<	function TFBArrayElement.SQLData: PChar;
248	>	function TFBArrayElement.SQLData: PByte;
249		begin
250		Result := FBufPtr;
251		end;
#	Line 268 | Line 271 | begin
271		IBError(ibxeArrayElementOverFlow,[nil]);
272		end;
273
274	<	constructor TFBArrayElement.Create(anArray: TFBArray; P: PChar);
274	>	constructor TFBArrayElement.Create(anArray: TFBArray; P: PByte);
275		begin
276		inherited Create;
277		FArray := anArray;
#	Line 280 | Line 283 | begin
283		Result :=  FArray.FMetaData.GetSQLType;
284		end;
285
286	<	function TFBArrayElement.GetName: string;
286	>	function TFBArrayElement.GetName: AnsiString;
287		begin
288		Result := FArray.FMetaData.GetColumnName;
289		end;
#	Line 295 | Line 298 | begin
298		Result := GetDataLength;
299		end;
300
301	<	function TFBArrayElement.GetAsString: string;
301	>	function TFBArrayElement.GetAsString: AnsiString;
302		var rs: RawByteString;
303		begin
304		case GetSQLType of
305		SQL_VARYING:
306		begin
307	<	rs := strpas(FBufPtr);
307	>	rs := strpas(PAnsiChar(FBufPtr));
308		SetCodePage(rs,GetCodePage,false);
309		Result := rs;
310		end;
311		SQL_TEXT:
312		begin
313	<	SetString(rs,FBufPtr,GetDataLength);
313	>	SetString(rs,PAnsiChar(FBufPtr),GetDataLength);
314		SetCodePage(rs,GetCodePage,false);
315		Result := rs;
316		end
#	Line 349 | Line 352 | begin
352		Changed;
353		end;
354
355	<	procedure TFBArrayElement.SetAsString(Value: String);
355	>	procedure TFBArrayElement.SetAsString(Value: AnsiString);
356		var len: integer;
357		ElementSize: integer;
358		begin
359		CheckActive;
360		case GetSQLType of
361		SQL_BOOLEAN:
362	<	if CompareText(Value,STrue) = 0 then
362	>	if AnsiCompareText(Value,STrue) = 0 then
363		AsBoolean := true
364		else
365	<	if CompareText(Value,SFalse) = 0 then
365	>	if AnsiCompareText(Value,SFalse) = 0 then
366		AsBoolean := false
367		else
368		IBError(ibxeInvalidDataConversion,[nil]);
#	Line 374 | Line 377 | begin
377		if Len > 0 then
378		Move(Value[1],FBufPtr^,len);
379		if Len < ElementSize - 2 then
380	<	(FBufPtr+len)^ := #0;
380	>	(FBufPtr+len)^ := 0;
381		Changed;
382		end;
383
#	Line 395 | Line 398 | begin
398		if trim(Value) = '' then
399		SetAsInt64(0)
400		else
401	<	SetAsInt64(StrToInt(Value));
401	>	SetAsInt64(AdjustScaleFromCurrency(StrToCurr(Value),GetScale));
402
403		SQL_D_FLOAT,
404		SQL_DOUBLE,
#	Line 480 | Line 483 | end;
483		{TFBArrayMetaData}
484
485		constructor TFBArrayMetaData.Create(aAttachment: IAttachment;
486	<	aTransaction: ITransaction; relationName, columnName: string);
486	>	aTransaction: ITransaction; relationName, columnName: AnsiString);
487		begin
488		inherited Create;
489		LoadMetaData(aAttachment,aTransaction,relationName, columnName);
490		end;
491
492	<	constructor TFBArrayMetaData.Create(SQLType: cardinal; tableName: string;
493	<	columnName: string; Scale: integer; size: cardinal; charSetID: cardinal;
492	>	constructor TFBArrayMetaData.Create(SQLType: cardinal; tableName: AnsiString;
493	>	columnName: AnsiString; Scale: integer; size: cardinal; charSetID: cardinal;
494		dimensions: cardinal; bounds: TArrayBounds);
495		var i: integer;
496		begin
#	Line 495 | Line 498 | begin
498		with FArrayDesc do
499		begin
500		array_desc_dtype := GetDType(SQLType);
501	<	array_desc_scale := char(Scale);
501	>	array_desc_scale := Scale;
502		array_desc_length := UShort(size);
503		StrPLCopy(array_desc_field_name,columnName,sizeof(array_desc_field_name));
504		StrPLCopy(array_desc_relation_name,tableName,sizeof(array_desc_relation_name));
#	Line 540 | Line 543 | begin
543		end;
544		end;
545
546	<	function TFBArrayMetaData.GetSQLTypeName: string;
546	>	function TFBArrayMetaData.GetSQLTypeName: AnsiString;
547		begin
548		Result := TSQLDataItem.GetSQLTypeName(GetSQLType);
549		end;
#	Line 555 | Line 558 | begin
558		Result := FArrayDesc.array_desc_length;
559		end;
560
561	<	function TFBArrayMetaData.GetTableName: string;
561	>	function TFBArrayMetaData.GetTableName: AnsiString;
562		begin
563		with FArrayDesc do
564	<	SetString(Result,PChar(@array_desc_relation_name),sizeof(array_desc_relation_name));
564	>	SetString(Result,PAnsiChar(@array_desc_relation_name),sizeof(array_desc_relation_name));
565		Result := trim(Result);
566		end;
567
568	<	function TFBArrayMetaData.GetColumnName: string;
568	>	function TFBArrayMetaData.GetColumnName: AnsiString;
569		begin
570		with FArrayDesc do
571	<	SetString(Result,PChar(@FArrayDesc.array_desc_field_name),sizeof(array_desc_field_name));
571	>	SetString(Result,PAnsiChar(@FArrayDesc.array_desc_field_name),sizeof(array_desc_field_name));
572		Result := trim(Result);
573		end;
574
#	Line 620 | Line 623 | begin
623		Result := 1;
624		Bounds := GetBounds;
625		for i := 0 to Length(Bounds) - 1 do
626	<	Result *= (Bounds[i].UpperBound - Bounds[i].LowerBound + 1);
626	>	Result := Result * (Bounds[i].UpperBound - Bounds[i].LowerBound + 1);
627		end;
628
629
#	Line 643 | Line 646 | begin
646		FElementSize := FArrayDesc.array_desc_length;
647		case GetSQLType of
648		SQL_VARYING:
649	<	FElementSize += 2;
649	>	FElementSize := FElementSize + 2;
650		SQL_TEXT:
651	<	FElementSize += 1;
651	>	FElementSize := FElementSize + 1;
652		end;
653		FBufSize := FElementSize * l;
654
#	Line 703 | Line 706 | begin
706		FIsNew := false;
707		end;
708
709	<	function TFBArray.GetOffset(index: array of integer): PChar;
709	>	function TFBArray.GetOffset(index: array of integer): PByte;
710		var i: integer;
711		Bounds: TArrayBounds;
712		FlatIndex: integer;
#	Line 718 | Line 721 | begin
721		if (index[i] < Bounds[i].LowerBound) or (index[i] > Bounds[i].UpperBound) then
722		IBError(ibxeInvalidSubscript,[index[i],i]);
723
724	<	FlatIndex += FOffsets[i]*(index[i] - Bounds[i].LowerBound);
724	>	FlatIndex := FlatIndex + FOffsets[i]*(index[i] - Bounds[i].LowerBound);
725		end;
726		Result := FBuffer + FlatIndex*FElementSize;
727		end;
#	Line 826 | Line 829 | begin
829		Result := FMetaData.GetSQLType;
830		end;
831
832	<	function TFBArray.GetSQLTypeName: string;
832	>	function TFBArray.GetSQLTypeName: AnsiString;
833		begin
834		Result := FMetaData.GetSQLTypeName;
835		end;
#	Line 846 | Line 849 | begin
849		Result := FMetaData.GetCharSetID;
850		end;
851
852	<	function TFBArray.GetTableName: string;
852	>	function TFBArray.GetTableName: AnsiString;
853		begin
854		Result := FMetaData.GetTableName;
855		end;
856
857	<	function TFBArray.GetColumnName: string;
857	>	function TFBArray.GetColumnName: AnsiString;
858		begin
859		Result := FMetaData.GetColumnName;
860		end;
#	Line 929 | Line 932 | begin
932		Result := FElement.GetAsShort;
933		end;
934
935	<	function TFBArray.GetAsString(index: array of integer): String;
935	>	function TFBArray.GetAsString(index: array of integer): AnsiString;
936		begin
937		GetArraySlice;
938		FElement.FBufPtr := GetOffset(index);
#	Line 1009 | Line 1012 | begin
1012		FElement.SetAsShort(Value);
1013		end;
1014
1015	<	procedure TFBArray.SetAsString(index: array of integer; Value: String);
1015	>	procedure TFBArray.SetAsString(index: array of integer; Value: AnsiString);
1016		begin
1017		FElement.FBufPtr := GetOffset(index);
1018		FElement.SetAsString(Value);
#	Line 1062 | Line 1065 | procedure TFBArray.RemoveEventHandler(Ha
1065		var i,j : integer;
1066		begin
1067		for i := Length(FEventHandlers) - 1 downto 0 do
1068	<	if FEventHandlers[i] = Handler then
1068	>	if (TMethod(FEventHandlers[i]).Code = TMethod(Handler).Code) and
1069	>	(TMethod(FEventHandlers[i]).Data = TMethod(Handler).Data) then
1070		begin
1071		for j := i to Length(FEventHandlers) - 2 do
1072		FEventHandlers[i] := FEventHandlers[i+1];

Diff Legend

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