ViewVC Help

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

root/public/ibx/trunk/runtime/IBSQL.pas

Comparing ibx/trunk/runtime/IBSQL.pas (file contents):
Revision 19 by tony, Mon Jul 7 13:00:15 2014 UTC vs.
Revision 39 by tony, Tue May 17 08:14:52 2016 UTC

#	Line 35 | Line 35 | unit IBSQL;
35
36		{$Mode Delphi}
37
38	+	{$IF FPC_FULLVERSION >= 20700 }
39	+	{$codepage UTF8}
40	+	{$ENDIF}
41	+
42		{ IBSQL param names in dialect 3 quoted format (e.g. :"MyParam") are by default disabled.
43
44		Dialect 3 quoted format parameter names represent a significant overhead and are of
#	Line 76 | Line 80 | uses
80		{$ELSE}
81		baseunix, unix,
82		{$ENDIF}
83	<	SysUtils, Classes, Forms, Controls, IBHeader,
83	>	SysUtils, Classes, IBHeader,
84		IBErrorCodes, IBExternals, DB, IB, IBDatabase, IBUtils, IBXConst;
85
86	+	const
87	+	sSQLErrorSeparator = ' When Executing: ';
88	+
89		type
90		TIBSQL = class;
91		TIBXSQLDA = class;
#	Line 97 | Line 104 | type
104		function AdjustScale(Value: Int64; Scale: Integer): Double;
105		function AdjustScaleToInt64(Value: Int64; Scale: Integer): Int64;
106		function AdjustScaleToCurrency(Value: Int64; Scale: Integer): Currency;
107	+	function GetAsBoolean: boolean;
108		function GetAsCurrency: Currency;
109		function GetAsInt64: Int64;
110		function GetAsDateTime: TDateTime;
#	Line 113 | Line 121 | type
121		function GetIsNullable: Boolean;
122		function GetSize: Integer;
123		function GetSQLType: Integer;
124	+	procedure SetAsBoolean(AValue: boolean);
125		procedure SetAsCurrency(Value: Currency);
126		procedure SetAsInt64(Value: Int64);
127		procedure SetAsDate(Value: TDateTime);
128	+	procedure SetAsLong(Value: Long);
129		procedure SetAsTime(Value: TDateTime);
130		procedure SetAsDateTime(Value: TDateTime);
131		procedure SetAsDouble(Value: Double);
132		procedure SetAsFloat(Value: Float);
123	–	procedure SetAsLong(Value: Long);
133		procedure SetAsPointer(Value: Pointer);
134		procedure SetAsQuad(Value: TISC_QUAD);
135		procedure SetAsShort(Value: Short);
#	Line 129 | Line 138 | type
138		procedure SetAsXSQLVAR(Value: PXSQLVAR);
139		procedure SetIsNull(Value: Boolean);
140		procedure SetIsNullable(Value: Boolean);
141	+	procedure xSetAsBoolean(AValue: boolean);
142		procedure xSetAsCurrency(Value: Currency);
143		procedure xSetAsInt64(Value: Int64);
144		procedure xSetAsDate(Value: TDateTime);
#	Line 154 | Line 164 | type
164		procedure SaveToFile(const FileName: String);
165		procedure SaveToStream(Stream: TStream);
166		property AsDate: TDateTime read GetAsDateTime write SetAsDate;
167	+	property AsBoolean:boolean read GetAsBoolean write SetAsBoolean;
168		property AsTime: TDateTime read GetAsDateTime write SetAsTime;
169		property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
170		property AsDouble: Double read GetAsDouble write SetAsDouble;
#	Line 321 | Line 332 | type
332		TIBSQL = class(TComponent)
333		private
334		FIBLoaded: Boolean;
335	+	FOnSQLChanged: TNotifyEvent;
336		FUniqueParamNames: Boolean;
337		function GetFieldCount: integer;
338		procedure SetUniqueParamNames(AValue: Boolean);
#	Line 359 | Line 371 | type
371		procedure SetSQL(Value: TStrings);
372		procedure SetTransaction(Value: TIBTransaction);
373		procedure SQLChanging(Sender: TObject);
374	<	procedure BeforeTransactionEnd(Sender: TObject);
374	>	procedure SQLChanged(Sender: TObject);
375	>	procedure BeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
376		public
377		constructor Create(AOwner: TComponent); override;
378		destructor Destroy; override;
#	Line 405 | Line 418 | type
418		property SQL: TStrings read FSQL write SetSQL;
419		property Transaction: TIBTransaction read GetTransaction write SetTransaction;
420		property OnSQLChanging: TNotifyEvent read FOnSQLChanging write FOnSQLChanging;
421	+	property OnSQLChanged: TNotifyEvent read FOnSQLChanged write FOnSQLChanged;
422		end;
423
424		implementation
#	Line 585 | Line 599 | begin
599		result := Value;
600		end;
601
602	+	function TIBXSQLVAR.GetAsBoolean: boolean;
603	+	begin
604	+	result := false;
605	+	if not IsNull then
606	+	begin
607	+	if FXSQLVAR^.sqltype and (not 1) = SQL_BOOLEAN then
608	+	result := PByte(FXSQLVAR^.sqldata)^ = ISC_TRUE
609	+	else
610	+	IBError(ibxeInvalidDataConversion, [nil]);
611	+	end
612	+	end;
613	+
614		function TIBXSQLVAR.GetAsCurrency: Currency;
615		begin
616		result := 0;
#	Line 896 | Line 922 | begin
922		result := AsDouble;
923		SQL_INT64:
924		if FXSQLVAR^.sqlscale = 0 then
925	<	IBError(ibxeInvalidDataConversion, [nil])
925	>	result := AsInt64
926		else if FXSQLVAR^.sqlscale >= (-4) then
927		result := AsCurrency
928		else
929		result := AsDouble;
930		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
931		result := AsDouble;
932	+	SQL_BOOLEAN:
933	+	result := AsBoolean;
934		else
935		IBError(ibxeInvalidDataConversion, [nil]);
936		end;
#	Line 991 | Line 1019 | begin
1019		result := FXSQLVAR^.sqltype and (not 1);
1020		end;
1021
1022	+	procedure TIBXSQLVAR.SetAsBoolean(AValue: boolean);
1023	+	var
1024	+	i: Integer;
1025	+	begin
1026	+	if FUniqueName then
1027	+	xSetAsBoolean(AValue)
1028	+	else
1029	+	for i := 0 to FParent.FCount - 1 do
1030	+	if FParent[i].FName = FName then
1031	+	FParent[i].xSetAsBoolean(AValue);
1032	+	end;
1033	+
1034		procedure TIBXSQLVAR.xSetAsCurrency(Value: Currency);
1035		begin
1036		if IsNullable then
#	Line 1398 | Line 1438 | begin
1438		varCurrency:
1439		AsCurrency := Value;
1440		varBoolean:
1441	<	if Value then
1402	<	AsLong := ISC_TRUE
1403	<	else
1404	<	AsLong := ISC_FALSE;
1441	>	AsBoolean := Value;
1442		varDate:
1443		AsDateTime := Value;
1444		varOleStr, varString:
#	Line 1528 | Line 1565 | begin
1565		FParent[i].xSetIsNullable(Value);
1566		end;
1567
1568	+	procedure TIBXSQLVAR.xSetAsBoolean(AValue: boolean);
1569	+	begin
1570	+	if IsNullable then
1571	+	IsNull := False;
1572	+
1573	+	FXSQLVAR^.sqltype := SQL_BOOLEAN;
1574	+	FXSQLVAR^.sqllen := 1;
1575	+	FXSQLVAR^.sqlscale := 0;
1576	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1577	+	if AValue then
1578	+	PByte(FXSQLVAR^.sqldata)^ := ISC_TRUE
1579	+	else
1580	+	PByte(FXSQLVAR^.sqldata)^ := ISC_FALSE;
1581	+	FModified := True;
1582	+	end;
1583	+
1584		procedure TIBXSQLVAR.Clear;
1585		begin
1586		IsNull := true;
#	Line 1721 | Line 1774 | begin
1774
1775		case sqltype and (not 1) of
1776		SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
1777	<	SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT,
1777	>	SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
1778		SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: begin
1779		if (sqllen = 0) then
1780		{ Make sure you get a valid pointer anyway
#	Line 2091 | Line 2144 | end;
2144
2145		{ TIBSQL }
2146		constructor TIBSQL.Create(AOwner: TComponent);
2147	+	var  GUID : TGUID;
2148		begin
2149		inherited Create(AOwner);
2150		FIBLoaded := False;
#	Line 2107 | Line 2161 | begin
2161		FRecordCount := 0;
2162		FSQL := TStringList.Create;
2163		TStringList(FSQL).OnChanging := SQLChanging;
2164	+	TStringList(FSQL).OnChange := SQLChanged;
2165		FProcessedSQL := TStringList.Create;
2166		FHandle := nil;
2167		FSQLParams := TIBXSQLDA.Create(self,daInput);
2168		FSQLRecord := TIBXSQLDA.Create(self,daOutput);
2169		FSQLType := SQLUnknown;
2170		FParamCheck := True;
2171	<	FCursor := Name + RandomString(8);
2171	>	CreateGuid(GUID);
2172	>	FCursor := GUIDToString(GUID);
2173		if AOwner is TIBDatabase then
2174		Database := TIBDatabase(AOwner)
2175		else
#	Line 2265 | Line 2321 | begin
2321		FBOF := True;
2322		FEOF := False;
2323		FRecordCount := 0;
2324	+	if not (csDesigning in ComponentState) then
2325	+	MonitorHook.SQLExecute(Self);
2326		if FGoToFirstRecordOnExecute then
2327		Next;
2328		end;
#	Line 2275 | Line 2333 | begin
2333		Database.SQLDialect,
2334		FSQLParams.AsXSQLDA,
2335		FSQLRecord.AsXSQLDA), True);
2336	+	if not (csDesigning in ComponentState) then
2337	+	MonitorHook.SQLExecute(Self);
2338		(*      if (fetch_res <> 0) and (fetch_res <> isc_deadlock) then
2339		begin
2340		{ Sometimes a prepared stored procedure appears to get
#	Line 2297 | Line 2357 | begin
2357		TRHandle,
2358		@FHandle,
2359		Database.SQLDialect,
2360	<	FSQLParams.AsXSQLDA), True)
2360	>	FSQLParams.AsXSQLDA), True);
2361	>	if not (csDesigning in ComponentState) then
2362	>	MonitorHook.SQLExecute(Self);
2363		end;
2364	<	if not (csDesigning in ComponentState) then
2365	<	MonitorHook.SQLExecute(Self);
2364	>	FBase.DoAfterExecQuery(self);
2365	>	//  writeln('Rows Affected = ',RowsAffected);
2366		end;
2367
2368		function TIBSQL.GetEOF: Boolean;
#	Line 2412 | Line 2474 | begin
2474		SQLUpdate, SQLDelete])) then
2475		result := ''
2476		else begin
2477	<	info_request := Char(isc_info_sql_get_plan);
2477	>	info_request := isc_info_sql_get_plan;
2478		Call(isc_dsql_sql_info(StatusVector, @FHandle, 2, @info_request,
2479		SizeOf(result_buffer), result_buffer), True);
2480	<	if (result_buffer[0] <> Char(isc_info_sql_get_plan)) then
2480	>	if (result_buffer[0] <> isc_info_sql_get_plan) then
2481		IBError(ibxeUnknownError, [nil]);
2482		result_length := isc_vax_integer(@result_buffer[1], 2);
2483		SetString(result, nil, result_length);
#	Line 2432 | Line 2494 | end;
2494
2495		function TIBSQL.GetRowsAffected: Integer;
2496		var
2435	–	result_buffer: array[0..1048] of Char;
2497		info_request: Char;
2498	+	RB: TResultBuffer;
2499		begin
2500		if not Prepared then
2501		result := -1
2502		else begin
2503	<	info_request := Char(isc_info_sql_records);
2504	<	if isc_dsql_sql_info(StatusVector, @FHandle, 1, @info_request,
2505	<	SizeOf(result_buffer), result_buffer) > 0 then
2506	<	IBDatabaseError;
2507	<	if (result_buffer[0] <> Char(isc_info_sql_records)) then
2508	<	result := -1
2509	<	else
2510	<	case SQLType of
2511	<	SQLUpdate:   Result := isc_vax_integer(@result_buffer[6], 4);
2512	<	SQLDelete:   Result := isc_vax_integer(@result_buffer[13], 4);
2513	<	SQLInsert:   Result := isc_vax_integer(@result_buffer[27], 4);
2514	<	else         Result := -1 ;
2515	<	end ;
2503	>	RB := TResultBuffer.Create;
2504	>	try
2505	>	info_request := isc_info_sql_records;
2506	>	if isc_dsql_sql_info(StatusVector, @FHandle, 1, @info_request,
2507	>	RB.Size, RB.buffer) > 0 then
2508	>	IBDatabaseError;
2509	>	case SQLType of
2510	>	SQLInsert, SQLUpdate: {Covers Insert or Update as well as individual update}
2511	>	Result := RB.GetValue(isc_info_sql_records, isc_info_req_insert_count)+
2512	>	RB.GetValue(isc_info_sql_records, isc_info_req_update_count);
2513	>	SQLDelete:
2514	>	Result := RB.GetValue(isc_info_sql_records, isc_info_req_delete_count);
2515	>	SQLExecProcedure:
2516	>	Result :=  RB.GetValue(isc_info_sql_records, isc_info_req_insert_count) +
2517	>	RB.GetValue(isc_info_sql_records, isc_info_req_update_count) +
2518	>	RB.GetValue(isc_info_sql_records, isc_info_req_delete_count);
2519	>	else
2520	>	Result := 0;
2521	>	end;
2522	>	finally
2523	>	RB.Free;
2524	>	end;
2525		end;
2526		end;
2527
#	Line 2502 | Line 2573 | const
2573		end;
2574
2575		begin
2576	+	sParamName := '';
2577		slNames := TStringList.Create;
2578		try
2579		{ Do some initializations of variables }
#	Line 2662 | Line 2734 | begin
2734		{ After preparing the statement, query the stmt type and possibly
2735		create a FSQLRecord "holder" }
2736		{ Get the type of the statement }
2737	<	type_item := Char(isc_info_sql_stmt_type);
2737	>	type_item := isc_info_sql_stmt_type;
2738		Call(isc_dsql_sql_info(StatusVector, @FHandle, 1, @type_item,
2739		SizeOf(res_buffer), res_buffer), True);
2740	<	if (res_buffer[0] <> Char(isc_info_sql_stmt_type)) then
2740	>	if (res_buffer[0] <> isc_info_sql_stmt_type) then
2741		IBError(ibxeUnknownError, [nil]);
2742		stmt_len := isc_vax_integer(@res_buffer[1], 2);
2743		FSQLType := TIBSQLTypes(isc_vax_integer(@res_buffer[3], stmt_len));
#	Line 2710 | Line 2782 | begin
2782		on E: Exception do begin
2783		if (FHandle <> nil) then
2784		FreeHandle;
2785	<	raise;
2785	>	if E is EIBInterBaseError then
2786	>	raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode,
2787	>	EIBInterBaseError(E).IBErrorCode,
2788	>	EIBInterBaseError(E).Message +
2789	>	sSQLErrorSeparator + FProcessedSQL.Text)
2790	>	else
2791	>	raise;
2792		end;
2793		end;
2794		end;
#	Line 2748 | Line 2826 | begin
2826		if FHandle <> nil then FreeHandle;
2827		end;
2828
2829	<	procedure TIBSQL.BeforeTransactionEnd(Sender: TObject);
2829	>	procedure TIBSQL.SQLChanged(Sender: TObject);
2830	>	begin
2831	>	if assigned(OnSQLChanged) then
2832	>	OnSQLChanged(self);
2833	>	end;
2834	>
2835	>	procedure TIBSQL.BeforeTransactionEnd(Sender: TObject;
2836	>	Action: TTransactionAction);
2837		begin
2838		if (FOpen) then
2839		Close;

Diff Legend

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