uses
Classes, SysUtils, DB, Forms, Controls, Graphics, Dialogs, DBCtrls, StdCtrls,
DBGrids, IBDatabase, IBCustomDataSet, IBSQL;
function GetScriptUI (TableName : String; Dt : TIBDataSet) : string;
function GetScriptDel (TableName : String; Dt : TIBDataSet; PkField:String) : string;
type
{ TForm1 }
TForm1 = class(TForm)
btnSave: TButton;
DbaOpr: TIBDatabase;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
DtCD: TIBStringField;
DtDS: TDataSource;
Dba: TIBDatabase;
Dt: TIBDataSet;
DtGRP: TIBStringField;
DtID: TIBIntegerField;
IBSQL: TIBSQL;
Trs: TIBTransaction;
TrsOpr: TIBTransaction;
procedure btnSaveClick(Sender: TObject);
procedure DtBeforeDelete(DataSet: TDataSet);
procedure DtBeforePost(DataSet: TDataSet);
procedure FormCreate(Sender: TObject);
function OpenDt() : boolean;
function OpenConn() : boolean;
private
public
end;
var
Form1: TForm1;
SQLScripts : TStringList;
function GetScriptDel (TableName : String; Dt : TIBDataSet;PkField:String) : string;
var
Header : string;
FieldList : TStringList;
y : integer;
begin
FieldList := TStringList.Create();
Dt.GetFieldNames(FieldList);
Header := 'delete from ' + TableName + ' where ' + PkField + '=';
y := 0;
while y < FieldList.Count do
begin
if FieldList.Strings[y] = PkField then
Header := Header + Dt.FieldByName(FieldList.Strings[y]).AsString;
y := y+1;
end;
Result := Header + ';';
end;
function GetScriptUI (TableName : String; Dt : TIBDataSet) : string;
var
Header, Body, Comma, Temp : string;
FieldList : TStringList;
y : integer;
begin
FieldList := TStringList.Create();
Dt.GetFieldNames(FieldList);
Header := 'update or Insert Into ' + TableName + ' (';
Comma := ',';
y := 0;
while y < FieldList.Count do
begin
if y = FieldList.Count - 1 then Comma := '';
Header := Header + FieldList.Strings[y] + Comma;
y := y+1;
end;
Header := Header + ') Values (';
Comma := ',';
Body := '';
y := 0;
while y < FieldList.Count do
begin
if (y = FieldList.Count - 1) then Comma := '';
if not (Dt.FieldByName(FieldList.Strings[y]).IsNull) then
begin
case Dt.Fields.Fields[y].DataType of
ftDateTime : Temp := '%''' + Format('mm/dd/yy hh:nn:ss',[Dt.FieldByName(FieldList.Strings[y]).AsDateTime]) + '%''';
ftDate : Temp := '%''' + Format('mm/dd/yy',[Dt.FieldByName(FieldList.Strings[y]).AsDateTime]) + '%''';
ftMemo : Temp := '%''' + Dt.FieldByName(FieldList.Strings[y]).AsString + '%''';
otherwise
begin
Temp := Dt.FieldByName(FieldList.Strings[y]).AsString;
Temp := Temp.Replace('''','''''');
Temp := '''' + Temp + '''';
end
end;
Body := Body + Temp + Comma;
end
else Body := Body + 'Null' + Comma;
y := y+1;
end;
FieldList.Free;
Result := Header + Body + ');';
end;
function TForm1.OpenConn() : boolean;
var
OpenOk : boolean;
begin
try
DbaOpr.Close(true);
DbaOpr.Open;
TrsOpr.Active:= true;
OpenOk := true;
except on E: EDatabaseError do OpenOk := false;
end;
Result := OpenOk;
end;
function TForm1.OpenDt() : boolean;
var
OpenOk : boolean;
begin
try
Dba.Close(true);
Dba.Open;
Trs.Active:= true;
Dt.Open;
OpenOk := true;
except on E: EDatabaseError do OpenOk := false;
end;
Result := OpenOk;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
OpenDt();
Memo.Clear;
SQLScripts:= TStringList.Create;
end;
procedure TForm1.DtBeforePost(DataSet: TDataSet);
var
SQL : string;
begin
SQL := GetScriptUI('M_GRP',Dt);
Memo.Lines.Add(SQL);
Memo.Lines.Add(#13);
SQLScripts.Add(SQL);
end;
procedure TForm1.DtBeforeDelete(DataSet: TDataSet);
var
SQL : string;
begin
SQL := GetScriptDel('M_GRP',Dt,'ID');
Memo.Lines.Add(SQL);
Memo.Lines.Add(#13);
SQLScripts.Add(SQL);
end;
procedure TForm1.btnSaveClick(Sender: TObject);
var
y : integer;
begin
if OpenConn then
begin
try
if not TrsOpr.Active then TrsOpr.Active := true;
y:=0;
while y < SQLScripts.Count do
begin
IBSQL.SQL.Clear;
IBSQL.SQL.Add(SQLScripts.Strings[y]);
IBSQL.execquery;
y := y+1;
end;
TrsOpr.Commit;
DbaOpr.Close(true);
OpenDt;
SQLScripts.Clear;
MessageDlg('Info', 'Data saved.', mtInformation, [mbOK], 0);
except
on E: EDatabaseError do
begin
TrsOpr.Rollback;
MessageDlg('Error', 'Connection Problem. Please check your network connection and then try again', mtError, [mbOK], 0);
end;
end;
end
else MessageDlg('Error', 'Connection Problem. Please check your network connection and then try again', mtError, [mbOK], 0)
end;