runtime/nongui/IBUpdate.pas

(*
 *  IBX For Lazarus (Firebird Express)
 *
 *  The contents of this file are subject to the Initial Developer's
 *  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 here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  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 Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2015 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*) 
            
unit IBUpdate;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, IBCustomDataSet, DB, IB, IBDatabase, IBExternals, FBMessages;

type

  TOnApplyUpdates = procedure(Sender: TObject; UpdateKind: TUpdateKind; Params: ISQLParams) of object;

  { TIBUpdate}

  TIBUpdate = class(TIBDataSetUpdateObject)
  private
    FDataSet: TIBCustomDataSet;
    FDummySQL: TStrings;
    FOnApplyUpdates: TOnApplyUpdates;
  protected
    function GetSQL(UpdateKind: TUpdateKind): TStrings; override;
    function GetDataSet: TIBCustomDataSet; override;
    procedure SetDataSet(ADataSet: TIBCustomDataSet); override;
    procedure Apply(UpdateKind: TUpdateKind; buff: PChar); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property DataSet;
  published
    property OnApplyUpdates: TOnApplyUpdates read FOnApplyUpdates write FOnApplyUpdates;
 end;


implementation

uses variants;

type

  { TParamListIntf }

  TParamListIntf = class(TInterfacedObject,ISQLParams)
  private
    type TParamRec = record
      Name: string;
      Value: variant;
      Modified: boolean;
    end;
  private
    FDatabase: TIBDatabase;
    FModified: boolean;
    FParams: array of TParamRec;
    procedure SetParam(index: integer; aValue: variant);
  public
    constructor Create(aFields: TFields; aDatabase: TIBDatabase);
    destructor Destroy; override;
    property Database: TIBDatabase read FDatabase;
  public
    {ISQLParams}
    function getCount: integer;
    function getSQLParam(index: integer): ISQLParam;
    function ByName(Idx: AnsiString): ISQLParam ;
    function GetModified: Boolean;
    function GetHasCaseSensitiveParams: Boolean;
  end;

  { TParamIntf }

  TParamIntf = class(TInterfacedObject,ISQLParam)
  private
    FIndex: integer;
    FOwner: TParamListIntf;
  public
    constructor Create(aOwner: TParamListIntf; aIndex: integer);
    function GetIndex: integer;
    function GetSQLType: cardinal;
    function GetSQLTypeName: AnsiString;
    function getSubtype: integer;
    function getName: AnsiString;
    function getScale: integer;
    function getCharSetID: cardinal;
    function getCodePage: TSystemCodePage;
    function getIsNullable: boolean;
    function GetSize: cardinal;
    function GetAsBoolean: boolean;
    function GetAsCurrency: Currency;
    function GetAsInt64: Int64;
    function GetAsDateTime: TDateTime;
    function GetAsDouble: Double;
    function GetAsFloat: Float;
    function GetAsLong: Long;
    function GetAsPointer: Pointer;
    function GetAsQuad: TISC_QUAD;
    function GetAsShort: short;
    function GetAsString: AnsiString;
    function GetIsNull: boolean;
    function GetAsVariant: Variant;
    function GetAsBlob: IBlob;
    function GetAsArray: IArray;
    procedure Clear;
    function GetModified: boolean;
    procedure SetAsBoolean(AValue: boolean);
    procedure SetAsCurrency(aValue: Currency);
    procedure SetAsInt64(aValue: Int64);
    procedure SetAsDate(aValue: TDateTime);
    procedure SetAsLong(aValue: Long);
    procedure SetAsTime(aValue: TDateTime);
    procedure SetAsDateTime(aValue: TDateTime);
    procedure SetAsDouble(aValue: Double);
    procedure SetAsFloat(aValue: Float);
    procedure SetAsPointer(aValue: Pointer);
    procedure SetAsShort(aValue: Short);
    procedure SetAsString(aValue: AnsiString);
    procedure SetAsVariant(aValue: Variant);
    procedure SetIsNull(aValue: Boolean);
    procedure SetAsBlob(aValue: IBlob);
    procedure SetAsArray(anArray: IArray);
    procedure SetAsQuad(aValue: TISC_QUAD);
    procedure SetCharSetID(aValue: cardinal);
  end;

