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

{ 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:	209
Committed:	Wed Mar 14 12:48:51 2018 UTC (6 years, 8 months ago) by tony
Content type:	text/x-pascal
File size:	12145 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	end;
92
93	{ TParamIntf }
94
95	TParamIntf = class(TInterfacedObject,ISQLParam)
96	private
97	FIndex: integer;
98	FOwner: TParamListIntf;
99	public
100	constructor Create(aOwner: TParamListIntf; aIndex: integer);
101	function GetIndex: integer;
102	function GetSQLType: cardinal;
103	function GetSQLTypeName: AnsiString;
104	function getSubtype: integer;
105	function getName: AnsiString;
106	function getScale: integer;
107	function getCharSetID: cardinal;
108	function getCodePage: TSystemCodePage;
109	function getIsNullable: boolean;
110	function GetSize: cardinal;
111	function GetAsBoolean: boolean;
112	function GetAsCurrency: Currency;
113	function GetAsInt64: Int64;
114	function GetAsDateTime: TDateTime;
115	function GetAsDouble: Double;
116	function GetAsFloat: Float;
117	function GetAsLong: Long;
118	function GetAsPointer: Pointer;
119	function GetAsQuad: TISC_QUAD;
120	function GetAsShort: short;
121	function GetAsString: AnsiString;
122	function GetIsNull: boolean;
123	function GetAsVariant: Variant;
124	function GetAsBlob: IBlob;
125	function GetAsArray: IArray;
126	procedure Clear;
127	function GetModified: boolean;
128	procedure SetAsBoolean(AValue: boolean);
129	procedure SetAsCurrency(aValue: Currency);
130	procedure SetAsInt64(aValue: Int64);
131	procedure SetAsDate(aValue: TDateTime);
132	procedure SetAsLong(aValue: Long);
133	procedure SetAsTime(aValue: TDateTime);
134	procedure SetAsDateTime(aValue: TDateTime);
135	procedure SetAsDouble(aValue: Double);
136	procedure SetAsFloat(aValue: Float);
137	procedure SetAsPointer(aValue: Pointer);
138	procedure SetAsShort(aValue: Short);
139	procedure SetAsString(aValue: AnsiString);
140	procedure SetAsVariant(aValue: Variant);
141	procedure SetIsNull(aValue: Boolean);
142	procedure SetAsBlob(aValue: IBlob);
143	procedure SetAsArray(anArray: IArray);
144	procedure SetAsQuad(aValue: TISC_QUAD);
145	procedure SetCharSetID(aValue: cardinal);
146	end;
147
148	{ TParamIntf }
149
150	constructor TParamIntf.Create(aOwner: TParamListIntf; aIndex: integer);
151	begin
152	FOwner := aOwner;
153	FIndex := aIndex;
154	end;
155
156	function TParamIntf.GetIndex: integer;
157	begin
158	Result := Findex;
159	end;
160
161	function TParamIntf.GetSQLType: cardinal;
162	begin
163	IBError(ibxeNotSupported,[]);
164	end;
165
166	function TParamIntf.GetSQLTypeName: AnsiString;
167	begin
168	IBError(ibxeNotSupported,[]);
169	end;
170
171	function TParamIntf.getSubtype: integer;
172	begin
173	IBError(ibxeNotSupported,[]);
174	end;
175
176	function TParamIntf.getName: AnsiString;
177	begin
178	Result := FOwner.FParams[FIndex].Name;
179	end;
180
181	function TParamIntf.getScale: integer;
182	begin
183	IBError(ibxeNotSupported,[]);
184	end;
185
186	function TParamIntf.getCharSetID: cardinal;
187	var id: integer;
188	begin
189	FOwner.Database.Attachment.CodePage2CharSetID(StringCodePage(FOwner.FParams[FIndex].Value),id);
190	Result := id;
191	end;
192
193	function TParamIntf.getCodePage: TSystemCodePage;
194	begin
195	Result := StringCodePage(FOwner.FParams[FIndex].Value);
196	end;
197
198	function TParamIntf.getIsNullable: boolean;
199	begin
200	Result := true;
201	end;
202
203	function TParamIntf.GetSize: cardinal;
204	begin
205	IBError(ibxeNotSupported,[]);
206	end;
207
208	function TParamIntf.GetAsBoolean: boolean;
209	begin
210	Result := FOwner.FParams[FIndex].Value;
211	end;
212
213	function TParamIntf.GetAsCurrency: Currency;
214	begin
215	Result := FOwner.FParams[FIndex].Value;
216	end;
217
218	function TParamIntf.GetAsInt64: Int64;
219	begin
220	Result := FOwner.FParams[FIndex].Value;
221	end;
222
223	function TParamIntf.GetAsDateTime: TDateTime;
224	begin
225	Result := FOwner.FParams[FIndex].Value;
226	end;
227
228	function TParamIntf.GetAsDouble: Double;
229	begin
230	Result := FOwner.FParams[FIndex].Value;
231	end;
232
233	function TParamIntf.GetAsFloat: Float;
234	begin
235	Result := FOwner.FParams[FIndex].Value;
236	end;
237
238	function TParamIntf.GetAsLong: Long;
239	begin
240	Result := FOwner.FParams[FIndex].Value;
241	end;
242
243	function TParamIntf.GetAsPointer: Pointer;
244	begin
245	IBError(ibxeNotSupported,[]);
246	end;
247
248	function TParamIntf.GetAsQuad: TISC_QUAD;
249	begin
250	IBError(ibxeNotSupported,[]);
251	end;
252
253	function TParamIntf.GetAsShort: short;
254	begin
255	Result := FOwner.FParams[FIndex].Value;
256	end;
257
258	function TParamIntf.GetAsString: AnsiString;
259	var v: variant;
260	begin
261	v := FOwner.FParams[FIndex].Value;
262	Case varType(v) of
263	varEmpty,
264	varNull:
265	Result := '';
266	varShortInt,
267	varSmallint,
268	varInteger,
269	varInt64,
270	varByte,
271	varWord,
272	varDecimal,
273	varLongWord,
274	varQWord,
275	varSingle:
276	Result := IntToStr(v);
277	varCurrency,
278	varDouble:
279	Result := FloatToStr(v);
280	varDate:
281	Result := DateTimeToStr(v);
282	varStrArg,
283	varString:
284	Result := v;
285	varBoolean:
286	if v then
287	Result := 'true'
288	else
289	Result := 'false';
290	varVariant:
291	Result := v;
292	else
293	Result := v;
294	end;
295	end;
296
297	function TParamIntf.GetIsNull: boolean;
298	begin
299	Result := VarIsNull(FOwner.FParams[FIndex].Value);
300	end;
301
302	function TParamIntf.GetAsVariant: Variant;
303	begin
304	Result := FOwner.FParams[FIndex].Value;
305	end;
306
307	function TParamIntf.GetAsBlob: IBlob;
308	begin
309	IBError(ibxeNotSupported,[]);
310	end;
311
312	function TParamIntf.GetAsArray: IArray;
313	begin
314	IBError(ibxeNotSupported,[]);
315	end;
316
317	procedure TParamIntf.Clear;
318	begin
319	FOwner.SetParam(FIndex,NULL);
320	end;
321
322	function TParamIntf.GetModified: boolean;
323	begin
324	Result := FOwner.FParams[FIndex].Modified;
325	end;
326
327	procedure TParamIntf.SetAsBoolean(AValue: boolean);
328	begin
329	FOwner.SetParam(FIndex,AValue);
330	end;
331
332	procedure TParamIntf.SetAsCurrency(aValue: Currency);
333	begin
334	FOwner.SetParam(FIndex,AValue);
335	end;
336
337	procedure TParamIntf.SetAsInt64(aValue: Int64);
338	begin
339	FOwner.SetParam(FIndex,AValue);
340	end;
341
342	procedure TParamIntf.SetAsDate(aValue: TDateTime);
343	begin
344	FOwner.SetParam(FIndex,AValue);
345	end;
346
347	procedure TParamIntf.SetAsLong(aValue: Long);
348	begin
349	FOwner.SetParam(FIndex,AValue);
350	end;
351
352	procedure TParamIntf.SetAsTime(aValue: TDateTime);
353	begin
354	FOwner.SetParam(FIndex,AValue);
355	end;
356
357	procedure TParamIntf.SetAsDateTime(aValue: TDateTime);
358	begin
359	FOwner.SetParam(FIndex,AValue);
360	end;
361
362	procedure TParamIntf.SetAsDouble(aValue: Double);
363	begin
364	FOwner.SetParam(FIndex,AValue);
365	end;
366
367	procedure TParamIntf.SetAsFloat(aValue: Float);
368	begin
369	FOwner.SetParam(FIndex,AValue);
370	end;
371
372	procedure TParamIntf.SetAsPointer(aValue: Pointer);
373	begin
374	IBError(ibxeNotSupported,[]);
375	end;
376
377	procedure TParamIntf.SetAsShort(aValue: Short);
378	begin
379	FOwner.SetParam(FIndex,AValue);
380	end;
381
382	procedure TParamIntf.SetAsString(aValue: AnsiString);
383	begin
384	FOwner.SetParam(FIndex,AValue);
385	end;
386
387	procedure TParamIntf.SetAsVariant(aValue: Variant);
388	begin
389	FOwner.SetParam(FIndex,AValue);
390	end;
391
392	procedure TParamIntf.SetIsNull(aValue: Boolean);
393	begin
394	if aValue then
395	FOwner.SetParam(FIndex,NULL)
396	end;
397
398	procedure TParamIntf.SetAsBlob(aValue: IBlob);
399	begin
400	IBError(ibxeNotSupported,[]);
401	end;
402
403	procedure TParamIntf.SetAsArray(anArray: IArray);
404	begin
405	IBError(ibxeNotSupported,[]);
406	end;
407
408	procedure TParamIntf.SetAsQuad(aValue: TISC_QUAD);
409	begin
410	IBError(ibxeNotSupported,[]);
411	end;
412
413	procedure TParamIntf.SetCharSetID(aValue: cardinal);
414	var s: RawByteString;
415	codepage: TSystemCodePage;
416	str: string;
417	begin
418	str := FOwner.FParams[FIndex].Value;
419	s := str;
420	if FOwner.Database.Attachment.CharSetID2CodePage(aValue,codepage) then
421	SetCodePage(s,codepage,codepage <> cp_none);
422	end;
423
424	{ TParamListIntf }
425
426	procedure TParamListIntf.SetParam(index: integer; aValue: variant);
427	begin
428	FParams[index].Value := aValue;
429	FParams[index].Modified := true;
430	FModified := true;
431	end;
432
433	constructor TParamListIntf.Create(aFields: TFields; aDatabase: TIBDatabase);
434	var i,j: integer;
435	begin
436	inherited Create;
437	FDatabase := aDatabase;
438	SetLength(FParams,aFields.Count*2);
439	j := 0;
440	{set up both current and "OLD" parameters from Field Names}
441	for i := 0 to aFields.Count - 1 do
442	if aFields[i].FieldKind = fkData then
443	begin
444	FParams[j].Name := aFields[i].FieldName;
445	FParams[j].Value := NULL;
446	FParams[j].Modified := false;
447	Inc(j);
448	FParams[j].Name := 'OLD_' + aFields[i].FieldName;
449	FParams[j].Value := NULL;
450	FParams[j].Modified := false;
451	Inc(j);
452	end;
453	SetLength(FParams,j);
454	end;
455
456	destructor TParamListIntf.Destroy;
457	begin
458	SetLength(FParams,0);
459	inherited Destroy;
460	end;
461
462	function TParamListIntf.getCount: integer;
463	begin
464	Result := Length(FParams);
465	end;
466
467	function TParamListIntf.getSQLParam(index: integer): ISQLParam;
468	begin
469	if (index < 0) or (index >= getCount) then
470	IBError(ibxeInvalidColumnIndex,[nil]);
471	Result := TParamIntf.Create(self,index);
472	end;
473
474	function TParamListIntf.ByName(Idx: AnsiString): ISQLParam;
475	var i: integer;
476	begin
477	Result := nil;
478	for i := 0 to getCount - 1 do
479	if CompareText(FParams[i].Name,Idx) = 0 then
480	begin
481	Result := getSQLParam(i);
482	Exit;
483	end;
484	end;
485
486	function TParamListIntf.GetModified: Boolean;
487	begin
488	Result := FModified;
489	end;
490
491	{ TIBUpdate }
492
493	function TIBUpdate.GetSQL(UpdateKind: TUpdateKind): TStrings;
494	begin
495	Result := FDummySQL; {non empty result}
496	end;
497
498	function TIBUpdate.GetDataSet: TIBCustomDataSet;
499	begin
500	Result := FDataSet;
501	end;
502
503	procedure TIBUpdate.SetDataSet(ADataSet: TIBCustomDataSet);
504	begin
505	FDataSet := ADataset;
506	end;
507
508	procedure TIBUpdate.Apply(UpdateKind: TUpdateKind; buff: PChar);
509	var Params: ISQLParams;
510	begin
511	Params := TParamListIntf.Create(Dataset.Fields,(DataSet.Database as TIBDatabase));
512	InternalSetParams(Params,buff);
513	if assigned(FOnApplyUpdates) then
514	OnApplyUpdates(self,UpdateKind,Params);
515	end;
516
517	constructor TIBUpdate.Create(AOwner: TComponent);
518	begin
519	inherited Create(AOwner);
520	FDummySQL := TStringList.Create;
521	FDummySQL.Text := '*';
522	end;
523
524	destructor TIBUpdate.Destroy;
525	begin
526	if assigned(FDummySQL) then FDummySQL.Free;
527	inherited Destroy;
528	end;
529
530	end.
531