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

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:	291
Committed:	Fri Apr 17 10:26:08 2020 UTC (4 years, 7 months ago) by tony
Content type:	text/x-pascal
File size:	12285 byte(s)
Log Message:	Changed for 2.3.4 merged into public release
#	User	Rev	Content
1	tony	209	(*
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	tony	291	Classes, SysUtils, IBCustomDataSet, DB, IB, IBDatabase, IBExternals, IBMessages;
35	tony	209
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	tony	287	function GetHasCaseSensitiveParams: Boolean;
92	tony	209	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	tony	287	function TParamListIntf.GetHasCaseSensitiveParams: Boolean;
493			begin
494			Result := false;
495			end;
496
497	tony	209	{ 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