{ TParamIntf }

constructor TParamIntf.Create(aOwner: TParamListIntf; aIndex: integer);
begin
  FOwner := aOwner;
  FIndex := aIndex;
end;

function TParamIntf.GetIndex: integer;
begin
  Result := Findex;
end;

function TParamIntf.GetSQLType: cardinal;
begin
  IBError(ibxeNotSupported,[]);
end;

function TParamIntf.GetSQLTypeName: AnsiString;
begin
  IBError(ibxeNotSupported,[]);
end;

function TParamIntf.getSubtype: integer;
begin
  IBError(ibxeNotSupported,[]);
end;

function TParamIntf.getName: AnsiString;
begin
  Result := FOwner.FParams[FIndex].Name;
end;

function TParamIntf.getScale: integer;
begin
  IBError(ibxeNotSupported,[]);
end;

function TParamIntf.getCharSetID: cardinal;
var id: integer;
begin
   FOwner.Database.Attachment.CodePage2CharSetID(StringCodePage(FOwner.FParams[FIndex].Value),id);
   Result := id;
end;

function TParamIntf.getCodePage: TSystemCodePage;
begin
  Result := StringCodePage(FOwner.FParams[FIndex].Value);
end;

function TParamIntf.getIsNullable: boolean;
begin
  Result := true;
end;

function TParamIntf.GetSize: cardinal;
begin
  IBError(ibxeNotSupported,[]);
end;

function TParamIntf.GetAsBoolean: boolean;
begin
  Result := FOwner.FParams[FIndex].Value;
end;

function TParamIntf.GetAsCurrency: Currency;
begin
  Result := FOwner.FParams[FIndex].Value;
end;

function TParamIntf.GetAsInt64: Int64;
begin
  Result := FOwner.FParams[FIndex].Value;
end;

function TParamIntf.GetAsDateTime: TDateTime;
begin
  Result := FOwner.FParams[FIndex].Value;
end;

function TParamIntf.GetAsDouble: Double;
begin
  Result := FOwner.FParams[FIndex].Value;
end;

function TParamIntf.GetAsFloat: Float;
begin
  Result := FOwner.FParams[FIndex].Value;
end;

function TParamIntf.GetAsLong: Long;
begin
  Result := FOwner.FParams[FIndex].Value;
end;

function TParamIntf.GetAsPointer: Pointer;
begin
  IBError(ibxeNotSupported,[]);
end;

function TParamIntf.GetAsQuad: TISC_QUAD;
begin
  IBError(ibxeNotSupported,[]);
end;

function TParamIntf.GetAsShort: short;
begin
  Result := FOwner.FParams[FIndex].Value;
end;

function TParamIntf.GetAsString: AnsiString;
var v: variant;
begin
  v := FOwner.FParams[FIndex].Value;
  Case varType(v) of
      varEmpty,
      varNull:
          Result := '';
      varShortInt,
      varSmallint,
      varInteger,
      varInt64,
      varByte,
      varWord,
      varDecimal,
      varLongWord,
      varQWord,
      varSingle:
          Result := IntToStr(v);
      varCurrency,
      varDouble:
          Result := FloatToStr(v);
      varDate:
          Result := DateTimeToStr(v);
      varStrArg,
      varString:
          Result := v;
      varBoolean:
          if v then
            Result := 'true'
          else
            Result := 'false';
      varVariant:
          Result := v;
   else
     Result := v;
   end;
end;

function TParamIntf.GetIsNull: boolean;
begin
  Result := VarIsNull(FOwner.FParams[FIndex].Value);
end;

