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 33 by tony, Sat Jul 18 12:30:52 2015 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 359 | Line 366 | type
366		procedure SetSQL(Value: TStrings);
367		procedure SetTransaction(Value: TIBTransaction);
368		procedure SQLChanging(Sender: TObject);
369	<	procedure BeforeTransactionEnd(Sender: TObject);
369	>	procedure BeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
370		public
371		constructor Create(AOwner: TComponent); override;
372		destructor Destroy; override;
#	Line 585 | Line 592 | begin
592		result := Value;
593		end;
594
595	+	function TIBXSQLVAR.GetAsBoolean: boolean;
596	+	begin
597	+	result := false;
598	+	if not IsNull then
599	+	begin
600	+	if FXSQLVAR^.sqltype and (not 1) = SQL_BOOLEAN then
601	+	result := PByte(FXSQLVAR^.sqldata)^ = ISC_TRUE
602	+	else
603	+	IBError(ibxeInvalidDataConversion, [nil]);
604	+	end
605	+	end;
606	+
607		function TIBXSQLVAR.GetAsCurrency: Currency;
608		begin
609		result := 0;
#	Line 896 | Line 915 | begin
915		result := AsDouble;
916		SQL_INT64:
917		if FXSQLVAR^.sqlscale = 0 then
918	<	IBError(ibxeInvalidDataConversion, [nil])
918	>	result := AsInt64
919		else if FXSQLVAR^.sqlscale >= (-4) then
920		result := AsCurrency
921		else
922		result := AsDouble;
923		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
924		result := AsDouble;
925	+	SQL_BOOLEAN:
926	+	result := AsBoolean;
927		else
928		IBError(ibxeInvalidDataConversion, [nil]);
929		end;
#	Line 991 | Line 1012 | begin
1012		result := FXSQLVAR^.sqltype and (not 1);
1013		end;
1014
1015	+	procedure TIBXSQLVAR.SetAsBoolean(AValue: boolean);
1016	+	var
1017	+	i: Integer;
1018	+	begin
1019	+	if FUniqueName then
1020	+	xSetAsBoolean(AValue)
1021	+	else
1022	+	for i := 0 to FParent.FCount - 1 do
1023	+	if FParent[i].FName = FName then
1024	+	FParent[i].xSetAsBoolean(AValue);
1025	+	end;
1026	+
1027		procedure TIBXSQLVAR.xSetAsCurrency(Value: Currency);
1028		begin
1029		if IsNullable then
#	Line 1398 | Line 1431 | begin
1431		varCurrency:
1432		AsCurrency := Value;
1433		varBoolean:
1434	<	if Value then
1402	<	AsLong := ISC_TRUE
1403	<	else
1404	<	AsLong := ISC_FALSE;
1434	>	AsBoolean := Value;
1435		varDate:
1436		AsDateTime := Value;
1437		varOleStr, varString:
#	Line 1528 | Line 1558 | begin
1558		FParent[i].xSetIsNullable(Value);
1559		end;
1560
1561	+	procedure TIBXSQLVAR.xSetAsBoolean(AValue: boolean);
1562	+	begin
1563	+	if IsNullable then
1564	+	IsNull := False;
1565	+
1566	+	FXSQLVAR^.sqltype := SQL_BOOLEAN;
1567	+	FXSQLVAR^.sqllen := 1;
1568	+	FXSQLVAR^.sqlscale := 0;
1569	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1570	+	if AValue then
1571	+	PByte(FXSQLVAR^.sqldata)^ := ISC_TRUE
1572	+	else
1573	+	PByte(FXSQLVAR^.sqldata)^ := ISC_FALSE;
1574	+	FModified := True;
1575	+	end;
1576	+
1577		procedure TIBXSQLVAR.Clear;
1578		begin
1579		IsNull := true;
#	Line 1721 | Line 1767 | begin
1767
1768		case sqltype and (not 1) of
1769		SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
1770	<	SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT,
1770	>	SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
1771		SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: begin
1772		if (sqllen = 0) then
1773		{ Make sure you get a valid pointer anyway
#	Line 2113 | Line 2159 | begin
2159		FSQLRecord := TIBXSQLDA.Create(self,daOutput);
2160		FSQLType := SQLUnknown;
2161		FParamCheck := True;
2162	<	FCursor := Name + RandomString(8);
2162	>	FCursor := HexStr(self); //Name + RandomString(8);
2163		if AOwner is TIBDatabase then
2164		Database := TIBDatabase(AOwner)
2165		else
#	Line 2265 | Line 2311 | begin
2311		FBOF := True;
2312		FEOF := False;
2313		FRecordCount := 0;
2314	+	if not (csDesigning in ComponentState) then
2315	+	MonitorHook.SQLExecute(Self);
2316		if FGoToFirstRecordOnExecute then
2317		Next;
2318		end;
#	Line 2275 | Line 2323 | begin
2323		Database.SQLDialect,
2324		FSQLParams.AsXSQLDA,
2325		FSQLRecord.AsXSQLDA), True);
2326	+	if not (csDesigning in ComponentState) then
2327	+	MonitorHook.SQLExecute(Self);
2328		(*      if (fetch_res <> 0) and (fetch_res <> isc_deadlock) then
2329		begin
2330		{ Sometimes a prepared stored procedure appears to get
#	Line 2297 | Line 2347 | begin
2347		TRHandle,
2348		@FHandle,
2349		Database.SQLDialect,
2350	<	FSQLParams.AsXSQLDA), True)
2350	>	FSQLParams.AsXSQLDA), True);
2351	>	if not (csDesigning in ComponentState) then
2352	>	MonitorHook.SQLExecute(Self);
2353		end;
2354	<	if not (csDesigning in ComponentState) then
2355	<	MonitorHook.SQLExecute(Self);
2354	>	FBase.DoAfterExecQuery(self);
2355	>	//  writeln('Rows Affected = ',RowsAffected);
2356		end;
2357
2358		function TIBSQL.GetEOF: Boolean;
#	Line 2412 | Line 2464 | begin
2464		SQLUpdate, SQLDelete])) then
2465		result := ''
2466		else begin
2467	<	info_request := Char(isc_info_sql_get_plan);
2467	>	info_request := isc_info_sql_get_plan;
2468		Call(isc_dsql_sql_info(StatusVector, @FHandle, 2, @info_request,
2469		SizeOf(result_buffer), result_buffer), True);
2470	<	if (result_buffer[0] <> Char(isc_info_sql_get_plan)) then
2470	>	if (result_buffer[0] <> isc_info_sql_get_plan) then
2471		IBError(ibxeUnknownError, [nil]);
2472		result_length := isc_vax_integer(@result_buffer[1], 2);
2473		SetString(result, nil, result_length);
#	Line 2432 | Line 2484 | end;
2484
2485		function TIBSQL.GetRowsAffected: Integer;
2486		var
2435	–	result_buffer: array[0..1048] of Char;
2487		info_request: Char;
2488	+	RB: TResultBuffer;
2489		begin
2490		if not Prepared then
2491		result := -1
2492		else begin
2493	<	info_request := Char(isc_info_sql_records);
2494	<	if isc_dsql_sql_info(StatusVector, @FHandle, 1, @info_request,
2495	<	SizeOf(result_buffer), result_buffer) > 0 then
2496	<	IBDatabaseError;
2497	<	if (result_buffer[0] <> Char(isc_info_sql_records)) then
2498	<	result := -1
2499	<	else
2500	<	case SQLType of
2501	<	SQLUpdate:   Result := isc_vax_integer(@result_buffer[6], 4);
2502	<	SQLDelete:   Result := isc_vax_integer(@result_buffer[13], 4);
2503	<	SQLInsert:   Result := isc_vax_integer(@result_buffer[27], 4);
2504	<	else         Result := -1 ;
2505	<	end ;
2493	>	RB := TResultBuffer.Create;
2494	>	try
2495	>	info_request := isc_info_sql_records;
2496	>	if isc_dsql_sql_info(StatusVector, @FHandle, 1, @info_request,
2497	>	RB.Size, RB.buffer) > 0 then
2498	>	IBDatabaseError;
2499	>	case SQLType of
2500	>	SQLInsert, SQLUpdate: {Covers Insert or Update as well as individual update}
2501	>	Result := RB.GetValue(isc_info_sql_records, isc_info_req_insert_count)+
2502	>	RB.GetValue(isc_info_sql_records, isc_info_req_update_count);
2503	>	SQLDelete:
2504	>	Result := RB.GetValue(isc_info_sql_records, isc_info_req_delete_count);
2505	>	SQLExecProcedure:
2506	>	Result :=  RB.GetValue(isc_info_sql_records, isc_info_req_insert_count) +
2507	>	RB.GetValue(isc_info_sql_records, isc_info_req_update_count) +
2508	>	RB.GetValue(isc_info_sql_records, isc_info_req_delete_count);
2509	>	else
2510	>	Result := 0;
2511	>	end;
2512	>	finally
2513	>	RB.Free;
2514	>	end;
2515		end;
2516		end;
2517
#	Line 2502 | Line 2563 | const
2563		end;
2564
2565		begin
2566	+	sParamName := '';
2567		slNames := TStringList.Create;
2568		try
2569		{ Do some initializations of variables }
#	Line 2662 | Line 2724 | begin
2724		{ After preparing the statement, query the stmt type and possibly
2725		create a FSQLRecord "holder" }
2726		{ Get the type of the statement }
2727	<	type_item := Char(isc_info_sql_stmt_type);
2727	>	type_item := isc_info_sql_stmt_type;
2728		Call(isc_dsql_sql_info(StatusVector, @FHandle, 1, @type_item,
2729		SizeOf(res_buffer), res_buffer), True);
2730	<	if (res_buffer[0] <> Char(isc_info_sql_stmt_type)) then
2730	>	if (res_buffer[0] <> isc_info_sql_stmt_type) then
2731		IBError(ibxeUnknownError, [nil]);
2732		stmt_len := isc_vax_integer(@res_buffer[1], 2);
2733		FSQLType := TIBSQLTypes(isc_vax_integer(@res_buffer[3], stmt_len));
#	Line 2710 | Line 2772 | begin
2772		on E: Exception do begin
2773		if (FHandle <> nil) then
2774		FreeHandle;
2775	<	raise;
2775	>	if E is EIBInterBaseError then
2776	>	raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode,
2777	>	EIBInterBaseError(E).IBErrorCode,
2778	>	EIBInterBaseError(E).Message +
2779	>	sSQLErrorSeparator + FProcessedSQL.Text)
2780	>	else
2781	>	raise;
2782		end;
2783		end;
2784		end;
#	Line 2748 | Line 2816 | begin
2816		if FHandle <> nil then FreeHandle;
2817		end;
2818
2819	<	procedure TIBSQL.BeforeTransactionEnd(Sender: TObject);
2819	>	procedure TIBSQL.BeforeTransactionEnd(Sender: TObject;
2820	>	Action: TTransactionAction);
2821		begin
2822		if (FOpen) then
2823		Close;

Diff Legend

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