runtime/nongui/IBQuery.pas

{************************************************************************}
{                                                                        }
{       Borland Delphi Visual Component Library                          }
{       InterBase Express core components                                }
{                                                                        }
{       Copyright (c) 1998-2000 Inprise Corporation                      }
{                                                                        }
{    InterBase Express is based in part on the product                   }
{    Free IB Components, written by Gregory H. Deatz for                 }
{    Hoagland, Longo, Moran, Dunst & Doukas Company.                     }
{    Free IB Components is used under license.                           }
{                                                                        }
{    The contents of this file are subject to the InterBase              }
{    Public License Version 1.0 (the "License"); you may not             }
{    use this file except in compliance with the License. You            }
{    may obtain a copy of the License at http://www.Inprise.com/IPL.html }
{    Software distributed under the License is distributed on            }
{    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
{    express or implied. See the License for the specific language       }
{    governing rights and limitations under the License.                 }
{    The Original Code was created by InterBase Software Corporation     }
{       and its successors.                                              }
{    Portions created by Inprise Corporation are Copyright (C) Inprise   }
{       Corporation. All Rights Reserved.                                }
{    Contributor(s): Jeff Overcash                                       }
{                                                                        }
{    IBX For Lazarus (Firebird Express)                                  }
{    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
{    Portions created by MWA Software are copyright McCallum Whyman      }
{    Associates Ltd 2011 - 2018                                               }
{                                                                        }
{************************************************************************}

unit IBQuery;

interface

{$Mode Delphi}

uses
{$IFDEF WINDOWS }
  Windows,
{$ELSE}
  unix,
{$ENDIF}
 SysUtils, Classes,  Db, IB, IBCustomDataSet, IBSQL;

type

{ TIBQuery }

  TIBQuery = class(TIBParserDataSet)
  private
    FSQL: TStrings;
    FPrepared: Boolean;
    FParams: TParams;
    FText: string;
    FSQLUpdating: boolean;
    FInQueryChanged: boolean;
    function GetRowsAffected: Integer;
    function ParseSQL(ParamList: TParams; SQL: string; DoClear: boolean): string;
    procedure PrepareSQL;
    procedure QueryChanged(Sender: TObject);
    procedure ReadParamData(Reader: TReader);
    procedure SetQuery(Value: TStrings);
    procedure SetParamsList(Value: TParams);
    procedure SetParams;
    procedure SetParamsFromCursor;
    procedure SetPrepared(Value: Boolean);
    procedure SetPrepare(Value: Boolean);
    procedure WriteParamData(Writer: TWriter);
    function GetStmtHandle: IStatement;
    procedure UpdateSQL;

  protected
    { IProviderSupport }
(*    procedure PSExecute; override;
    function PSGetParams: TParams; override;
    function PSGetTableName: string; override;
    procedure PSSetCommandText(const CommandText: string); override;
    procedure PSSetParams(AParams: TParams); override;  *)

    procedure DefineProperties(Filer: TFiler); override;
    procedure InitFieldDefs; override;
    procedure InternalOpen; override;
    procedure Disconnect; override;
    function GetParamsCount: Word;
    function GenerateQueryForLiveUpdate : Boolean;
    procedure SetFiltered(Value: Boolean); override;
    procedure SQLChanged(Sender: TObject); override;
    procedure SQLChanging(Sender: TObject); override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure BatchInput(InputObject: TIBBatchInput);
    procedure BatchOutput(OutputObject: TIBBatchOutput);
    procedure ExecSQL;
    procedure GetDetailLinkFields(MasterFields, DetailFields: TList);(* override;*)
    function ParamByName(const Value: string): TParam;
    procedure Prepare;
    procedure UnPrepare;
    procedure ResetParser; override;
    property Prepared: Boolean read FPrepared write SetPrepare;
    property ParamCount: Word read GetParamsCount;
    property StmtHandle: IStatement read GetStmtHandle;
    property StatementType;
    property Text: string read FText;
    property RowsAffected: Integer read GetRowsAffected;
 //   property Params: TParams read FParams write SetParamsList;
    property BaseSQLSelect;

  published
    property Active;
    property AutoCommit;
    property BufferChunks;
    property CachedUpdates;
    property CaseSensitiveParameterNames;
    property DataSource read GetDataSource write SetDataSource;
    property EnableStatistics;
    property GenerateParamNames;
 //   property Constraints stored ConstraintsStored;
    property GeneratorField;
    property MasterDetailDelay;
    property ParamCheck;
    property SQL: TStrings read FSQL write SetQuery;
    property Params: TParams read FParams write SetParamsList;
    property UniDirectional default False;
    property UpdateObject;
    property Filtered;
    property DataSetCloseAction;

    property BeforeDatabaseDisconnect;
    property AfterDatabaseDisconnect;
    property DatabaseFree;
    property BeforeTransactionEnd;
    property AfterTransactionEnd;
    property TransactionFree;
    property OnFilterRecord;
    property OnValidatePost;
    property OnDeleteReturning;
end;

implementation

uses FBMessages, IBUtils;

{ TIBQuery }

constructor TIBQuery.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSQL := TStringList.Create;
  TStringList(SQL).OnChange := QueryChanged;
  FParams := TParams.Create(Self);
  ParamCheck := True;
end;

destructor TIBQuery.Destroy;
begin
  Destroying;
  Disconnect;
  SQL.Free;
  FParams.Free;
  inherited Destroy;
end;

procedure TIBQuery.InitFieldDefs;
begin
  inherited InitFieldDefs;
end;

procedure TIBQuery.InternalOpen;
begin
  ActivateConnection();
  ActivateTransaction;
  QSelect.GenerateParamNames := GenerateParamNames;
  SetPrepared(True);
  if DataSource <> nil then
    SetParamsFromCursor;
  SetParams;
  inherited InternalOpen;
end;

procedure TIBQuery.Disconnect;
begin
  Close;
  UnPrepare;
end;

procedure TIBQuery.SetPrepare(Value: Boolean);
begin
  if Value then
    Prepare
  else
    UnPrepare;
end;

procedure TIBQuery.Prepare;
begin
  SetPrepared(True);
end;

procedure TIBQuery.UnPrepare;
begin
  SetPrepared(False);
end;

procedure TIBQuery.ResetParser;
begin
  inherited ResetParser;
  UpdateSQL;
end;

procedure TIBQuery.SetQuery(Value: TStrings);
begin
  if SQL.Text <> Value.Text then
  begin
    Disconnect;
    SQL.BeginUpdate;
    try
      SQL.Assign(Value);
    finally
      SQL.EndUpdate;
    end;
  end;
end;

procedure TIBQuery.QueryChanged(Sender: TObject);
begin
  if FInQueryChanged then Exit;
  FInQueryChanged := true;
  try
    if not (csReading in ComponentState) then
    begin
      Disconnect;
      if csDesigning in ComponentState then
        FText := ParseSQL(FParams,SQL.Text, true)
      else
        FText := SQL.Text;
      DataEvent(dePropertyChange, 0);
    end else
      FText := ParseSQL(FParams,SQL.Text, true);

    if not FSQLUpdating then
    begin
      Prepared := false;
      SelectSQL.Assign(SQL);
    end;
  finally
    FInQueryChanged := false;
  end;
end;

procedure TIBQuery.SetParamsList(Value: TParams);
begin
  FParams.AssignValues(Value);
end;

function TIBQuery.GetParamsCount: Word;
begin
  Result := FParams.Count;
end;

procedure TIBQuery.DefineProperties(Filer: TFiler);

  function WriteData: Boolean;
  begin
  {The following results in a stream read error with nested frames. Hence commented out until
   someone fixes the LCL }
{    if Filer.Ancestor <> nil then
      Result := not FParams.IsEqual(TIBQuery(Filer.Ancestor).FParams) else}
      Result := FParams.Count > 0;
  end;

begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('ParamData', ReadParamData, WriteParamData, WriteData); {do not localize}
end;


procedure TIBQuery.ReadParamData(Reader: TReader);
begin
  FParams.Clear;
  Reader.ReadValue;
  Reader.ReadCollection(FParams);
end;

procedure TIBQuery.WriteParamData(Writer: TWriter);
begin
  Writer.WriteCollection(Params);
end;

procedure TIBQuery.SetPrepared(Value: Boolean);
begin
  CheckDatasetClosed;
  if Value <> Prepared then
  begin
    if Value then
    begin
      if Length(Text) > 1 then PrepareSQL
      else IBError(ibxeEmptySQLStatement, [nil]);
    end
    else
    begin
      InternalUnPrepare;
      FParams.Clear;
    end;
    FPrepared := Value;
  end;
end;

procedure TIBQuery.SetParamsFromCursor;
var
  I: Integer;
  DataSet: TDataSet;
  Field: TField;

  procedure CheckRequiredParams;
  var
    I: Integer;
  begin
    for I := 0 to FParams.Count - 1 do
    with FParams[I] do
      if not Bound then
        IBError(ibxeRequiredParamNotSet, [FParams[I].Name]);
  end;

begin
  if DataSource <> nil then
  begin
    DataSet := DataSource.DataSet;
    if DataSet <> nil then
    begin
      DataSet.FieldDefs.Update;
      for I := 0 to FParams.Count - 1 do
      if not FParams[I].Bound then
      begin
        Field := DataSet.FindField(FParams[I].Name);
        if assigned(Field) then
        begin
            FParams[I].AssignField(Field);
            FParams[I].Bound := False;
        end;
      end;
    end
    else
      CheckRequiredParams;
  end
  else
    CheckRequiredParams;
end;


function TIBQuery.ParamByName(const Value: string): TParam;
var i: integer;
begin
  if not Prepared then
    Prepare;
  Result := nil;
  if not CaseSensitiveParameterNames then
    Result := FParams.ParamByName(Value)
  else
  begin
    i := FParams.Count - 1;
    while (Result = nil) and (i >= 0) do
      if CompareStr(Value,FParams.Items[i].Name) = 0 then
        Result := FParams.Items[i]
      else
        Dec(i);
    if Result = nil then
      IBError(ibxeParameterNameNotFound,[Value]);
  end;
end;

procedure TIBQuery.BatchInput(InputObject: TIBBatchInput);
begin
  InternalBatchInput(InputObject);
end;

procedure TIBQuery.BatchOutput(OutputObject: TIBBatchOutput);
begin
  InternalBatchOutput(OutputObject);
end;

procedure TIBQuery.ExecSQL;
var
  DidActivate: Boolean;
begin
  CheckInActive;
  if SQL.Count <= 0 then
    IBError(ibxeEmptySQLStatement, [nil]);

  ActivateConnection();
  DidActivate := ActivateTransaction;
  try
    SetPrepared(True);
    if DataSource <> nil then SetParamsFromCursor;
    if FParams.Count > 0 then SetParams;
    InternalExecQuery;
  finally
    if DidActivate then
      DeactivateTransaction;
  end;
end;

procedure TIBQuery.SetParams;

var
i : integer;
Buffer: Pointer;
SQLParam: ISQLParam;

begin
  for I := 0 to FParams.Count - 1 do
  begin
    SQLParam :=  SQLParams.ByName(Params[i].Name);
    if Params[i].IsNull then
      SQLParam.IsNull := True
    else begin
      SQLParam.IsNull := False;
      case Params[i].DataType of
        ftBytes:
        begin
          GetMem(Buffer,Params[i].GetDataSize);
          try
            Params[i].GetData(Buffer);
            SQLParam.AsPointer := Buffer;
          finally
            FreeMem(Buffer);
          end;
        end;
        ftString:
          SQLParam.AsString := Params[i].AsString;
        ftBoolean:
          SQLParam.AsBoolean := Params[i].AsBoolean;
        ftSmallint, ftWord:
          SQLParam.AsShort := Params[i].AsSmallInt;
        ftInteger:
          SQLParam.AsLong := Params[i].AsInteger;
        ftLargeInt:
          SQLParam.AsInt64 := Params[i].AsLargeInt;
        ftFloat:
         SQLParam.AsDouble := Params[i].AsFloat;
        ftBCD, ftCurrency:
          SQLParam.AsCurrency := Params[i].AsCurrency;
        ftDate:
          SQLParam.AsDate := Params[i].AsDateTime;
        ftTime:
          SQLParam.AsTime := Params[i].AsDateTime;
        ftDateTime:
          SQLParam.AsDateTime := Params[i].AsDateTime;
        ftBlob, ftMemo:
          SQLParam.AsString := Params[i].AsString;
        else
          IBError(ibxeNotSupported, [nil]);
      end;
    end;
  end;
end;

procedure TIBQuery.PrepareSQL;
var List: TParams;
begin
  QSelect.GenerateParamNames := GenerateParamNames;
  InternalPrepare;
  UpdateSQL;
  if ParamCheck  then
  begin
    List := TParams.Create(Self);
    try
      FText := ParseSQL(List,SQL.Text, True);
      List.AssignValues(FParams);
      FParams.Clear;
      FParams.Assign(List);
    finally
      List.Free;
    end;
  end;
end;


function TIBQuery.GetRowsAffected: Integer;
begin
  Result := -1;
  if Prepared then
   Result := QSelect.RowsAffected
end;

function TIBQuery.ParseSQL(ParamList: TParams; SQL: string; DoClear: boolean
  ): string;
var ParamNames: TStrings;
    i: integer;
begin
  ParamNames := TStringList.Create;
  try
    Result := TSQLParamProcessor.Execute(SQL,GenerateParamNames,ParamNames);
    if DoClear then ParamList.Clear;
    for i := 0 to ParamNames.Count - 1 do
    begin
      if not CaseSensitiveParameterNames then
        ParamNames[i] := AnsiUpperCase(ParamNames[i]);
      if ParamList.FindParam(ParamNames[i]) = nil then
        ParamList.CreateParam(ftUnknown, ParamNames[i], ptInput);
    end;
  finally
    ParamNames.Free
  end;
end;


procedure TIBQuery.GetDetailLinkFields(MasterFields, DetailFields: TList);

  function AddFieldToList(const FieldName: string; DataSet: TDataSet;
    List: TList): Boolean;
  var
    Field: TField;
  begin
    Field := DataSet.FindField(FieldName);
    if (Field <> nil) then
      List.Add(Field);
    Result := Field <> nil;
  end;

var
  i: Integer;
begin
  MasterFields.Clear;
  DetailFields.Clear;
  if (DataSource <> nil) and (DataSource.DataSet <> nil) then
    for i := 0 to Params.Count - 1 do
      if AddFieldToList(Params[i].Name, DataSource.DataSet, MasterFields) then
        AddFieldToList(Params[i].Name, Self, DetailFields);
end;

function TIBQuery.GetStmtHandle: IStatement;
begin
  Result := SelectStmtHandle;
end;

procedure TIBQuery.UpdateSQL;
begin
  if not FSQLUpdating and not FInQueryChanged and (SQL.Text <> SelectSQL.Text) then
  begin
    FSQLUpdating := true;
    try
      SQL.Text := SelectSQL.Text;
    finally
      FSQLUpdating := false
    end;
  end;
end;

function TIBQuery.GenerateQueryForLiveUpdate : Boolean;
begin
  Result := False;
end;

procedure TIBQuery.SetFiltered(Value: Boolean);
begin
  if(Filtered <> Value) then
  begin
    inherited SetFiltered(value);
    if Active then
    begin
      Close;
      Open;
    end;
  end
  else
    inherited SetFiltered(value);
end;

procedure TIBQuery.SQLChanged(Sender: TObject);
begin
  inherited SQLChanged(Sender);
  UpdateSQL;
end;

procedure TIBQuery.SQLChanging(Sender: TObject);
begin
  inherited SQLChanging(Sender);
  Prepared := false;
end;

{ TIBQuery IProviderSupport }
 (*
function TIBQuery.PSGetParams: TParams;
begin
  Result := Params;
end;

procedure TIBQuery.PSSetParams(AParams: TParams);
begin
  if AParams.Count <> 0 then
    Params.Assign(AParams);
  Close;
end;

function TIBQuery.PSGetTableName: string;
begin
  Result := inherited PSGetTableName;
end;

procedure TIBQuery.PSExecute;
begin
  ExecSQL;
end;

procedure TIBQuery.PSSetCommandText(const CommandText: string);
begin
  if CommandText <> '' then
    SQL.Text := CommandText;
end;
 *)
end.

Revision:	270
Committed:	Fri Jan 18 11:10:37 2019 UTC (5 years, 3 months ago) by tony
Content type:	text/x-pascal
File size:	15710 byte(s)
Log Message:	Fixes merged
#	Content
1	{************************************************************************}
2	{ }
3	{ Borland Delphi Visual Component Library }
4	{ InterBase Express core components }
5	{ }
6	{ Copyright (c) 1998-2000 Inprise Corporation }
7	{ }
8	{ InterBase Express is based in part on the product }
9	{ Free IB Components, written by Gregory H. Deatz for }
10	{ Hoagland, Longo, Moran, Dunst & Doukas Company. }
11	{ Free IB Components is used under license. }
12	{ }
13	{ The contents of this file are subject to the InterBase }
14	{ Public License Version 1.0 (the "License"); you may not }
15	{ use this file except in compliance with the License. You }
16	{ may obtain a copy of the License at http://www.Inprise.com/IPL.html }
17	{ Software distributed under the License is distributed on }
18	{ an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
19	{ express or implied. See the License for the specific language }
20	{ governing rights and limitations under the License. }
21	{ The Original Code was created by InterBase Software Corporation }
22	{ and its successors. }
23	{ Portions created by Inprise Corporation are Copyright (C) Inprise }
24	{ Corporation. All Rights Reserved. }
25	{ Contributor(s): Jeff Overcash }
26	{ }
27	{ IBX For Lazarus (Firebird Express) }
28	{ Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29	{ Portions created by MWA Software are copyright McCallum Whyman }
30	{ Associates Ltd 2011 - 2018 }
31	{ }
32	{************************************************************************}
33
34	unit IBQuery;
35
36	interface
37
38	{$Mode Delphi}
39
40	uses
41	{$IFDEF WINDOWS }
42	Windows,
43	{$ELSE}
44	unix,
45	{$ENDIF}
46	SysUtils, Classes, Db, IB, IBCustomDataSet, IBSQL;
47
48	type
49
50	{ TIBQuery }
51
52	TIBQuery = class(TIBParserDataSet)
53	private
54	FSQL: TStrings;
55	FPrepared: Boolean;
56	FParams: TParams;
57	FText: string;
58	FSQLUpdating: boolean;
59	FInQueryChanged: boolean;
60	function GetRowsAffected: Integer;
61	function ParseSQL(ParamList: TParams; SQL: string; DoClear: boolean): string;
62	procedure PrepareSQL;
63	procedure QueryChanged(Sender: TObject);
64	procedure ReadParamData(Reader: TReader);
65	procedure SetQuery(Value: TStrings);
66	procedure SetParamsList(Value: TParams);
67	procedure SetParams;
68	procedure SetParamsFromCursor;
69	procedure SetPrepared(Value: Boolean);
70	procedure SetPrepare(Value: Boolean);
71	procedure WriteParamData(Writer: TWriter);
72	function GetStmtHandle: IStatement;
73	procedure UpdateSQL;
74
75	protected
76	{ IProviderSupport }
77	(* procedure PSExecute; override;
78	function PSGetParams: TParams; override;
79	function PSGetTableName: string; override;
80	procedure PSSetCommandText(const CommandText: string); override;
81	procedure PSSetParams(AParams: TParams); override; *)
82
83	procedure DefineProperties(Filer: TFiler); override;
84	procedure InitFieldDefs; override;
85	procedure InternalOpen; override;
86	procedure Disconnect; override;
87	function GetParamsCount: Word;
88	function GenerateQueryForLiveUpdate : Boolean;
89	procedure SetFiltered(Value: Boolean); override;
90	procedure SQLChanged(Sender: TObject); override;
91	procedure SQLChanging(Sender: TObject); override;
92
93	public
94	constructor Create(AOwner: TComponent); override;
95	destructor Destroy; override;
96	procedure BatchInput(InputObject: TIBBatchInput);
97	procedure BatchOutput(OutputObject: TIBBatchOutput);
98	procedure ExecSQL;
99	procedure GetDetailLinkFields(MasterFields, DetailFields: TList);(* override;*)
100	function ParamByName(const Value: string): TParam;
101	procedure Prepare;
102	procedure UnPrepare;
103	procedure ResetParser; override;
104	property Prepared: Boolean read FPrepared write SetPrepare;
105	property ParamCount: Word read GetParamsCount;
106	property StmtHandle: IStatement read GetStmtHandle;
107	property StatementType;
108	property Text: string read FText;
109	property RowsAffected: Integer read GetRowsAffected;
110	// property Params: TParams read FParams write SetParamsList;
111	property BaseSQLSelect;
112
113	published
114	property Active;
115	property AutoCommit;
116	property BufferChunks;
117	property CachedUpdates;
118	property CaseSensitiveParameterNames;
119	property DataSource read GetDataSource write SetDataSource;
120	property EnableStatistics;
121	property GenerateParamNames;
122	// property Constraints stored ConstraintsStored;
123	property GeneratorField;
124	property MasterDetailDelay;
125	property ParamCheck;
126	property SQL: TStrings read FSQL write SetQuery;
127	property Params: TParams read FParams write SetParamsList;
128	property UniDirectional default False;
129	property UpdateObject;
130	property Filtered;
131	property DataSetCloseAction;
132
133	property BeforeDatabaseDisconnect;
134	property AfterDatabaseDisconnect;
135	property DatabaseFree;
136	property BeforeTransactionEnd;
137	property AfterTransactionEnd;
138	property TransactionFree;
139	property OnFilterRecord;
140	property OnValidatePost;
141	property OnDeleteReturning;
142	end;
143
144	implementation
145
146	uses FBMessages, IBUtils;
147
148	{ TIBQuery }
149
150	constructor TIBQuery.Create(AOwner: TComponent);
151	begin
152	inherited Create(AOwner);
153	FSQL := TStringList.Create;
154	TStringList(SQL).OnChange := QueryChanged;
155	FParams := TParams.Create(Self);
156	ParamCheck := True;
157	end;
158
159	destructor TIBQuery.Destroy;
160	begin
161	Destroying;
162	Disconnect;
163	SQL.Free;
164	FParams.Free;
165	inherited Destroy;
166	end;
167
168	procedure TIBQuery.InitFieldDefs;
169	begin
170	inherited InitFieldDefs;
171	end;
172
173	procedure TIBQuery.InternalOpen;
174	begin
175	ActivateConnection();
176	ActivateTransaction;
177	QSelect.GenerateParamNames := GenerateParamNames;
178	SetPrepared(True);
179	if DataSource <> nil then
180	SetParamsFromCursor;
181	SetParams;
182	inherited InternalOpen;
183	end;
184
185	procedure TIBQuery.Disconnect;
186	begin
187	Close;
188	UnPrepare;
189	end;
190
191	procedure TIBQuery.SetPrepare(Value: Boolean);
192	begin
193	if Value then
194	Prepare
195	else
196	UnPrepare;
197	end;
198
199	procedure TIBQuery.Prepare;
200	begin
201	SetPrepared(True);
202	end;
203
204	procedure TIBQuery.UnPrepare;
205	begin
206	SetPrepared(False);
207	end;
208
209	procedure TIBQuery.ResetParser;
210	begin
211	inherited ResetParser;
212	UpdateSQL;
213	end;
214
215	procedure TIBQuery.SetQuery(Value: TStrings);
216	begin
217	if SQL.Text <> Value.Text then
218	begin
219	Disconnect;
220	SQL.BeginUpdate;
221	try
222	SQL.Assign(Value);
223	finally
224	SQL.EndUpdate;
225	end;
226	end;
227	end;
228
229	procedure TIBQuery.QueryChanged(Sender: TObject);
230	begin
231	if FInQueryChanged then Exit;
232	FInQueryChanged := true;
233	try
234	if not (csReading in ComponentState) then
235	begin
236	Disconnect;
237	if csDesigning in ComponentState then
238	FText := ParseSQL(FParams,SQL.Text, true)
239	else
240	FText := SQL.Text;
241	DataEvent(dePropertyChange, 0);
242	end else
243	FText := ParseSQL(FParams,SQL.Text, true);
244
245	if not FSQLUpdating then
246	begin
247	Prepared := false;
248	SelectSQL.Assign(SQL);
249	end;
250	finally
251	FInQueryChanged := false;
252	end;
253	end;
254
255	procedure TIBQuery.SetParamsList(Value: TParams);
256	begin
257	FParams.AssignValues(Value);
258	end;
259
260	function TIBQuery.GetParamsCount: Word;
261	begin
262	Result := FParams.Count;
263	end;
264
265	procedure TIBQuery.DefineProperties(Filer: TFiler);
266
267	function WriteData: Boolean;
268	begin
269	{The following results in a stream read error with nested frames. Hence commented out until
270	someone fixes the LCL }
271	{ if Filer.Ancestor <> nil then
272	Result := not FParams.IsEqual(TIBQuery(Filer.Ancestor).FParams) else}
273	Result := FParams.Count > 0;
274	end;
275
276	begin
277	inherited DefineProperties(Filer);
278	Filer.DefineProperty('ParamData', ReadParamData, WriteParamData, WriteData); {do not localize}
279	end;
280
281
282	procedure TIBQuery.ReadParamData(Reader: TReader);
283	begin
284	FParams.Clear;
285	Reader.ReadValue;
286	Reader.ReadCollection(FParams);
287	end;
288
289	procedure TIBQuery.WriteParamData(Writer: TWriter);
290	begin
291	Writer.WriteCollection(Params);
292	end;
293
294	procedure TIBQuery.SetPrepared(Value: Boolean);
295	begin
296	CheckDatasetClosed;
297	if Value <> Prepared then
298	begin
299	if Value then
300	begin
301	if Length(Text) > 1 then PrepareSQL
302	else IBError(ibxeEmptySQLStatement, [nil]);
303	end
304	else
305	begin
306	InternalUnPrepare;
307	FParams.Clear;
308	end;
309	FPrepared := Value;
310	end;
311	end;
312
313	procedure TIBQuery.SetParamsFromCursor;
314	var
315	I: Integer;
316	DataSet: TDataSet;
317	Field: TField;
318
319	procedure CheckRequiredParams;
320	var
321	I: Integer;
322	begin
323	for I := 0 to FParams.Count - 1 do
324	with FParams[I] do
325	if not Bound then
326	IBError(ibxeRequiredParamNotSet, [FParams[I].Name]);
327	end;
328
329	begin
330	if DataSource <> nil then
331	begin
332	DataSet := DataSource.DataSet;
333	if DataSet <> nil then
334	begin
335	DataSet.FieldDefs.Update;
336	for I := 0 to FParams.Count - 1 do
337	if not FParams[I].Bound then
338	begin
339	Field := DataSet.FindField(FParams[I].Name);
340	if assigned(Field) then
341	begin
342	FParams[I].AssignField(Field);
343	FParams[I].Bound := False;
344	end;
345	end;
346	end
347	else
348	CheckRequiredParams;
349	end
350	else
351	CheckRequiredParams;
352	end;
353
354
355	function TIBQuery.ParamByName(const Value: string): TParam;
356	var i: integer;
357	begin
358	if not Prepared then
359	Prepare;
360	Result := nil;
361	if not CaseSensitiveParameterNames then
362	Result := FParams.ParamByName(Value)
363	else
364	begin
365	i := FParams.Count - 1;
366	while (Result = nil) and (i >= 0) do
367	if CompareStr(Value,FParams.Items[i].Name) = 0 then
368	Result := FParams.Items[i]
369	else
370	Dec(i);
371	if Result = nil then
372	IBError(ibxeParameterNameNotFound,[Value]);
373	end;
374	end;
375
376	procedure TIBQuery.BatchInput(InputObject: TIBBatchInput);
377	begin
378	InternalBatchInput(InputObject);
379	end;
380
381	procedure TIBQuery.BatchOutput(OutputObject: TIBBatchOutput);
382	begin
383	InternalBatchOutput(OutputObject);
384	end;
385
386	procedure TIBQuery.ExecSQL;
387	var
388	DidActivate: Boolean;
389	begin
390	CheckInActive;
391	if SQL.Count <= 0 then
392	IBError(ibxeEmptySQLStatement, [nil]);
393
394	ActivateConnection();
395	DidActivate := ActivateTransaction;
396	try
397	SetPrepared(True);
398	if DataSource <> nil then SetParamsFromCursor;
399	if FParams.Count > 0 then SetParams;
400	InternalExecQuery;
401	finally
402	if DidActivate then
403	DeactivateTransaction;
404	end;
405	end;
406
407	procedure TIBQuery.SetParams;
408
409	var
410	i : integer;
411	Buffer: Pointer;
412	SQLParam: ISQLParam;
413
414	begin
415	for I := 0 to FParams.Count - 1 do
416	begin
417	SQLParam := SQLParams.ByName(Params[i].Name);
418	if Params[i].IsNull then
419	SQLParam.IsNull := True
420	else begin
421	SQLParam.IsNull := False;
422	case Params[i].DataType of
423	ftBytes:
424	begin
425	GetMem(Buffer,Params[i].GetDataSize);
426	try
427	Params[i].GetData(Buffer);
428	SQLParam.AsPointer := Buffer;
429	finally
430	FreeMem(Buffer);
431	end;
432	end;
433	ftString:
434	SQLParam.AsString := Params[i].AsString;
435	ftBoolean:
436	SQLParam.AsBoolean := Params[i].AsBoolean;
437	ftSmallint, ftWord:
438	SQLParam.AsShort := Params[i].AsSmallInt;
439	ftInteger:
440	SQLParam.AsLong := Params[i].AsInteger;
441	ftLargeInt:
442	SQLParam.AsInt64 := Params[i].AsLargeInt;
443	ftFloat:
444	SQLParam.AsDouble := Params[i].AsFloat;
445	ftBCD, ftCurrency:
446	SQLParam.AsCurrency := Params[i].AsCurrency;
447	ftDate:
448	SQLParam.AsDate := Params[i].AsDateTime;
449	ftTime:
450	SQLParam.AsTime := Params[i].AsDateTime;
451	ftDateTime:
452	SQLParam.AsDateTime := Params[i].AsDateTime;
453	ftBlob, ftMemo:
454	SQLParam.AsString := Params[i].AsString;
455	else
456	IBError(ibxeNotSupported, [nil]);
457	end;
458	end;
459	end;
460	end;
461
462	procedure TIBQuery.PrepareSQL;
463	var List: TParams;
464	begin
465	QSelect.GenerateParamNames := GenerateParamNames;
466	InternalPrepare;
467	UpdateSQL;
468	if ParamCheck then
469	begin
470	List := TParams.Create(Self);
471	try
472	FText := ParseSQL(List,SQL.Text, True);
473	List.AssignValues(FParams);
474	FParams.Clear;
475	FParams.Assign(List);
476	finally
477	List.Free;
478	end;
479	end;
480	end;
481
482
483	function TIBQuery.GetRowsAffected: Integer;
484	begin
485	Result := -1;
486	if Prepared then
487	Result := QSelect.RowsAffected
488	end;
489
490	function TIBQuery.ParseSQL(ParamList: TParams; SQL: string; DoClear: boolean
491	): string;
492	var ParamNames: TStrings;
493	i: integer;
494	begin
495	ParamNames := TStringList.Create;
496	try
497	Result := TSQLParamProcessor.Execute(SQL,GenerateParamNames,ParamNames);
498	if DoClear then ParamList.Clear;
499	for i := 0 to ParamNames.Count - 1 do
500	begin
501	if not CaseSensitiveParameterNames then
502	ParamNames[i] := AnsiUpperCase(ParamNames[i]);
503	if ParamList.FindParam(ParamNames[i]) = nil then
504	ParamList.CreateParam(ftUnknown, ParamNames[i], ptInput);
505	end;
506	finally
507	ParamNames.Free
508	end;
509	end;
510
511
512	procedure TIBQuery.GetDetailLinkFields(MasterFields, DetailFields: TList);
513
514	function AddFieldToList(const FieldName: string; DataSet: TDataSet;
515	List: TList): Boolean;
516	var
517	Field: TField;
518	begin
519	Field := DataSet.FindField(FieldName);
520	if (Field <> nil) then
521	List.Add(Field);
522	Result := Field <> nil;
523	end;
524
525	var
526	i: Integer;
527	begin
528	MasterFields.Clear;
529	DetailFields.Clear;
530	if (DataSource <> nil) and (DataSource.DataSet <> nil) then
531	for i := 0 to Params.Count - 1 do
532	if AddFieldToList(Params[i].Name, DataSource.DataSet, MasterFields) then
533	AddFieldToList(Params[i].Name, Self, DetailFields);
534	end;
535
536	function TIBQuery.GetStmtHandle: IStatement;
537	begin
538	Result := SelectStmtHandle;
539	end;
540
541	procedure TIBQuery.UpdateSQL;
542	begin
543	if not FSQLUpdating and not FInQueryChanged and (SQL.Text <> SelectSQL.Text) then
544	begin
545	FSQLUpdating := true;
546	try
547	SQL.Text := SelectSQL.Text;
548	finally
549	FSQLUpdating := false
550	end;
551	end;
552	end;
553
554	function TIBQuery.GenerateQueryForLiveUpdate : Boolean;
555	begin
556	Result := False;
557	end;
558
559	procedure TIBQuery.SetFiltered(Value: Boolean);
560	begin
561	if(Filtered <> Value) then
562	begin
563	inherited SetFiltered(value);
564	if Active then
565	begin
566	Close;
567	Open;
568	end;
569	end
570	else
571	inherited SetFiltered(value);
572	end;
573
574	procedure TIBQuery.SQLChanged(Sender: TObject);
575	begin
576	inherited SQLChanged(Sender);
577	UpdateSQL;
578	end;
579
580	procedure TIBQuery.SQLChanging(Sender: TObject);
581	begin
582	inherited SQLChanging(Sender);
583	Prepared := false;
584	end;
585
586	{ TIBQuery IProviderSupport }
587	(*
588	function TIBQuery.PSGetParams: TParams;
589	begin
590	Result := Params;
591	end;
592
593	procedure TIBQuery.PSSetParams(AParams: TParams);
594	begin
595	if AParams.Count <> 0 then
596	Params.Assign(AParams);
597	Close;
598	end;
599
600	function TIBQuery.PSGetTableName: string;
601	begin
602	Result := inherited PSGetTableName;
603	end;
604
605	procedure TIBQuery.PSExecute;
606	begin
607	ExecSQL;
608	end;
609
610	procedure TIBQuery.PSSetCommandText(const CommandText: string);
611	begin
612	if CommandText <> '' then
613	SQL.Text := CommandText;
614	end;
615	*)
616	end.
617