function TParamIntf.GetAsVariant: Variant;
begin
  Result := FOwner.FParams[FIndex].Value;
end;

function TParamIntf.GetAsBlob: IBlob;
begin
  IBError(ibxeNotSupported,[]);
end;

function TParamIntf.GetAsArray: IArray;
begin
  IBError(ibxeNotSupported,[]);
end;

procedure TParamIntf.Clear;
begin
  FOwner.SetParam(FIndex,NULL);
end;

function TParamIntf.GetModified: boolean;
begin
  Result := FOwner.FParams[FIndex].Modified;
end;

procedure TParamIntf.SetAsBoolean(AValue: boolean);
begin
  FOwner.SetParam(FIndex,AValue);
end;

procedure TParamIntf.SetAsCurrency(aValue: Currency);
begin
  FOwner.SetParam(FIndex,AValue);
end;

procedure TParamIntf.SetAsInt64(aValue: Int64);
begin
  FOwner.SetParam(FIndex,AValue);
end;

procedure TParamIntf.SetAsDate(aValue: TDateTime);
begin
  FOwner.SetParam(FIndex,AValue);
end;

procedure TParamIntf.SetAsLong(aValue: Long);
begin
  FOwner.SetParam(FIndex,AValue);
end;

procedure TParamIntf.SetAsTime(aValue: TDateTime);
begin
  FOwner.SetParam(FIndex,AValue);
end;

procedure TParamIntf.SetAsDateTime(aValue: TDateTime);
begin
  FOwner.SetParam(FIndex,AValue);
end;

procedure TParamIntf.SetAsDouble(aValue: Double);
begin
  FOwner.SetParam(FIndex,AValue);
end;

procedure TParamIntf.SetAsFloat(aValue: Float);
begin
  FOwner.SetParam(FIndex,AValue);
end;

procedure TParamIntf.SetAsPointer(aValue: Pointer);
begin
  IBError(ibxeNotSupported,[]);
end;

procedure TParamIntf.SetAsShort(aValue: Short);
begin
  FOwner.SetParam(FIndex,AValue);
end;

procedure TParamIntf.SetAsString(aValue: AnsiString);
begin
  FOwner.SetParam(FIndex,AValue);
end;

procedure TParamIntf.SetAsVariant(aValue: Variant);
begin
  FOwner.SetParam(FIndex,AValue);
end;

procedure TParamIntf.SetIsNull(aValue: Boolean);
begin
  if aValue then
    FOwner.SetParam(FIndex,NULL)
end;

procedure TParamIntf.SetAsBlob(aValue: IBlob);
begin
  IBError(ibxeNotSupported,[]);
end;

procedure TParamIntf.SetAsArray(anArray: IArray);
begin
  IBError(ibxeNotSupported,[]);
end;

procedure TParamIntf.SetAsQuad(aValue: TISC_QUAD);
begin
  IBError(ibxeNotSupported,[]);
end;

procedure TParamIntf.SetCharSetID(aValue: cardinal);
var s: RawByteString;
    codepage: TSystemCodePage;
    str: string;
begin
  str := FOwner.FParams[FIndex].Value;
  s := str;
  if FOwner.Database.Attachment.CharSetID2CodePage(aValue,codepage) then
    SetCodePage(s,codepage,codepage <> cp_none);
end;

{ TParamListIntf }

procedure TParamListIntf.SetParam(index: integer; aValue: variant);
begin
  FParams[index].Value := aValue;
  FParams[index].Modified := true;
  FModified := true;
end;

constructor TParamListIntf.Create(aFields: TFields; aDatabase: TIBDatabase);
var i,j: integer;
begin
  inherited Create;
  FDatabase := aDatabase;
  SetLength(FParams,aFields.Count*2);
  j := 0;
  {set up both current and "OLD" parameters from Field Names}
  for i := 0 to aFields.Count - 1 do
  if aFields[i].FieldKind = fkData then
  begin
    FParams[j].Name := aFields[i].FieldName;
    FParams[j].Value := NULL;
    FParams[j].Modified := false;
    Inc(j);
    FParams[j].Name := 'OLD_' + aFields[i].FieldName;
    FParams[j].Value := NULL;
    FParams[j].Modified := false;
    Inc(j);
  end;
  SetLength(FParams,j);
