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;

{$Mode Delphi}

interface

uses SysUtils, Classes, DB, 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

uses Variants;

{ 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:	5
Committed:	Fri Feb 18 16:26:16 2011 UTC (13 years, 2 months ago) by tony
Content type:	text/x-pascal
File size:	6843 byte(s)
Log Message:	Committing updates for Release pre-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	tony	5	{$Mode Delphi}
32
33	tony	1	interface
34
35	tony	5	uses SysUtils, Classes, DB, IB, IBCustomDataSet, IBQuery;
36	tony	1
37			type
38			{ TIBUpdateSQL }
39
40			TIBUpdateSQL = class(TIBDataSetUpdateObject)
41			private
42			FDataSet: TIBCustomDataSet;
43			FQueries: array[TUpdateKind] of TIBQuery;
44			FSQLText: array[TUpdateKind] of TStrings;
45			function GetQuery(UpdateKind: TUpdateKind): TIBQuery;
46			function GetSQLIndex(Index: Integer): TStrings;
47			procedure SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
48			procedure SetSQLIndex(Index: Integer; Value: TStrings);
49			protected
50			function GetSQL(UpdateKind: TUpdateKind): TStrings; override;
51			function GetDataSet: TIBCustomDataSet; override;
52			procedure SetDataSet(ADataSet: TIBCustomDataSet); override;
53			procedure SQLChanged(Sender: TObject);
54			public
55			constructor Create(AOwner: TComponent); override;
56			destructor Destroy; override;
57			procedure Apply(UpdateKind: TUpdateKind); override;
58			procedure ExecSQL(UpdateKind: TUpdateKind);
59			procedure SetParams(UpdateKind: TUpdateKind);
60			property DataSet;
61			property Query[UpdateKind: TUpdateKind]: TIBQuery read GetQuery;
62			property SQL[UpdateKind: TUpdateKind]: TStrings read GetSQL write SetSQL;
63			published
64			property ModifySQL: TStrings index 0 read GetSQLIndex write SetSQLIndex;
65			property InsertSQL: TStrings index 1 read GetSQLIndex write SetSQLIndex;
66			property DeleteSQL: TStrings index 2 read GetSQLIndex write SetSQLIndex;
67			end;
68
69			implementation
70
71	tony	5	uses Variants;
72
73	tony	1	{ TIBUpdateSQL }
74
75			constructor TIBUpdateSQL.Create(AOwner: TComponent);
76			var
77			UpdateKind: TUpdateKind;
78			begin
79			inherited Create(AOwner);
80			for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
81			begin
82			FSQLText[UpdateKind] := TStringList.Create;
83			TStringList(FSQLText[UpdateKind]).OnChange := SQLChanged;
84			end;
85			end;
86
87			destructor TIBUpdateSQL.Destroy;
88			var
89			UpdateKind: TUpdateKind;
90			begin
91			if Assigned(FDataSet) and (FDataSet.UpdateObject = Self) then
92			FDataSet.UpdateObject := nil;
93			for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
94			FSQLText[UpdateKind].Free;
95			inherited Destroy;
96			end;
97
98			procedure TIBUpdateSQL.ExecSQL(UpdateKind: TUpdateKind);
99			begin
100			with Query[UpdateKind] do
101			begin
102			Prepare;
103			ExecSQL;
104			if RowsAffected <> 1 then IBError(ibxeUpdateFailed, [nil]);
105			end;
106			end;
107
108			function TIBUpdateSQL.GetQuery(UpdateKind: TUpdateKind): TIBQuery;
109			begin
110			if not Assigned(FQueries[UpdateKind]) then
111			begin
112			FQueries[UpdateKind] := TIBQuery.Create(Self);
113			FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
114			if (FDataSet is TIBCustomDataSet) then
115			begin
116			FQueries[UpdateKind].Database := TIBCustomDataSet(FDataSet).DataBase;
117			FQueries[UpdateKind].Transaction := TIBCustomDataSet(FDataSet).Transaction;
118			end;
119			end;
120			Result := FQueries[UpdateKind];
121			end;
122
123			function TIBUpdateSQL.GetSQL(UpdateKind: TUpdateKind): TStrings;
124			begin
125			Result := FSQLText[UpdateKind];
126			end;
127
128			function TIBUpdateSQL.GetSQLIndex(Index: Integer): TStrings;
129			begin
130			Result := FSQLText[TUpdateKind(Index)];
131			end;
132
133			function TIBUpdateSQL.GetDataSet: TIBCustomDataSet;
134			begin
135			Result := FDataSet;
136			end;
137
138			procedure TIBUpdateSQL.SetDataSet(ADataSet: TIBCustomDataSet);
139			begin
140			FDataSet := ADataSet;
141			end;
142
143			procedure TIBUpdateSQL.SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
144			begin
145			FSQLText[UpdateKind].Assign(Value);
146			end;
147
148			procedure TIBUpdateSQL.SetSQLIndex(Index: Integer; Value: TStrings);
149			begin
150			SetSQL(TUpdateKind(Index), Value);
151			end;
152
153			procedure TIBUpdateSQL.SQLChanged(Sender: TObject);
154			var
155			UpdateKind: TUpdateKind;
156			begin
157			for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
158			if Sender = FSQLText[UpdateKind] then
159			begin
160			if Assigned(FQueries[UpdateKind]) then
161			begin
162			FQueries[UpdateKind].Params.Clear;
163			FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
164			end;
165			Break;
166			end;
167			end;
168
169			procedure TIBUpdateSQL.SetParams(UpdateKind: TUpdateKind);
170			var
171			I: Integer;
172			Old: Boolean;
173			Param: TParam;
174			PName: string;
175			Field: TField;
176			Value: Variant;
177			begin
178			if not Assigned(FDataSet) then Exit;
179			with Query[UpdateKind] do
180			begin
181			for I := 0 to Params.Count - 1 do
182			begin
183			Param := Params[I];
184			PName := Param.Name;
185			Old := CompareText(Copy(PName, 1, 4), 'OLD_') = 0; {do not localize}
186			if Old then
187			System.Delete(PName, 1, 4);
188			Field := FDataSet.FindField(PName);
189			if not Assigned(Field) then
190			Continue;
191			if Old then
192			Param.AssignFieldValue(Field, Field.OldValue) else
193			begin
194			Value := Field.NewValue;
195			if VarIsEmpty(Value) then
196			Value := Field.OldValue;
197			Param.AssignFieldValue(Field, Value);
198			end;
199			end;
200			end;
201			end;
202
203			procedure TIBUpdateSQL.Apply(UpdateKind: TUpdateKind);
204			begin
205			SetParams(UpdateKind);
206			ExecSQL(UpdateKind);
207			end;
208
209			end.