trunk/runtime/IBUpdateSQL.pas

{************************************************************************}
{                                                                        }
{       Borland Delphi Visual Component Library                          }
{       InterBase Express core components                                }
{                                                                        }
{       Copyright (c) 1998-2000 Inprise Corporation                      }
{                                                                        }
{    InterBase Express is based in part on the product                   }
{    Free IB Components, written by Gregory H. Deatz for                 }
{    Hoagland, Longo, Moran, Dunst & Doukas Company.                     }
{    Free IB Components is used under license.                           }
{                                                                        }
{    The contents of this file are subject to the InterBase              }
{    Public License Version 1.0 (the "License"); you may not             }
{    use this file except in compliance with the License. You            }
{    may obtain a copy of the License at http://www.Inprise.com/IPL.html }
{    Software distributed under the License is distributed on            }
{    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
{    express or implied. See the License for the specific language       }
{    governing rights and limitations under the License.                 }
{    The Original Code was created by InterBase Software Corporation     }
{       and its successors.                                              }
{    Portions created by Inprise Corporation are Copyright (C) Inprise   }
{       Corporation. All Rights Reserved.                                }
{    Contributor(s): Jeff Overcash                                       }
{                                                                        }
{************************************************************************}

unit IBUpdateSQL;

interface

uses Windows, SysUtils, Graphics, Classes, Controls, Db, StdVCL,
     IB, IBCustomDataSet, IBQuery;

type
{ TIBUpdateSQL }

  TIBUpdateSQL = class(TIBDataSetUpdateObject)
  private
    FDataSet: TIBCustomDataSet;
    FQueries: array[TUpdateKind] of TIBQuery;
    FSQLText: array[TUpdateKind] of TStrings;
    function GetQuery(UpdateKind: TUpdateKind): TIBQuery;
    function GetSQLIndex(Index: Integer): TStrings;
    procedure SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
    procedure SetSQLIndex(Index: Integer; Value: TStrings);
  protected
    function GetSQL(UpdateKind: TUpdateKind): TStrings; override;
    function GetDataSet: TIBCustomDataSet; override;
    procedure SetDataSet(ADataSet: TIBCustomDataSet); override;
    procedure SQLChanged(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Apply(UpdateKind: TUpdateKind); override;
    procedure ExecSQL(UpdateKind: TUpdateKind);
    procedure SetParams(UpdateKind: TUpdateKind);
    property DataSet;
    property Query[UpdateKind: TUpdateKind]: TIBQuery read GetQuery;
    property SQL[UpdateKind: TUpdateKind]: TStrings read GetSQL write SetSQL;
  published
    property ModifySQL: TStrings index 0 read GetSQLIndex write SetSQLIndex;
    property InsertSQL: TStrings index 1 read GetSQLIndex write SetSQLIndex;
    property DeleteSQL: TStrings index 2 read GetSQLIndex write SetSQLIndex;
  end;

implementation

{ TIBUpdateSQL }

constructor TIBUpdateSQL.Create(AOwner: TComponent);
var
  UpdateKind: TUpdateKind;
begin
  inherited Create(AOwner);
  for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
  begin
    FSQLText[UpdateKind] := TStringList.Create;
    TStringList(FSQLText[UpdateKind]).OnChange := SQLChanged;
  end;
end;

destructor TIBUpdateSQL.Destroy;
var
  UpdateKind: TUpdateKind;
begin
  if Assigned(FDataSet) and (FDataSet.UpdateObject = Self) then
    FDataSet.UpdateObject := nil;
  for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
    FSQLText[UpdateKind].Free;
  inherited Destroy;
end;

procedure TIBUpdateSQL.ExecSQL(UpdateKind: TUpdateKind);
begin
  with Query[UpdateKind] do
  begin
    Prepare;
    ExecSQL;
    if RowsAffected <> 1 then IBError(ibxeUpdateFailed, [nil]);
  end;
end;

function TIBUpdateSQL.GetQuery(UpdateKind: TUpdateKind): TIBQuery;
begin
  if not Assigned(FQueries[UpdateKind]) then
  begin
    FQueries[UpdateKind] := TIBQuery.Create(Self);
    FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
    if (FDataSet is TIBCustomDataSet) then
    begin
      FQueries[UpdateKind].Database := TIBCustomDataSet(FDataSet).DataBase;
      FQueries[UpdateKind].Transaction := TIBCustomDataSet(FDataSet).Transaction;
    end;
  end;
  Result := FQueries[UpdateKind];
end;

function TIBUpdateSQL.GetSQL(UpdateKind: TUpdateKind): TStrings;
begin
  Result := FSQLText[UpdateKind];
end;

function TIBUpdateSQL.GetSQLIndex(Index: Integer): TStrings;
begin
  Result := FSQLText[TUpdateKind(Index)];
end;

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

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

procedure TIBUpdateSQL.SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
begin
  FSQLText[UpdateKind].Assign(Value);
end;

procedure TIBUpdateSQL.SetSQLIndex(Index: Integer; Value: TStrings);
begin
  SetSQL(TUpdateKind(Index), Value);
end;

procedure TIBUpdateSQL.SQLChanged(Sender: TObject);
var
  UpdateKind: TUpdateKind;
begin
  for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
    if Sender = FSQLText[UpdateKind] then
    begin
      if Assigned(FQueries[UpdateKind]) then
      begin
        FQueries[UpdateKind].Params.Clear;
        FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
      end;
      Break;
    end;
end;

procedure TIBUpdateSQL.SetParams(UpdateKind: TUpdateKind);
var
  I: Integer;
  Old: Boolean;
  Param: TParam;
  PName: string;
  Field: TField;
  Value: Variant;
begin
  if not Assigned(FDataSet) then Exit;
  with Query[UpdateKind] do
  begin
    for I := 0 to Params.Count - 1 do
    begin
      Param := Params[I];
      PName := Param.Name;
      Old := CompareText(Copy(PName, 1, 4), 'OLD_') = 0; {do not localize}
      if Old then
        System.Delete(PName, 1, 4);
      Field := FDataSet.FindField(PName);
      if not Assigned(Field) then
        Continue;
      if Old then
        Param.AssignFieldValue(Field, Field.OldValue) else
      begin
        Value := Field.NewValue;
        if VarIsEmpty(Value) then
          Value := Field.OldValue;
        Param.AssignFieldValue(Field, Value);
      end;
    end;
  end;
end;

procedure TIBUpdateSQL.Apply(UpdateKind: TUpdateKind);
begin
  SetParams(UpdateKind);
  ExecSQL(UpdateKind);
end;

end.
Revision:	1
Committed:	Mon Jul 31 16:43:00 2000 UTC (24 years, 4 months ago) by tony
Content type:	text/x-pascal
File size:	6853 byte(s)
Log Message:	Borland IBX Open Source Release
#	User	Rev	Content
1	tony	1	{************************************************************************}
2			{ }
3			{ Borland Delphi Visual Component Library }
4			{ InterBase Express core components }
5			{ }
6			{ Copyright (c) 1998-2000 Inprise Corporation }
7			{ }
8			{ InterBase Express is based in part on the product }
9			{ Free IB Components, written by Gregory H. Deatz for }
10			{ Hoagland, Longo, Moran, Dunst & Doukas Company. }
11			{ Free IB Components is used under license. }
12			{ }
13			{ The contents of this file are subject to the InterBase }
14			{ Public License Version 1.0 (the "License"); you may not }
15			{ use this file except in compliance with the License. You }
16			{ may obtain a copy of the License at http://www.Inprise.com/IPL.html }
17			{ Software distributed under the License is distributed on }
18			{ an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
19			{ express or implied. See the License for the specific language }
20			{ governing rights and limitations under the License. }
21			{ The Original Code was created by InterBase Software Corporation }
22			{ and its successors. }
23			{ Portions created by Inprise Corporation are Copyright (C) Inprise }
24			{ Corporation. All Rights Reserved. }
25			{ Contributor(s): Jeff Overcash }
26			{ }
27			{************************************************************************}
28
29			unit IBUpdateSQL;
30
31			interface
32
33			uses Windows, SysUtils, Graphics, Classes, Controls, Db, StdVCL,
34			IB, IBCustomDataSet, IBQuery;
35
36			type
37			{ TIBUpdateSQL }
38
39			TIBUpdateSQL = class(TIBDataSetUpdateObject)
40			private
41			FDataSet: TIBCustomDataSet;
42			FQueries: array[TUpdateKind] of TIBQuery;
43			FSQLText: array[TUpdateKind] of TStrings;
44			function GetQuery(UpdateKind: TUpdateKind): TIBQuery;
45			function GetSQLIndex(Index: Integer): TStrings;
46			procedure SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
47			procedure SetSQLIndex(Index: Integer; Value: TStrings);
48			protected
49			function GetSQL(UpdateKind: TUpdateKind): TStrings; override;
50			function GetDataSet: TIBCustomDataSet; override;
51			procedure SetDataSet(ADataSet: TIBCustomDataSet); override;
52			procedure SQLChanged(Sender: TObject);
53			public
54			constructor Create(AOwner: TComponent); override;
55			destructor Destroy; override;
56			procedure Apply(UpdateKind: TUpdateKind); override;
57			procedure ExecSQL(UpdateKind: TUpdateKind);
58			procedure SetParams(UpdateKind: TUpdateKind);
59			property DataSet;
60			property Query[UpdateKind: TUpdateKind]: TIBQuery read GetQuery;
61			property SQL[UpdateKind: TUpdateKind]: TStrings read GetSQL write SetSQL;
62			published
63			property ModifySQL: TStrings index 0 read GetSQLIndex write SetSQLIndex;
64			property InsertSQL: TStrings index 1 read GetSQLIndex write SetSQLIndex;
65			property DeleteSQL: TStrings index 2 read GetSQLIndex write SetSQLIndex;
66			end;
67
68			implementation
69
70			{ TIBUpdateSQL }
71
72			constructor TIBUpdateSQL.Create(AOwner: TComponent);
73			var
74			UpdateKind: TUpdateKind;
75			begin
76			inherited Create(AOwner);
77			for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
78			begin
79			FSQLText[UpdateKind] := TStringList.Create;
80			TStringList(FSQLText[UpdateKind]).OnChange := SQLChanged;
81			end;
82			end;
83
84			destructor TIBUpdateSQL.Destroy;
85			var
86			UpdateKind: TUpdateKind;
87			begin
88			if Assigned(FDataSet) and (FDataSet.UpdateObject = Self) then
89			FDataSet.UpdateObject := nil;
90			for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
91			FSQLText[UpdateKind].Free;
92			inherited Destroy;
93			end;
94
95			procedure TIBUpdateSQL.ExecSQL(UpdateKind: TUpdateKind);
96			begin
97			with Query[UpdateKind] do
98			begin
99			Prepare;
100			ExecSQL;
101			if RowsAffected <> 1 then IBError(ibxeUpdateFailed, [nil]);
102			end;
103			end;
104
105			function TIBUpdateSQL.GetQuery(UpdateKind: TUpdateKind): TIBQuery;
106			begin
107			if not Assigned(FQueries[UpdateKind]) then
108			begin
109			FQueries[UpdateKind] := TIBQuery.Create(Self);
110			FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
111			if (FDataSet is TIBCustomDataSet) then
112			begin
113			FQueries[UpdateKind].Database := TIBCustomDataSet(FDataSet).DataBase;
114			FQueries[UpdateKind].Transaction := TIBCustomDataSet(FDataSet).Transaction;
115			end;
116			end;
117			Result := FQueries[UpdateKind];
118			end;
119
120			function TIBUpdateSQL.GetSQL(UpdateKind: TUpdateKind): TStrings;
121			begin
122			Result := FSQLText[UpdateKind];
123			end;
124
125			function TIBUpdateSQL.GetSQLIndex(Index: Integer): TStrings;
126			begin
127			Result := FSQLText[TUpdateKind(Index)];
128			end;
129
130			function TIBUpdateSQL.GetDataSet: TIBCustomDataSet;
131			begin
132			Result := FDataSet;
133			end;
134
135			procedure TIBUpdateSQL.SetDataSet(ADataSet: TIBCustomDataSet);
136			begin
137			FDataSet := ADataSet;
138			end;
139
140			procedure TIBUpdateSQL.SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
141			begin
142			FSQLText[UpdateKind].Assign(Value);
143			end;
144
145			procedure TIBUpdateSQL.SetSQLIndex(Index: Integer; Value: TStrings);
146			begin
147			SetSQL(TUpdateKind(Index), Value);
148			end;
149
150			procedure TIBUpdateSQL.SQLChanged(Sender: TObject);
151			var
152			UpdateKind: TUpdateKind;
153			begin
154			for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
155			if Sender = FSQLText[UpdateKind] then
156			begin
157			if Assigned(FQueries[UpdateKind]) then
158			begin
159			FQueries[UpdateKind].Params.Clear;
160			FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
161			end;
162			Break;
163			end;
164			end;
165
166			procedure TIBUpdateSQL.SetParams(UpdateKind: TUpdateKind);
167			var
168			I: Integer;
169			Old: Boolean;
170			Param: TParam;
171			PName: string;
172			Field: TField;
173			Value: Variant;
174			begin
175			if not Assigned(FDataSet) then Exit;
176			with Query[UpdateKind] do
177			begin
178			for I := 0 to Params.Count - 1 do
179			begin
180			Param := Params[I];
181			PName := Param.Name;
182			Old := CompareText(Copy(PName, 1, 4), 'OLD_') = 0; {do not localize}
183			if Old then
184			System.Delete(PName, 1, 4);
185			Field := FDataSet.FindField(PName);
186			if not Assigned(Field) then
187			Continue;
188			if Old then
189			Param.AssignFieldValue(Field, Field.OldValue) else
190			begin
191			Value := Field.NewValue;
192			if VarIsEmpty(Value) then
193			Value := Field.OldValue;
194			Param.AssignFieldValue(Field, Value);
195			end;
196			end;
197			end;
198			end;
199
200			procedure TIBUpdateSQL.Apply(UpdateKind: TUpdateKind);
201			begin
202			SetParams(UpdateKind);
203			ExecSQL(UpdateKind);
204			end;
205
206			end.