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