end;

destructor TParamListIntf.Destroy;
begin
  SetLength(FParams,0);
  inherited Destroy;
end;

function TParamListIntf.getCount: integer;
begin
  Result := Length(FParams);
end;

function TParamListIntf.getSQLParam(index: integer): ISQLParam;
begin
  if (index < 0) or (index >= getCount) then
    IBError(ibxeInvalidColumnIndex,[nil]);
  Result := TParamIntf.Create(self,index);
end;

function TParamListIntf.ByName(Idx: AnsiString): ISQLParam;
var i: integer;
begin
  Result := nil;
  for i := 0 to getCount - 1 do
    if CompareText(FParams[i].Name,Idx) = 0 then
    begin
      Result := getSQLParam(i);
      Exit;
    end;
end;

function TParamListIntf.GetModified: Boolean;
begin
  Result := FModified;
end;

function TParamListIntf.GetHasCaseSensitiveParams: Boolean;
begin
  Result := false;
end;

{ TIBUpdate }

function TIBUpdate.GetSQL(UpdateKind: TUpdateKind): TStrings;
begin
  Result := FDummySQL; {non empty result}
end;

function TIBUpdate.GetDataSet: TIBCustomDataSet;
begin
  Result := FDataSet;
end;

procedure TIBUpdate.SetDataSet(ADataSet: TIBCustomDataSet);
begin
  FDataSet := ADataset;
end;

procedure TIBUpdate.Apply(UpdateKind: TUpdateKind; buff: PChar);
var Params: ISQLParams;
begin
  Params := TParamListIntf.Create(Dataset.Fields,(DataSet.Database as TIBDatabase));
  InternalSetParams(Params,buff);
  if assigned(FOnApplyUpdates) then
    OnApplyUpdates(self,UpdateKind,Params);
end;

constructor TIBUpdate.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDummySQL := TStringList.Create;
  FDummySQL.Text := '*';
end;

destructor TIBUpdate.Destroy;
begin
  if assigned(FDummySQL) then FDummySQL.Free;
  inherited Destroy;
end;

end.

