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;
    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 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;

{ 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 := FParams.ParseSQL(SQL.Text, true)
      else
        FText := SQL.Text;
      DataEvent(dePropertyChange, 0);
    end else
      FText := FParams.ParseSQL(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;
begin
  if not Prepared then
    Prepare;
  Result := FParams.ParamByName(Value);
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 := List.ParseSQL(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;


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:	209
Committed:	Wed Mar 14 12:48:51 2018 UTC (6 years, 1 month ago) by tony
Content type:	text/x-pascal
File size:	14595 byte(s)
Log Message:	Fixes Merged
#	User	Rev	Content
1	tony	209	{************************************************************************}
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			procedure PrepareSQL;
62			procedure QueryChanged(Sender: TObject);
63			procedure ReadParamData(Reader: TReader);
64			procedure SetQuery(Value: TStrings);
65			procedure SetParamsList(Value: TParams);
66			procedure SetParams;
67			procedure SetParamsFromCursor;
68			procedure SetPrepared(Value: Boolean);
69			procedure SetPrepare(Value: Boolean);
70			procedure WriteParamData(Writer: TWriter);
71			function GetStmtHandle: IStatement;
72			procedure UpdateSQL;
73
74			protected
75			{ IProviderSupport }
76			(* procedure PSExecute; override;
77			function PSGetParams: TParams; override;
78			function PSGetTableName: string; override;
79			procedure PSSetCommandText(const CommandText: string); override;
80			procedure PSSetParams(AParams: TParams); override; *)
81
82			procedure DefineProperties(Filer: TFiler); override;
83			procedure InitFieldDefs; override;
84			procedure InternalOpen; override;
85			procedure Disconnect; override;
86			function GetParamsCount: Word;
87			function GenerateQueryForLiveUpdate : Boolean;
88			procedure SetFiltered(Value: Boolean); override;
89			procedure SQLChanged(Sender: TObject); override;
90			procedure SQLChanging(Sender: TObject); override;
91
92			public
93			constructor Create(AOwner: TComponent); override;
94			destructor Destroy; override;
95			procedure BatchInput(InputObject: TIBBatchInput);
96			procedure BatchOutput(OutputObject: TIBBatchOutput);
97			procedure ExecSQL;
98			procedure GetDetailLinkFields(MasterFields, DetailFields: TList);(* override;*)
99			function ParamByName(const Value: string): TParam;
100			procedure Prepare;
101			procedure UnPrepare;
102			procedure ResetParser; override;
103			property Prepared: Boolean read FPrepared write SetPrepare;
104			property ParamCount: Word read GetParamsCount;
105			property StmtHandle: IStatement read GetStmtHandle;
106			property StatementType;
107			property Text: string read FText;
108			property RowsAffected: Integer read GetRowsAffected;
109			// property Params: TParams read FParams write SetParamsList;
110			property BaseSQLSelect;
111
112			published
113			property Active;
114			property AutoCommit;
115			property BufferChunks;
116			property CachedUpdates;
117			property DataSource read GetDataSource write SetDataSource;
118			property EnableStatistics;
119			property GenerateParamNames;
120			// property Constraints stored ConstraintsStored;
121			property GeneratorField;
122			property MasterDetailDelay;
123			property ParamCheck;
124			property SQL: TStrings read FSQL write SetQuery;
125			property Params: TParams read FParams write SetParamsList;
126			property UniDirectional default False;
127			property UpdateObject;
128			property Filtered;
129			property DataSetCloseAction;
130
131			property BeforeDatabaseDisconnect;
132			property AfterDatabaseDisconnect;
133			property DatabaseFree;
134			property BeforeTransactionEnd;
135			property AfterTransactionEnd;
136			property TransactionFree;
137			property OnFilterRecord;
138			property OnValidatePost;
139			property OnDeleteReturning;
140			end;
141
142			implementation
143
144			uses FBMessages;
145
146			{ TIBQuery }
147
148			constructor TIBQuery.Create(AOwner: TComponent);
149			begin
150			inherited Create(AOwner);
151			FSQL := TStringList.Create;
152			TStringList(SQL).OnChange := QueryChanged;
153			FParams := TParams.Create(Self);
154			ParamCheck := True;
155			end;
156
157			destructor TIBQuery.Destroy;
158			begin
159			Destroying;
160			Disconnect;
161			SQL.Free;
162			FParams.Free;
163			inherited Destroy;
164			end;
165
166			procedure TIBQuery.InitFieldDefs;
167			begin
168			inherited InitFieldDefs;
169			end;
170
171			procedure TIBQuery.InternalOpen;
172			begin
173			ActivateConnection();
174			ActivateTransaction;
175			QSelect.GenerateParamNames := GenerateParamNames;
176			SetPrepared(True);
177			if DataSource <> nil then
178			SetParamsFromCursor;
179			SetParams;
180			inherited InternalOpen;
181			end;
182
183			procedure TIBQuery.Disconnect;
184			begin
185			Close;
186			UnPrepare;
187			end;
188
189			procedure TIBQuery.SetPrepare(Value: Boolean);
190			begin
191			if Value then
192			Prepare
193			else
194			UnPrepare;
195			end;
196
197			procedure TIBQuery.Prepare;
198			begin
199			SetPrepared(True);
200			end;
201
202			procedure TIBQuery.UnPrepare;
203			begin
204			SetPrepared(False);
205			end;
206
207			procedure TIBQuery.ResetParser;
208			begin
209			inherited ResetParser;
210			UpdateSQL;
211			end;
212
213			procedure TIBQuery.SetQuery(Value: TStrings);
214			begin
215			if SQL.Text <> Value.Text then
216			begin
217			Disconnect;
218			SQL.BeginUpdate;
219			try
220			SQL.Assign(Value);
221			finally
222			SQL.EndUpdate;
223			end;
224			end;
225			end;
226
227			procedure TIBQuery.QueryChanged(Sender: TObject);
228			begin
229			if FInQueryChanged then Exit;
230			FInQueryChanged := true;
231			try
232			if not (csReading in ComponentState) then
233			begin
234			Disconnect;
235			if csDesigning in ComponentState then
236			FText := FParams.ParseSQL(SQL.Text, true)
237			else
238			FText := SQL.Text;
239			DataEvent(dePropertyChange, 0);
240			end else
241			FText := FParams.ParseSQL(SQL.Text, true);
242
243			if not FSQLUpdating then
244			begin
245			Prepared := false;
246			SelectSQL.Assign(SQL);
247			end;
248			finally
249			FInQueryChanged := false;
250			end;
251			end;
252
253			procedure TIBQuery.SetParamsList(Value: TParams);
254			begin
255			FParams.AssignValues(Value);
256			end;
257
258			function TIBQuery.GetParamsCount: Word;
259			begin
260			Result := FParams.Count;
261			end;
262
263			procedure TIBQuery.DefineProperties(Filer: TFiler);
264
265			function WriteData: Boolean;
266			begin
267			{The following results in a stream read error with nested frames. Hence commented out until
268			someone fixes the LCL }
269			{ if Filer.Ancestor <> nil then
270			Result := not FParams.IsEqual(TIBQuery(Filer.Ancestor).FParams) else}
271			Result := FParams.Count > 0;
272			end;
273
274			begin
275			inherited DefineProperties(Filer);
276			Filer.DefineProperty('ParamData', ReadParamData, WriteParamData, WriteData); {do not localize}
277			end;
278
279
280			procedure TIBQuery.ReadParamData(Reader: TReader);
281			begin
282			FParams.Clear;
283			Reader.ReadValue;
284			Reader.ReadCollection(FParams);
285			end;
286
287			procedure TIBQuery.WriteParamData(Writer: TWriter);
288			begin
289			Writer.WriteCollection(Params);
290			end;
291
292			procedure TIBQuery.SetPrepared(Value: Boolean);
293			begin
294			CheckDatasetClosed;
295			if Value <> Prepared then
296			begin
297			if Value then
298			begin
299			if Length(Text) > 1 then PrepareSQL
300			else IBError(ibxeEmptySQLStatement, [nil]);
301			end
302			else
303			begin
304			InternalUnPrepare;
305			FParams.Clear;
306			end;
307			FPrepared := Value;
308			end;
309			end;
310
311			procedure TIBQuery.SetParamsFromCursor;
312			var
313			I: Integer;
314			DataSet: TDataSet;
315			Field: TField;
316
317			procedure CheckRequiredParams;
318			var
319			I: Integer;
320			begin
321			for I := 0 to FParams.Count - 1 do
322			with FParams[I] do
323			if not Bound then
324			IBError(ibxeRequiredParamNotSet, [FParams[I].Name]);
325			end;
326
327			begin
328			if DataSource <> nil then
329			begin
330			DataSet := DataSource.DataSet;
331			if DataSet <> nil then
332			begin
333			DataSet.FieldDefs.Update;
334			for I := 0 to FParams.Count - 1 do
335			if not FParams[I].Bound then
336			begin
337			Field := DataSet.FindField(FParams[I].Name);
338			if assigned(Field) then
339			begin
340			FParams[I].AssignField(Field);
341			FParams[I].Bound := False;
342			end;
343			end;
344			end
345			else
346			CheckRequiredParams;
347			end
348			else
349			CheckRequiredParams;
350			end;
351
352
353			function TIBQuery.ParamByName(const Value: string): TParam;
354			begin
355			if not Prepared then
356			Prepare;
357			Result := FParams.ParamByName(Value);
358			end;
359
360			procedure TIBQuery.BatchInput(InputObject: TIBBatchInput);
361			begin
362			InternalBatchInput(InputObject);
363			end;
364
365			procedure TIBQuery.BatchOutput(OutputObject: TIBBatchOutput);
366			begin
367			InternalBatchOutput(OutputObject);
368			end;
369
370			procedure TIBQuery.ExecSQL;
371			var
372			DidActivate: Boolean;
373			begin
374			CheckInActive;
375			if SQL.Count <= 0 then
376			IBError(ibxeEmptySQLStatement, [nil]);
377
378			ActivateConnection();
379			DidActivate := ActivateTransaction;
380			try
381			SetPrepared(True);
382			if DataSource <> nil then SetParamsFromCursor;
383			if FParams.Count > 0 then SetParams;
384			InternalExecQuery;
385			finally
386			if DidActivate then
387			DeactivateTransaction;
388			end;
389			end;
390
391			procedure TIBQuery.SetParams;
392
393			var
394			i : integer;
395			Buffer: Pointer;
396			SQLParam: ISQLParam;
397
398			begin
399			for I := 0 to FParams.Count - 1 do
400			begin
401			SQLParam := SQLParams.ByName(Params[i].Name);
402			if Params[i].IsNull then
403			SQLParam.IsNull := True
404			else begin
405			SQLParam.IsNull := False;
406			case Params[i].DataType of
407			ftBytes:
408			begin
409			GetMem(Buffer,Params[i].GetDataSize);
410			try
411			Params[i].GetData(Buffer);
412			SQLParam.AsPointer := Buffer;
413			finally
414			FreeMem(Buffer);
415			end;
416			end;
417			ftString:
418			SQLParam.AsString := Params[i].AsString;
419			ftBoolean:
420			SQLParam.AsBoolean := Params[i].AsBoolean;
421			ftSmallint, ftWord:
422			SQLParam.AsShort := Params[i].AsSmallInt;
423			ftInteger:
424			SQLParam.AsLong := Params[i].AsInteger;
425			ftLargeInt:
426			SQLParam.AsInt64 := Params[i].AsLargeInt;
427			ftFloat:
428			SQLParam.AsDouble := Params[i].AsFloat;
429			ftBCD, ftCurrency:
430			SQLParam.AsCurrency := Params[i].AsCurrency;
431			ftDate:
432			SQLParam.AsDate := Params[i].AsDateTime;
433			ftTime:
434			SQLParam.AsTime := Params[i].AsDateTime;
435			ftDateTime:
436			SQLParam.AsDateTime := Params[i].AsDateTime;
437			ftBlob, ftMemo:
438			SQLParam.AsString := Params[i].AsString;
439			else
440			IBError(ibxeNotSupported, [nil]);
441			end;
442			end;
443			end;
444			end;
445
446			procedure TIBQuery.PrepareSQL;
447			var List: TParams;
448			begin
449			QSelect.GenerateParamNames := GenerateParamNames;
450			InternalPrepare;
451			UpdateSQL;
452			if ParamCheck then
453			begin
454			List := TParams.Create(Self);
455			try
456			FText := List.ParseSQL(SQL.Text, True);
457			List.AssignValues(FParams);
458			FParams.Clear;
459			FParams.Assign(List);
460			finally
461			List.Free;
462			end;
463			end;
464			end;
465
466
467			function TIBQuery.GetRowsAffected: Integer;
468			begin
469			Result := -1;
470			if Prepared then
471			Result := QSelect.RowsAffected
472			end;
473
474
475			procedure TIBQuery.GetDetailLinkFields(MasterFields, DetailFields: TList);
476
477			function AddFieldToList(const FieldName: string; DataSet: TDataSet;
478			List: TList): Boolean;
479			var
480			Field: TField;
481			begin
482			Field := DataSet.FindField(FieldName);
483			if (Field <> nil) then
484			List.Add(Field);
485			Result := Field <> nil;
486			end;
487
488			var
489			i: Integer;
490			begin
491			MasterFields.Clear;
492			DetailFields.Clear;
493			if (DataSource <> nil) and (DataSource.DataSet <> nil) then
494			for i := 0 to Params.Count - 1 do
495			if AddFieldToList(Params[i].Name, DataSource.DataSet, MasterFields) then
496			AddFieldToList(Params[i].Name, Self, DetailFields);
497			end;
498
499			function TIBQuery.GetStmtHandle: IStatement;
500			begin
501			Result := SelectStmtHandle;
502			end;
503
504			procedure TIBQuery.UpdateSQL;
505			begin
506			if not FSQLUpdating and not FInQueryChanged and (SQL.Text <> SelectSQL.Text) then
507			begin
508			FSQLUpdating := true;
509			try
510			SQL.Text := SelectSQL.Text;
511			finally
512			FSQLUpdating := false
513			end;
514			end;
515			end;
516
517			function TIBQuery.GenerateQueryForLiveUpdate : Boolean;
518			begin
519			Result := False;
520			end;
521
522			procedure TIBQuery.SetFiltered(Value: Boolean);
523			begin
524			if(Filtered <> Value) then
525			begin
526			inherited SetFiltered(value);
527			if Active then
528			begin
529			Close;
530			Open;
531			end;
532			end
533			else
534			inherited SetFiltered(value);
535			end;
536
537			procedure TIBQuery.SQLChanged(Sender: TObject);
538			begin
539			inherited SQLChanged(Sender);
540			UpdateSQL;
541			end;
542
543			procedure TIBQuery.SQLChanging(Sender: TObject);
544			begin
545			inherited SQLChanging(Sender);
546			Prepared := false;
547			end;
548
549			{ TIBQuery IProviderSupport }
550			(*
551			function TIBQuery.PSGetParams: TParams;
552			begin
553			Result := Params;
554			end;
555
556			procedure TIBQuery.PSSetParams(AParams: TParams);
557			begin
558			if AParams.Count <> 0 then
559			Params.Assign(AParams);
560			Close;
561			end;
562
563			function TIBQuery.PSGetTableName: string;
564			begin
565			Result := inherited PSGetTableName;
566			end;
567
568			procedure TIBQuery.PSExecute;
569			begin
570			ExecSQL;
571			end;
572
573			procedure TIBQuery.PSSetCommandText(const CommandText: string);
574			begin
575			if CommandText <> '' then
576			SQL.Text := CommandText;
577			end;
578			*)
579			end.
580