Forum > Databases

[Firebird + IBX] Method to handling database operation on an unstable network

(1/1)

incendio:
Hi guys,

This post is a follow up from this post :
https://forum.lazarus.freepascal.org/index.php/topic,57290.0.html

During running an app, if Firebird Server is restart or there is an unstable network connection, app using LCL components for Firebird will throw an error.

This error will still raised even Firebird Server / network connection restored again.

To get rid of this error, app must be restart again, this could lead to a data lost due to unable to save changes to Firebird server.

I don't want that thing happen, so in this post, want to share the basic method to handle this problem.

Here are the ideas :

* Use CachedUpdated for allDataSets
* Pull sql statements from all Datasets (update/insert/delete)
* Use two Databases, let says DbaA & DbaB. DbaA for holds transaction & datasets that will be used in data aware component. DbaB, only holds transaction and TIBSQL component.
* When users finished data entry and want to save data, run sql statement via TIBSQL in DbaB
Requirement :

* All table in Firebird must have Primary Key
* Primary Key can't be composite field
Here are the sample codes :

--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---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;  
Those are a basic operation. You can modify it to suit your need.

Navigation

[0] Message Index

Go to full version