Revision:	287
Committed:	Thu Apr 11 08:51:23 2019 UTC (5 years, 7 months ago) by tony
Content type:	text/x-pascal
File size:	12285 byte(s)
Log Message:	Fixes Merged
#	Content
1	(*
2	* IBX For Lazarus (Firebird Express)
3	*
4	* The contents of this file are subject to the Initial Developer's
5	* Public License Version 1.0 (the "License"); you may not use this
6	* file except in compliance with the License. You may obtain a copy
7	* of the License here:
8	*
9	* http://www.firebirdsql.org/index.php?op=doc&id=idpl
10	*
11	* Software distributed under the License is distributed on an "AS
12	* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
13	* implied. See the License for the specific language governing rights
14	* and limitations under the License.
15	*
16	* The Initial Developer of the Original Code is Tony Whyman.
17	*
18	* The Original Code is (C) 2015 Tony Whyman, MWA Software
19	* (http://www.mwasoftware.co.uk).
20	*
21	* All Rights Reserved.
22	*
23	* Contributor(s): ______________________________________.
24	*
25	*)
26
27	unit IBUpdate;
28
29	{$mode objfpc}{$H+}
30
31	interface
32
33	uses
34	Classes, SysUtils, IBCustomDataSet, DB, IB, IBDatabase, IBExternals, FBMessages;
35
36	type
37
38	TOnApplyUpdates = procedure(Sender: TObject; UpdateKind: TUpdateKind; Params: ISQLParams) of object;
39
40	{ TIBUpdate}
41
42	TIBUpdate = class(TIBDataSetUpdateObject)
43	private
44	FDataSet: TIBCustomDataSet;
45	FDummySQL: TStrings;
46	FOnApplyUpdates: TOnApplyUpdates;
47	protected
48	function GetSQL(UpdateKind: TUpdateKind): TStrings; override;
49	function GetDataSet: TIBCustomDataSet; override;
50	procedure SetDataSet(ADataSet: TIBCustomDataSet); override;
51	procedure Apply(UpdateKind: TUpdateKind; buff: PChar); override;
52	public
53	constructor Create(AOwner: TComponent); override;
54	destructor Destroy; override;
55	property DataSet;
56	published
57	property OnApplyUpdates: TOnApplyUpdates read FOnApplyUpdates write FOnApplyUpdates;
58	end;
59
60
61	implementation
62
63	uses variants;
64
65	type
66
67	{ TParamListIntf }
68
69	TParamListIntf = class(TInterfacedObject,ISQLParams)
70	private
71	type TParamRec = record
72	Name: string;
73	Value: variant;
74	Modified: boolean;
75	end;
76	private
77	FDatabase: TIBDatabase;
78	FModified: boolean;
79	FParams: array of TParamRec;
80	procedure SetParam(index: integer; aValue: variant);
81	public
82	constructor Create(aFields: TFields; aDatabase: TIBDatabase);
83	destructor Destroy; override;
84	property Database: TIBDatabase read FDatabase;
85	public
86	{ISQLParams}
87	function getCount: integer;
88	function getSQLParam(index: integer): ISQLParam;
89	function ByName(Idx: AnsiString): ISQLParam ;
90	function GetModified: Boolean;
91	function GetHasCaseSensitiveParams: Boolean;
92	end;
93
94	{ TParamIntf }
95
96	TParamIntf = class(TInterfacedObject,ISQLParam)
97	private
98	FIndex: integer;
99	FOwner: TParamListIntf;
100	public
101	constructor Create(aOwner: TParamListIntf; aIndex: integer);
102	function GetIndex: integer;
103	function GetSQLType: cardinal;
104	function GetSQLTypeName: AnsiString;
105	function getSubtype: integer;
106	function getName: AnsiString;
107	function getScale: integer;
108	function getCharSetID: cardinal;
109	function getCodePage: TSystemCodePage;
110	function getIsNullable: boolean;
111	function GetSize: cardinal;
112	function GetAsBoolean: boolean;
113	function GetAsCurrency: Currency;
114	function GetAsInt64: Int64;
115	function GetAsDateTime: TDateTime;
116	function GetAsDouble: Double;
117	function GetAsFloat: Float;
118	function GetAsLong: Long;
119	function GetAsPointer: Pointer;
120	function GetAsQuad: TISC_QUAD;
121	function GetAsShort: short;
122	function GetAsString: AnsiString;
123	function GetIsNull: boolean;
124	function GetAsVariant: Variant;
125	function GetAsBlob: IBlob;
126	function GetAsArray: IArray;
127	procedure Clear;
128	function GetModified: boolean;
129	procedure SetAsBoolean(AValue: boolean);
130	procedure SetAsCurrency(aValue: Currency);
131	procedure SetAsInt64(aValue: Int64);
132	procedure SetAsDate(aValue: TDateTime);
133	procedure SetAsLong(aValue: Long);
134	procedure SetAsTime(aValue: TDateTime);
135	procedure SetAsDateTime(aValue: TDateTime);
136	procedure SetAsDouble(aValue: Double);
137	procedure SetAsFloat(aValue: Float);
138	procedure SetAsPointer(aValue: Pointer);
139	procedure SetAsShort(aValue: Short);
140	procedure SetAsString(aValue: AnsiString);
141	procedure SetAsVariant(aValue: Variant);
142	procedure SetIsNull(aValue: Boolean);
143	procedure SetAsBlob(aValue: IBlob);
144	procedure SetAsArray(anArray: IArray);
145	procedure SetAsQuad(aValue: TISC_QUAD);
146	procedure SetCharSetID(aValue: cardinal);
147	end;
148
149	{ TParamIntf }
150
151	constructor TParamIntf.Create(aOwner: TParamListIntf; aIndex: integer);
152	begin
153	FOwner := aOwner;
154	FIndex := aIndex;
155	end;
156
157	function TParamIntf.GetIndex: integer;
158	begin
159	Result := Findex;
160	end;
161
162	function TParamIntf.GetSQLType: cardinal;
163	begin
164	IBError(ibxeNotSupported,[]);
165	end;
166
167	function TParamIntf.GetSQLTypeName: AnsiString;
168	begin
169	IBError(ibxeNotSupported,[]);
170	end;
171
172	function TParamIntf.getSubtype: integer;
173	begin
174	IBError(ibxeNotSupported,[]);
175	end;
176
177	function TParamIntf.getName: AnsiString;
178	begin
179	Result := FOwner.FParams[FIndex].Name;
180	end;
181
182	function TParamIntf.getScale: integer;
183	begin
184	IBError(ibxeNotSupported,[]);
185	end;
186
187	function TParamIntf.getCharSetID: cardinal;
188	var id: integer;
189	begin
190	FOwner.Database.Attachment.CodePage2CharSetID(StringCodePage(FOwner.FParams[FIndex].Value),id);
191	Result := id;
192	end;
193
194	function TParamIntf.getCodePage: TSystemCodePage;
195	begin
196	Result := StringCodePage(FOwner.FParams[FIndex].Value);
197	end;
198
199	function TParamIntf.getIsNullable: boolean;
200	begin
201	Result := true;
202	end;
203
204	function TParamIntf.GetSize: cardinal;
205	begin
206	IBError(ibxeNotSupported,[]);
207	end;
208
209	function TParamIntf.GetAsBoolean: boolean;
210	begin
211	Result := FOwner.FParams[FIndex].Value;
212	end;
213
214	function TParamIntf.GetAsCurrency: Currency;
215	begin
216	Result := FOwner.FParams[FIndex].Value;
217	end;
218
219	function TParamIntf.GetAsInt64: Int64;
220	begin
221	Result := FOwner.FParams[FIndex].Value;
222	end;
223
224	function TParamIntf.GetAsDateTime: TDateTime;
225	begin
226	Result := FOwner.FParams[FIndex].Value;
227	end;
228
229	function TParamIntf.GetAsDouble: Double;
230	begin
231	Result := FOwner.FParams[FIndex].Value;
232	end;
233
234	function TParamIntf.GetAsFloat: Float;
235	begin
236	Result := FOwner.FParams[FIndex].Value;
237	end;
238
239	function TParamIntf.GetAsLong: Long;
240	begin
241	Result := FOwner.FParams[FIndex].Value;
242	end;
243
244	function TParamIntf.GetAsPointer: Pointer;
245	begin
246	IBError(ibxeNotSupported,[]);
247	end;
248
249	function TParamIntf.GetAsQuad: TISC_QUAD;
250	begin
251	IBError(ibxeNotSupported,[]);
252	end;
253
254	function TParamIntf.GetAsShort: short;
255	begin
256	Result := FOwner.FParams[FIndex].Value;
257	end;
258
259	function TParamIntf.GetAsString: AnsiString;
260	var v: variant;
261	begin
262	v := FOwner.FParams[FIndex].Value;
263	Case varType(v) of
264	varEmpty,
265	varNull:
266	Result := '';
267	varShortInt,
268	varSmallint,
269	varInteger,
270	varInt64,
271	varByte,
272	varWord,
273	varDecimal,
274	varLongWord,
275	varQWord,
276	varSingle:
277	Result := IntToStr(v);
278	varCurrency,
279	varDouble:
280	Result := FloatToStr(v);
281	varDate:
282	Result := DateTimeToStr(v);
283	varStrArg,
284	varString:
285	Result := v;
286	varBoolean:
287	if v then
288	Result := 'true'
289	else
290	Result := 'false';
291	varVariant:
292	Result := v;
293	else
294	Result := v;
295	end;
296	end;
297
298	function TParamIntf.GetIsNull: boolean;
299	begin
300	Result := VarIsNull(FOwner.FParams[FIndex].Value);
301	end;
302
303	function TParamIntf.GetAsVariant: Variant;
304	begin
305	Result := FOwner.FParams[FIndex].Value;
306	end;
307
308	function TParamIntf.GetAsBlob: IBlob;
309	begin
310	IBError(ibxeNotSupported,[]);
311	end;
312
313	function TParamIntf.GetAsArray: IArray;
314	begin
315	IBError(ibxeNotSupported,[]);
316	end;
317
318	procedure TParamIntf.Clear;
319	begin
320	FOwner.SetParam(FIndex,NULL);
321	end;
322
323	function TParamIntf.GetModified: boolean;
324	begin
325	Result := FOwner.FParams[FIndex].Modified;
326	end;
327
328	procedure TParamIntf.SetAsBoolean(AValue: boolean);
329	begin
330	FOwner.SetParam(FIndex,AValue);
331	end;
332
333	procedure TParamIntf.SetAsCurrency(aValue: Currency);
334	begin
335	FOwner.SetParam(FIndex,AValue);
336	end;
337
338	procedure TParamIntf.SetAsInt64(aValue: Int64);
339	begin
340	FOwner.SetParam(FIndex,AValue);
341	end;
342
343	procedure TParamIntf.SetAsDate(aValue: TDateTime);
344	begin
345	FOwner.SetParam(FIndex,AValue);
346	end;
347
348	procedure TParamIntf.SetAsLong(aValue: Long);
349	begin
350	FOwner.SetParam(FIndex,AValue);
351	end;
352
353	procedure TParamIntf.SetAsTime(aValue: TDateTime);
354	begin
355	FOwner.SetParam(FIndex,AValue);
356	end;
357
358	procedure TParamIntf.SetAsDateTime(aValue: TDateTime);
359	begin
360	FOwner.SetParam(FIndex,AValue);
361	end;
362
363	procedure TParamIntf.SetAsDouble(aValue: Double);
364	begin
365	FOwner.SetParam(FIndex,AValue);
366	end;
367
368	procedure TParamIntf.SetAsFloat(aValue: Float);
369	begin
370	FOwner.SetParam(FIndex,AValue);
371	end;
372
373	procedure TParamIntf.SetAsPointer(aValue: Pointer);
374	begin
375	IBError(ibxeNotSupported,[]);
376	end;
377
378	procedure TParamIntf.SetAsShort(aValue: Short);
379	begin
380	FOwner.SetParam(FIndex,AValue);
381	end;
382
383	procedure TParamIntf.SetAsString(aValue: AnsiString);
384	begin
385	FOwner.SetParam(FIndex,AValue);
386	end;
387
388	procedure TParamIntf.SetAsVariant(aValue: Variant);
389	begin
390	FOwner.SetParam(FIndex,AValue);
391	end;
392
393	procedure TParamIntf.SetIsNull(aValue: Boolean);
394	begin
395	if aValue then
396	FOwner.SetParam(FIndex,NULL)
397	end;
398
399	procedure TParamIntf.SetAsBlob(aValue: IBlob);
400	begin
401	IBError(ibxeNotSupported,[]);
402	end;
403
404	procedure TParamIntf.SetAsArray(anArray: IArray);
405	begin
406	IBError(ibxeNotSupported,[]);
407	end;
408
409	procedure TParamIntf.SetAsQuad(aValue: TISC_QUAD);
410	begin
411	IBError(ibxeNotSupported,[]);
412	end;
413
414	procedure TParamIntf.SetCharSetID(aValue: cardinal);
415	var s: RawByteString;
416	codepage: TSystemCodePage;
417	str: string;
418	begin
419	str := FOwner.FParams[FIndex].Value;
420	s := str;
421	if FOwner.Database.Attachment.CharSetID2CodePage(aValue,codepage) then
422	SetCodePage(s,codepage,codepage <> cp_none);
423	end;
424
425	{ TParamListIntf }
426
427	procedure TParamListIntf.SetParam(index: integer; aValue: variant);
428	begin
429	FParams[index].Value := aValue;
430	FParams[index].Modified := true;
431	FModified := true;
432	end;
433
434	constructor TParamListIntf.Create(aFields: TFields; aDatabase: TIBDatabase);
435	var i,j: integer;
436	begin
437	inherited Create;
438	FDatabase := aDatabase;
439	SetLength(FParams,aFields.Count*2);
440	j := 0;
441	{set up both current and "OLD" parameters from Field Names}
442	for i := 0 to aFields.Count - 1 do
443	if aFields[i].FieldKind = fkData then
444	begin
445	FParams[j].Name := aFields[i].FieldName;
446	FParams[j].Value := NULL;
447	FParams[j].Modified := false;
448	Inc(j);
449	FParams[j].Name := 'OLD_' + aFields[i].FieldName;
450	FParams[j].Value := NULL;
451	FParams[j].Modified := false;
452	Inc(j);
453	end;
454	SetLength(FParams,j);
455	end;
456
457	destructor TParamListIntf.Destroy;
458	begin
459	SetLength(FParams,0);
460	inherited Destroy;
461	end;
462
463	function TParamListIntf.getCount: integer;
464	begin
465	Result := Length(FParams);
466	end;
467
468	function TParamListIntf.getSQLParam(index: integer): ISQLParam;
469	begin
470	if (index < 0) or (index >= getCount) then
471	IBError(ibxeInvalidColumnIndex,[nil]);
472	Result := TParamIntf.Create(self,index);
473	end;
474
475	function TParamListIntf.ByName(Idx: AnsiString): ISQLParam;
476	var i: integer;
477	begin
478	Result := nil;
479	for i := 0 to getCount - 1 do
480	if CompareText(FParams[i].Name,Idx) = 0 then
481	begin
482	Result := getSQLParam(i);
483	Exit;
484	end;
485	end;
486
487	function TParamListIntf.GetModified: Boolean;
488	begin
489	Result := FModified;
490	end;
491
492	function TParamListIntf.GetHasCaseSensitiveParams: Boolean;
493	begin
494	Result := false;
495	end;
496
497	{ TIBUpdate }
498
499	function TIBUpdate.GetSQL(UpdateKind: TUpdateKind): TStrings;
500	begin
501	Result := FDummySQL; {non empty result}
502	end;
503
504	function TIBUpdate.GetDataSet: TIBCustomDataSet;
505	begin
506	Result := FDataSet;
507	end;
508
509	procedure TIBUpdate.SetDataSet(ADataSet: TIBCustomDataSet);
510	begin
511	FDataSet := ADataset;
512	end;
513
514	procedure TIBUpdate.Apply(UpdateKind: TUpdateKind; buff: PChar);
515	var Params: ISQLParams;
516	begin
517	Params := TParamListIntf.Create(Dataset.Fields,(DataSet.Database as TIBDatabase));
518	InternalSetParams(Params,buff);
519	if assigned(FOnApplyUpdates) then
520	OnApplyUpdates(self,UpdateKind,Params);
521	end;
522
523	constructor TIBUpdate.Create(AOwner: TComponent);
524	begin
525	inherited Create(AOwner);
526	FDummySQL := TStringList.Create;
527	FDummySQL.Text := '*';
528	end;
529
530	destructor TIBUpdate.Destroy;
531	begin
532	if assigned(FDummySQL) then FDummySQL.Free;
533	inherited Destroy;
534	end;
535
536	end.
537