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