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                                       }
{                                                                        }
{    IBX For Lazarus (Firebird Express)                                  }
{    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
{    Portions created by MWA Software are copyright McCallum Whyman      }
{    Associates Ltd 2011 - 2018                                               }
{                                                                        }
{************************************************************************}

unit IBUpdateSQL;

{$Mode Delphi}

interface

uses SysUtils, Classes, DB, IB, IBCustomDataSet, IBSQL;

type
{ TIBUpdateSQL }

  TIBUpdateSQL = class(TIBDataSetUpdateObject)
  private
    FDataSet: TIBCustomDataSet;
    FQueries: array[TUpdateKind] of TIBSQL;
    FSQLText: array[TUpdateKind] of TStrings;
    function GetQuery(UpdateKind: TUpdateKind): TIBSQL;
    function GetSQLIndex(Index: Integer): TStrings;
    procedure SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
    procedure SetSQLIndex(Index: Integer; Value: TStrings);
  protected
    procedure InternalPrepare(UpdateKind: TUpdateKind);
    function GetSQL(UpdateKind: TUpdateKind): TStrings; override;
    function GetDataSet: TIBCustomDataSet; override;
    procedure SetDataSet(ADataSet: TIBCustomDataSet); override;
    procedure SQLChanged(Sender: TObject);
    procedure Apply(UpdateKind: TUpdateKind; buff: PChar); override;
    procedure ExecSQL(UpdateKind: TUpdateKind; buff: PChar);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property DataSet;
    property Query[UpdateKind: TUpdateKind]: TIBSQL 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; buff: PChar);
begin
  InternalPrepare(UpdateKind);
  with Query[UpdateKind] do
  begin
    ExecQuery;
//    if RowsAffected <> 1 then IBError(ibxeUpdateFailed, [nil]);
// Commented out in release 1.2
    if FieldCount > 0 then  {Has RETURNING Clause}
      UpdateRecordFromQuery(UpdateKind,Current,Buff);
  end;
end;

function TIBUpdateSQL.GetQuery(UpdateKind: TUpdateKind): TIBSQL;
begin
  if not Assigned(FQueries[UpdateKind]) then
  begin
    FQueries[UpdateKind] := TIBSQL.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.InternalPrepare(UpdateKind: TUpdateKind);
begin
  with Query[UpdateKind] do
  begin
    with Transaction do
      if not InTransaction then StartTransaction;
    if not Prepared then Prepare;
  end;
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
        FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
      Break;
    end;
end;

procedure TIBUpdateSQL.Apply(UpdateKind: TUpdateKind; buff: PChar);
begin
  if not Assigned(FDataSet) then Exit;
  InternalPrepare(UpdateKind);
  InternalSetParams(Query[UpdateKind].Params,buff);
  ExecSQL(UpdateKind,buff);
end;

