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 35 by tony, Tue Jan 26 14:38:47 2016 UTC

#	Line 76 | Line 76 | uses
76		{$ELSE}
77		baseunix, unix,
78		{$ENDIF}
79	<	SysUtils, Classes, Forms, Controls, IBHeader,
79	>	SysUtils, Classes, IBHeader,
80		IBErrorCodes, IBExternals, DB, IB, IBDatabase, IBUtils, IBXConst;
81
82	+	const
83	+	sSQLErrorSeparator = ' When Executing: ';
84	+
85		type
86		TIBSQL = class;
87		TIBXSQLDA = class;
#	Line 97 | Line 100 | type
100		function AdjustScale(Value: Int64; Scale: Integer): Double;
101		function AdjustScaleToInt64(Value: Int64; Scale: Integer): Int64;
102		function AdjustScaleToCurrency(Value: Int64; Scale: Integer): Currency;
103	+	function GetAsBoolean: boolean;
104		function GetAsCurrency: Currency;
105		function GetAsInt64: Int64;
106		function GetAsDateTime: TDateTime;
#	Line 113 | Line 117 | type
117		function GetIsNullable: Boolean;
118		function GetSize: Integer;
119		function GetSQLType: Integer;
120	+	procedure SetAsBoolean(AValue: boolean);
121		procedure SetAsCurrency(Value: Currency);
122		procedure SetAsInt64(Value: Int64);
123		procedure SetAsDate(Value: TDateTime);
124	+	procedure SetAsLong(Value: Long);
125		procedure SetAsTime(Value: TDateTime);
126		procedure SetAsDateTime(Value: TDateTime);
127		procedure SetAsDouble(Value: Double);
128		procedure SetAsFloat(Value: Float);
123	–	procedure SetAsLong(Value: Long);
129		procedure SetAsPointer(Value: Pointer);
130		procedure SetAsQuad(Value: TISC_QUAD);
131		procedure SetAsShort(Value: Short);
#	Line 129 | Line 134 | type
134		procedure SetAsXSQLVAR(Value: PXSQLVAR);
135		procedure SetIsNull(Value: Boolean);
136		procedure SetIsNullable(Value: Boolean);
137	+	procedure xSetAsBoolean(AValue: boolean);
138		procedure xSetAsCurrency(Value: Currency);
139		procedure xSetAsInt64(Value: Int64);
140		procedure xSetAsDate(Value: TDateTime);
#	Line 154 | Line 160 | type
160		procedure SaveToFile(const FileName: String);
161		procedure SaveToStream(Stream: TStream);
162		property AsDate: TDateTime read GetAsDateTime write SetAsDate;
163	+	property AsBoolean:boolean read GetAsBoolean write SetAsBoolean;
164		property AsTime: TDateTime read GetAsDateTime write SetAsTime;
165		property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
166		property AsDouble: Double read GetAsDouble write SetAsDouble;
#	Line 321 | Line 328 | type
328		TIBSQL = class(TComponent)
329		private
330		FIBLoaded: Boolean;
331	+	FOnSQLChanged: TNotifyEvent;
332		FUniqueParamNames: Boolean;
333		function GetFieldCount: integer;
334		procedure SetUniqueParamNames(AValue: Boolean);
#	Line 359 | Line 367 | type
367		procedure SetSQL(Value: TStrings);
368		procedure SetTransaction(Value: TIBTransaction);
369		procedure SQLChanging(Sender: TObject);
370	<	procedure BeforeTransactionEnd(Sender: TObject);
370	>	procedure SQLChanged(Sender: TObject);
371	>	procedure BeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
372		public
373		constructor Create(AOwner: TComponent); override;
374		destructor Destroy; override;
#	Line 405 | Line 414 | type
414		property SQL: TStrings read FSQL write SetSQL;
415		property Transaction: TIBTransaction read GetTransaction write SetTransaction;
416		property OnSQLChanging: TNotifyEvent read FOnSQLChanging write FOnSQLChanging;
417	+	property OnSQLChanged: TNotifyEvent read FOnSQLChanged write FOnSQLChanged;
418		end;
419
420		implementation
#	Line 585 | Line 595 | begin
595		result := Value;
596		end;
597
598	+	function TIBXSQLVAR.GetAsBoolean: boolean;
599	+	begin
600	+	result := false;
601	+	if not IsNull then
602	+	begin
603	+	if FXSQLVAR^.sqltype and (not 1) = SQL_BOOLEAN then
604	+	result := PByte(FXSQLVAR^.sqldata)^ = ISC_TRUE
605	+	else
606	+	IBError(ibxeInvalidDataConversion, [nil]);
607	+	end
608	+	end;
609	+
610		function TIBXSQLVAR.GetAsCurrency: Currency;
611		begin
612		result := 0;
#	Line 896 | Line 918 | begin
918		result := AsDouble;
919		SQL_INT64:
920		if FXSQLVAR^.sqlscale = 0 then
921	<	IBError(ibxeInvalidDataConversion, [nil])
921	>	result := AsInt64
922		else if FXSQLVAR^.sqlscale >= (-4) then
923		result := AsCurrency
924		else
925		result := AsDouble;
926		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
927		result := AsDouble;
928	+	SQL_BOOLEAN:
929	+	result := AsBoolean;
930		else
931		IBError(ibxeInvalidDataConversion, [nil]);
932		end;
#	Line 991 | Line 1015 | begin
1015		result := FXSQLVAR^.sqltype and (not 1);
1016		end;
1017
1018	+	procedure TIBXSQLVAR.SetAsBoolean(AValue: boolean);
1019	+	var
1020	+	i: Integer;
1021	+	begin
1022	+	if FUniqueName then
1023	+	xSetAsBoolean(AValue)
1024	+	else
1025	+	for i := 0 to FParent.FCount - 1 do
1026	+	if FParent[i].FName = FName then
1027	+	FParent[i].xSetAsBoolean(AValue);
1028	+	end;
1029	+
1030		procedure TIBXSQLVAR.xSetAsCurrency(Value: Currency);
1031		begin
1032		if IsNullable then
#	Line 1398 | Line 1434 | begin
1434		varCurrency:
1435		AsCurrency := Value;
1436		varBoolean:
1437	<	if Value then
1402	<	AsLong := ISC_TRUE
1403	<	else
1404	<	AsLong := ISC_FALSE;
1437	>	AsBoolean := Value;
1438		varDate:
1439		AsDateTime := Value;
1440		varOleStr, varString:
#	Line 1528 | Line 1561 | begin
1561		FParent[i].xSetIsNullable(Value);
1562		end;
1563
1564	+	procedure TIBXSQLVAR.xSetAsBoolean(AValue: boolean);
1565	+	begin
1566	+	if IsNullable then
1567	+	IsNull := False;
1568	+
1569	+	FXSQLVAR^.sqltype := SQL_BOOLEAN;
1570	+	FXSQLVAR^.sqllen := 1;
1571	+	FXSQLVAR^.sqlscale := 0;
1572	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1573	+	if AValue then
1574	+	PByte(FXSQLVAR^.sqldata)^ := ISC_TRUE
1575	+	else
1576	+	PByte(FXSQLVAR^.sqldata)^ := ISC_FALSE;
1577	+	FModified := True;
1578	+	end;
1579	+
1580		procedure TIBXSQLVAR.Clear;
1581		begin
1582		IsNull := true;
#	Line 1721 | Line 1770 | begin
1770
1771		case sqltype and (not 1) of
1772		SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
1773	<	SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT,
1773	>	SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
1774		SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: begin
1775		if (sqllen = 0) then
1776		{ Make sure you get a valid pointer anyway
#	Line 2107 | Line 2156 | begin
2156		FRecordCount := 0;
2157		FSQL := TStringList.Create;
2158		TStringList(FSQL).OnChanging := SQLChanging;
2159	+	TStringList(FSQL).OnChange := SQLChanged;
2160		FProcessedSQL := TStringList.Create;
2161		FHandle := nil;
2162		FSQLParams := TIBXSQLDA.Create(self,daInput);
2163		FSQLRecord := TIBXSQLDA.Create(self,daOutput);
2164		FSQLType := SQLUnknown;
2165		FParamCheck := True;
2166	<	FCursor := Name + RandomString(8);
2166	>	FCursor := HexStr(self); //Name + RandomString(8);
2167		if AOwner is TIBDatabase then
2168		Database := TIBDatabase(AOwner)
2169		else
#	Line 2265 | Line 2315 | begin
2315		FBOF := True;
2316		FEOF := False;
2317		FRecordCount := 0;
2318	+	if not (csDesigning in ComponentState) then
2319	+	MonitorHook.SQLExecute(Self);
2320		if FGoToFirstRecordOnExecute then
2321		Next;
2322		end;
#	Line 2275 | Line 2327 | begin
2327		Database.SQLDialect,
2328		FSQLParams.AsXSQLDA,
2329		FSQLRecord.AsXSQLDA), True);
2330	+	if not (csDesigning in ComponentState) then
2331	+	MonitorHook.SQLExecute(Self);
2332		(*      if (fetch_res <> 0) and (fetch_res <> isc_deadlock) then
2333		begin
2334		{ Sometimes a prepared stored procedure appears to get
#	Line 2297 | Line 2351 | begin
2351		TRHandle,
2352		@FHandle,
2353		Database.SQLDialect,
2354	<	FSQLParams.AsXSQLDA), True)
2354	>	FSQLParams.AsXSQLDA), True);
2355	>	if not (csDesigning in ComponentState) then
2356	>	MonitorHook.SQLExecute(Self);
2357		end;
2358	<	if not (csDesigning in ComponentState) then
2359	<	MonitorHook.SQLExecute(Self);
2358	>	FBase.DoAfterExecQuery(self);
2359	>	//  writeln('Rows Affected = ',RowsAffected);
2360		end;
2361
2362		function TIBSQL.GetEOF: Boolean;
#	Line 2412 | Line 2468 | begin
2468		SQLUpdate, SQLDelete])) then
2469		result := ''
2470		else begin
2471	<	info_request := Char(isc_info_sql_get_plan);
2471	>	info_request := isc_info_sql_get_plan;
2472		Call(isc_dsql_sql_info(StatusVector, @FHandle, 2, @info_request,
2473		SizeOf(result_buffer), result_buffer), True);
2474	<	if (result_buffer[0] <> Char(isc_info_sql_get_plan)) then
2474	>	if (result_buffer[0] <> isc_info_sql_get_plan) then
2475		IBError(ibxeUnknownError, [nil]);
2476		result_length := isc_vax_integer(@result_buffer[1], 2);
2477		SetString(result, nil, result_length);
#	Line 2432 | Line 2488 | end;
2488
2489		function TIBSQL.GetRowsAffected: Integer;
2490		var
2435	–	result_buffer: array[0..1048] of Char;
2491		info_request: Char;
2492	+	RB: TResultBuffer;
2493		begin
2494		if not Prepared then
2495		result := -1
2496		else begin
2497	<	info_request := Char(isc_info_sql_records);
2498	<	if isc_dsql_sql_info(StatusVector, @FHandle, 1, @info_request,
2499	<	SizeOf(result_buffer), result_buffer) > 0 then
2500	<	IBDatabaseError;
2501	<	if (result_buffer[0] <> Char(isc_info_sql_records)) then
2502	<	result := -1
2503	<	else
2504	<	case SQLType of
2505	<	SQLUpdate:   Result := isc_vax_integer(@result_buffer[6], 4);
2506	<	SQLDelete:   Result := isc_vax_integer(@result_buffer[13], 4);
2507	<	SQLInsert:   Result := isc_vax_integer(@result_buffer[27], 4);
2508	<	else         Result := -1 ;
2509	<	end ;
2497	>	RB := TResultBuffer.Create;
2498	>	try
2499	>	info_request := isc_info_sql_records;
2500	>	if isc_dsql_sql_info(StatusVector, @FHandle, 1, @info_request,
2501	>	RB.Size, RB.buffer) > 0 then
2502	>	IBDatabaseError;
2503	>	case SQLType of
2504	>	SQLInsert, SQLUpdate: {Covers Insert or Update as well as individual update}
2505	>	Result := RB.GetValue(isc_info_sql_records, isc_info_req_insert_count)+
2506	>	RB.GetValue(isc_info_sql_records, isc_info_req_update_count);
2507	>	SQLDelete:
2508	>	Result := RB.GetValue(isc_info_sql_records, isc_info_req_delete_count);
2509	>	SQLExecProcedure:
2510	>	Result :=  RB.GetValue(isc_info_sql_records, isc_info_req_insert_count) +
2511	>	RB.GetValue(isc_info_sql_records, isc_info_req_update_count) +
2512	>	RB.GetValue(isc_info_sql_records, isc_info_req_delete_count);
2513	>	else
2514	>	Result := 0;
2515	>	end;
2516	>	finally
2517	>	RB.Free;
2518	>	end;
2519		end;
2520		end;
2521
#	Line 2502 | Line 2567 | const
2567		end;
2568
2569		begin
2570	+	sParamName := '';
2571		slNames := TStringList.Create;
2572		try
2573		{ Do some initializations of variables }
#	Line 2662 | Line 2728 | begin
2728		{ After preparing the statement, query the stmt type and possibly
2729		create a FSQLRecord "holder" }
2730		{ Get the type of the statement }
2731	<	type_item := Char(isc_info_sql_stmt_type);
2731	>	type_item := isc_info_sql_stmt_type;
2732		Call(isc_dsql_sql_info(StatusVector, @FHandle, 1, @type_item,
2733		SizeOf(res_buffer), res_buffer), True);
2734	<	if (res_buffer[0] <> Char(isc_info_sql_stmt_type)) then
2734	>	if (res_buffer[0] <> isc_info_sql_stmt_type) then
2735		IBError(ibxeUnknownError, [nil]);
2736		stmt_len := isc_vax_integer(@res_buffer[1], 2);
2737		FSQLType := TIBSQLTypes(isc_vax_integer(@res_buffer[3], stmt_len));
#	Line 2710 | Line 2776 | begin
2776		on E: Exception do begin
2777		if (FHandle <> nil) then
2778		FreeHandle;
2779	<	raise;
2779	>	if E is EIBInterBaseError then
2780	>	raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode,
2781	>	EIBInterBaseError(E).IBErrorCode,
2782	>	EIBInterBaseError(E).Message +
2783	>	sSQLErrorSeparator + FProcessedSQL.Text)
2784	>	else
2785	>	raise;
2786		end;
2787		end;
2788		end;
#	Line 2748 | Line 2820 | begin
2820		if FHandle <> nil then FreeHandle;
2821		end;
2822
2823	<	procedure TIBSQL.BeforeTransactionEnd(Sender: TObject);
2823	>	procedure TIBSQL.SQLChanged(Sender: TObject);
2824	>	begin
2825	>	if assigned(OnSQLChanged) then
2826	>	OnSQLChanged(self);
2827	>	end;
2828	>
2829	>	procedure TIBSQL.BeforeTransactionEnd(Sender: TObject;
2830	>	Action: TTransactionAction);
2831		begin
2832		if (FOpen) then
2833		Close;

Diff Legend

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