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, Graphics, Classes, Controls, Db,
     IBHeader, IB, IBCustomDataSet, IBSQL;

type

{ TIBQuery }

  TIBQuery = class(TIBCustomDataSet)
  private
    FSQL: TStrings;
    FPrepared: Boolean;
    FParams: TParams;
    FText: string;
    FRowsAffected: Integer;
    FCheckRowsAffected: Boolean;
    function GetRowsAffected: Integer;
    procedure PrepareSQL(Value: PChar);
    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;  *)

    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;

  published
    property Active;
    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 BeforeDatabaseDisconnect;
    property AfterDatabaseDisconnect;
    property DatabaseFree;
    property BeforeTransactionEnd;
    property AfterTransactionEnd;
    property TransactionFree;
    property OnFilterRecord;
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 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(PChar(Text))
      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, [nil]);
  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;

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

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