end.
Revision:	143
Committed:	Fri Feb 23 12:11:21 2018 UTC (6 years, 9 months ago) by tony
Content type:	text/x-pascal
File size:	6855 byte(s)
Log Message:	Fixes Merged
#	User	Rev	Content
1	tony	33	{************************************************************************}
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			{ IBX For Lazarus (Firebird Express) }
28			{ Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29			{ Portions created by MWA Software are copyright McCallum Whyman }
30	tony	143	{ Associates Ltd 2011 - 2018 }
31	tony	33	{ }
32			{************************************************************************}
33
34			unit IBUpdateSQL;
35
36			{$Mode Delphi}
37
38			interface
39
40			uses SysUtils, Classes, DB, IB, IBCustomDataSet, IBSQL;
41
42			type
43			{ TIBUpdateSQL }
44
45			TIBUpdateSQL = class(TIBDataSetUpdateObject)
46			private
47			FDataSet: TIBCustomDataSet;
48			FQueries: array[TUpdateKind] of TIBSQL;
49			FSQLText: array[TUpdateKind] of TStrings;
50			function GetQuery(UpdateKind: TUpdateKind): TIBSQL;
51			function GetSQLIndex(Index: Integer): TStrings;
52			procedure SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
53			procedure SetSQLIndex(Index: Integer; Value: TStrings);
54			protected
55			procedure InternalPrepare(UpdateKind: TUpdateKind);
56			function GetSQL(UpdateKind: TUpdateKind): TStrings; override;
57			function GetDataSet: TIBCustomDataSet; override;
58			procedure SetDataSet(ADataSet: TIBCustomDataSet); override;
59			procedure SQLChanged(Sender: TObject);
60			procedure Apply(UpdateKind: TUpdateKind; buff: PChar); override;
61	tony	101	procedure ExecSQL(UpdateKind: TUpdateKind; buff: PChar);
62	tony	33	public
63			constructor Create(AOwner: TComponent); override;
64			destructor Destroy; override;
65			property DataSet;
66			property Query[UpdateKind: TUpdateKind]: TIBSQL read GetQuery;
67			property SQL[UpdateKind: TUpdateKind]: TStrings read GetSQL write SetSQL;
68			published
69			property ModifySQL: TStrings index 0 read GetSQLIndex write SetSQLIndex;
70			property InsertSQL: TStrings index 1 read GetSQLIndex write SetSQLIndex;
71			property DeleteSQL: TStrings index 2 read GetSQLIndex write SetSQLIndex;
72			end;
73
74			implementation
75
76			uses Variants;
77
78			{ TIBUpdateSQL }
79
80			constructor TIBUpdateSQL.Create(AOwner: TComponent);
81			var
82			UpdateKind: TUpdateKind;
83			begin
84			inherited Create(AOwner);
85			for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
86			begin
87			FSQLText[UpdateKind] := TStringList.Create;
88			TStringList(FSQLText[UpdateKind]).OnChange := SQLChanged;
89			end;
90			end;
91
92			destructor TIBUpdateSQL.Destroy;
93			var
94			UpdateKind: TUpdateKind;
95			begin
96			if Assigned(FDataSet) and (FDataSet.UpdateObject = Self) then
97			FDataSet.UpdateObject := nil;
98			for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
99			FSQLText[UpdateKind].Free;
100			inherited Destroy;
101			end;
102
103	tony	101	procedure TIBUpdateSQL.ExecSQL(UpdateKind: TUpdateKind; buff: PChar);
104	tony	33	begin
105			InternalPrepare(UpdateKind);
106			with Query[UpdateKind] do
107			begin
108			ExecQuery;
109			// if RowsAffected <> 1 then IBError(ibxeUpdateFailed, [nil]);
110			// Commented out in release 1.2
111	tony	101	if FieldCount > 0 then {Has RETURNING Clause}
112	tony	118	UpdateRecordFromQuery(UpdateKind,Current,Buff);
113	tony	33	end;
114			end;
115
116			function TIBUpdateSQL.GetQuery(UpdateKind: TUpdateKind): TIBSQL;
117			begin
118			if not Assigned(FQueries[UpdateKind]) then
119			begin
120			FQueries[UpdateKind] := TIBSQL.Create(Self);
121			FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
122			if (FDataSet is TIBCustomDataSet) then
123			begin
124			FQueries[UpdateKind].Database := TIBCustomDataSet(FDataSet).DataBase;
125			FQueries[UpdateKind].Transaction := TIBCustomDataSet(FDataSet).Transaction;
126			end;
127			end;
128			Result := FQueries[UpdateKind];
129			end;
130
131			function TIBUpdateSQL.GetSQL(UpdateKind: TUpdateKind): TStrings;
132			begin
133			Result := FSQLText[UpdateKind];
134			end;
135
136			function TIBUpdateSQL.GetSQLIndex(Index: Integer): TStrings;
137			begin
138			Result := FSQLText[TUpdateKind(Index)];
139			end;
140
141			function TIBUpdateSQL.GetDataSet: TIBCustomDataSet;
142			begin
143			Result := FDataSet;
144			end;
145
146			procedure TIBUpdateSQL.SetDataSet(ADataSet: TIBCustomDataSet);
147			begin
148			FDataSet := ADataSet;
149			end;
150
151			procedure TIBUpdateSQL.SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
152			begin
153			FSQLText[UpdateKind].Assign(Value);
154			end;
155
156			procedure TIBUpdateSQL.SetSQLIndex(Index: Integer; Value: TStrings);
157			begin
158			SetSQL(TUpdateKind(Index), Value);
159			end;
160
161			procedure TIBUpdateSQL.InternalPrepare(UpdateKind: TUpdateKind);
162			begin
163			with Query[UpdateKind] do
164			begin
165			with Transaction do
166			if not InTransaction then StartTransaction;
167			if not Prepared then Prepare;
168			end;
169			end;
170
171			procedure TIBUpdateSQL.SQLChanged(Sender: TObject);
172			var
173			UpdateKind: TUpdateKind;
174			begin
175			for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
176			if Sender = FSQLText[UpdateKind] then
177			begin
178			if Assigned(FQueries[UpdateKind]) then
179			FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
180			Break;
181			end;
182			end;
183
184			procedure TIBUpdateSQL.Apply(UpdateKind: TUpdateKind; buff: PChar);
185			begin
186			if not Assigned(FDataSet) then Exit;
187			InternalPrepare(UpdateKind);
188	tony	80	InternalSetParams(Query[UpdateKind].Params,buff);
189	tony	101	ExecSQL(UpdateKind,buff);
190	tony	33	end;
191
192	tony	80	end.