trunk/runtime/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                                                 }
{                                                                        }
{************************************************************************}

unit IBQuery;

interface

{$Mode Delphi}

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

type

{ TIBQuery }

  TIBQuery = class(TIBParserDataSet)
  private
    FSQL: TStrings;
    FPrepared: Boolean;
    FParams: TParams;
    FText: string;
    FRowsAffected: Integer;
    FCheckRowsAffected: Boolean;
    FSQLUpdating: 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: TISC_STMT_HANDLE;

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

    function CreateParser: TSelectSQLParser; 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;

  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;
    property Prepared: Boolean read FPrepared write SetPrepare;
    property ParamCount: Word read GetParamsCount;
    property StmtHandle: TISC_STMT_HANDLE 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 GenerateParamNames;
 //   property Constraints stored ConstraintsStored;
    property GeneratorField;
    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;
end;

implementation

{ TIBQuery }

constructor TIBQuery.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSQL := TStringList.Create;
  TStringList(SQL).OnChange := QueryChanged;
  FParams := TParams.Create(Self);
  ParamCheck := True;
  FRowsAffected := -1;
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.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);
var
  List: TParams;
begin
  if not (csReading in ComponentState) then
  begin
    Disconnect;
    if HasParser and not FSQLUpdating then
    begin
      FSQLUpdating := true;
      try
        SQL.Text := Parser.SQLText;
      finally
        FSQLUpdating := false
      end;
    end;
    if ParamCheck or (csDesigning in ComponentState) 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 else
      FText := SQL.Text;
    DataEvent(dePropertyChange, 0);
  end else
    FText := FParams.ParseSQL(SQL.Text, true);
  SelectSQL.Assign(SQL);
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
      FRowsAffected := -1;
      FCheckRowsAffected := True;
      if Length(Text) > 1 then PrepareSQL
      else IBError(ibxeEmptySQLStatement, [nil]);
    end
    else
    begin
      if FCheckRowsAffected then
        FRowsAffected := RowsAffected;
      InternalUnPrepare;
    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
  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
  begin
    FCheckRowsAffected := False;
    IBError(ibxeEmptySQLStatement, [nil]);
  end;
  ActivateConnection();
  DidActivate := ActivateTransaction;
  try
    SetPrepared(True);
    if DataSource <> nil then SetParamsFromCursor;
    if FParams.Count > 0 then SetParams;
    InternalExecQuery;
  finally
    if DidActivate then
      DeactivateTransaction;
    FCheckRowsAffected := True;
  end;
end;

procedure TIBQuery.SetParams;

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

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;
begin
  QSelect.GenerateParamNames := GenerateParamNames;
  InternalPrepare;
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: TISC_STMT_HANDLE;
begin
  Result := SelectStmtHandle;
end;

function TIBQuery.CreateParser: TSelectSQLParser;
begin
  Result := inherited CreateParser;
  Result.OnSQLChanging := QueryChanged;
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;

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