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 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 56 by tony, Mon Mar 6 10:20: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 99 | Line 103 | type
103		{ TFBArrayMetaData }
104
105		TFBArrayMetaData = class(TFBInterfacedObject,IArrayMetaData)
106	+	private
107	+	function GetDType(SQLType: cardinal): UChar;
108		protected
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);
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;
121
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 142 | 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 166 | 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 190 | 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 203 | 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 235 | 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 250 | Line 260 | begin
260		Result := (FArray.FMetaData as TFBArrayMetaData).GetCodePage;
261		end;
262
263	+	function TFBArrayElement.getCharSetID: cardinal;
264	+	begin
265	+	Result := (FArray.FMetaData as TFBArrayMetaData).GetCharSetID;
266	+	end;
267	+
268		procedure TFBArrayElement.SetDataLength(len: cardinal);
269		begin
270		if len > GetDataLength then
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 268 | 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 283 | 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 337 | 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 362 | 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 468 | 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: AnsiString;
493	+	columnName: AnsiString; Scale: integer; size: cardinal; charSetID: cardinal;
494	+	dimensions: cardinal; bounds: TArrayBounds);
495	+	var i: integer;
496	+	begin
497	+	inherited Create;
498	+	with FArrayDesc do
499	+	begin
500	+	array_desc_dtype := GetDType(SQLType);
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));
505	+	array_desc_dimensions := dimensions;
506	+	array_desc_flags := 0;
507	+	FCharSetID := charSetID;
508	+	for i := 0 to Length(bounds) - 1 do
509	+	begin
510	+	array_desc_bounds[i].array_bound_lower := bounds[i].LowerBound;
511	+	array_desc_bounds[i].array_bound_upper := bounds[i].UpperBound;
512	+	end;
513	+	end;
514	+	end;
515	+
516		function TFBArrayMetaData.GetSQLType: cardinal;
517		begin
518		case  FArrayDesc.array_desc_dtype of
#	Line 504 | 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 519 | 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 549 | Line 588 | begin
588		end;
589		end;
590
591	+	function TFBArrayMetaData.GetDType(SQLType: cardinal): UChar;
592	+	begin
593	+	case  SQLType of
594	+	SQL_TEXT:
595	+	Result := blr_text;
596	+	SQL_SHORT:
597	+	Result :=  blr_short;
598	+	SQL_LONG:
599	+	Result := blr_long;
600	+	SQL_QUAD:
601	+	Result := blr_quad;
602	+	SQL_FLOAT:
603	+	Result := blr_float;
604	+	SQL_D_FLOAT:
605	+	Result := blr_double;
606	+	SQL_TIMESTAMP:
607	+	Result := blr_timestamp;
608	+	SQL_VARYING:
609	+	Result := blr_varying;
610	+	SQL_TYPE_DATE:
611	+	Result := blr_sql_date;
612	+	SQL_TYPE_TIME:
613	+	Result :=  blr_sql_time;
614	+	SQL_INT64:
615	+	Result := blr_int64;
616	+	end;
617	+	end;
618	+
619		function TFBArrayMetaData.NumOfElements: integer;
620		var i: integer;
621		Bounds: TArrayBounds;
#	Line 556 | 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 579 | 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 639 | 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 654 | 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 762 | 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 782 | 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 865 | 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 945 | 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 998 | 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