Recent

Author Topic: [Firebird + IBX] Method to handling database operation on an unstable network  (Read 1664 times)

incendio

  • Full Member
  • ***
  • Posts: 126
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  [Select][+][-]
  1. uses
  2.   Classes, SysUtils, DB, Forms, Controls, Graphics, Dialogs, DBCtrls, StdCtrls,
  3.   DBGrids, IBDatabase, IBCustomDataSet, IBSQL;
  4.   function GetScriptUI (TableName : String; Dt : TIBDataSet) : string;
  5.   function GetScriptDel (TableName : String; Dt : TIBDataSet; PkField:String) : string;
  6.  
  7. type
  8.  
  9.   { TForm1 }
  10.  
  11.   TForm1 = class(TForm)
  12.     btnSave: TButton;
  13.     DbaOpr: TIBDatabase;
  14.     DBGrid1: TDBGrid;
  15.     DBNavigator1: TDBNavigator;
  16.     DtCD: TIBStringField;
  17.     DtDS: TDataSource;
  18.     Dba: TIBDatabase;
  19.     Dt: TIBDataSet;
  20.     DtGRP: TIBStringField;
  21.     DtID: TIBIntegerField;
  22.     IBSQL: TIBSQL;
  23.     Trs: TIBTransaction;
  24.     TrsOpr: TIBTransaction;
  25.     procedure btnSaveClick(Sender: TObject);
  26.     procedure DtBeforeDelete(DataSet: TDataSet);
  27.     procedure DtBeforePost(DataSet: TDataSet);
  28.     procedure FormCreate(Sender: TObject);
  29.     function OpenDt() : boolean;
  30.     function OpenConn() : boolean;
  31.  
  32.   private
  33.   public
  34.   end;
  35.  
  36. var
  37.   Form1: TForm1;
  38.   SQLScripts : TStringList;
  39.  
  40. function GetScriptDel (TableName : String; Dt : TIBDataSet;PkField:String) : string;
  41. var
  42.   Header : string;
  43.   FieldList : TStringList;
  44.   y : integer;
  45. begin
  46.   FieldList := TStringList.Create();
  47.   Dt.GetFieldNames(FieldList);
  48.  
  49.   Header := 'delete from ' + TableName + ' where ' + PkField + '=';
  50.   y := 0;
  51.   while y < FieldList.Count do
  52.   begin
  53.     if FieldList.Strings[y] = PkField then
  54.       Header := Header + Dt.FieldByName(FieldList.Strings[y]).AsString;
  55.  
  56.     y := y+1;
  57.   end;
  58.  
  59.   Result := Header + ';';
  60. end;
  61.  
  62. function GetScriptUI (TableName : String; Dt : TIBDataSet) : string;
  63. var
  64.   Header, Body, Comma, Temp : string;
  65.   FieldList : TStringList;
  66.   y : integer;
  67. begin
  68.   FieldList := TStringList.Create();
  69.   Dt.GetFieldNames(FieldList);
  70.  
  71.   Header := 'update or Insert Into ' + TableName + ' (';
  72.   Comma  := ',';
  73.   y := 0;
  74.  
  75.   while y < FieldList.Count do
  76.   begin
  77.     if y = FieldList.Count - 1 then Comma := '';
  78.     Header := Header + FieldList.Strings[y] + Comma;
  79.  
  80.     y := y+1;
  81.   end;
  82.  
  83.   Header := Header + ') Values (';
  84.  
  85.   Comma  := ',';
  86.   Body   := '';
  87.  
  88.   y := 0;
  89.   while y < FieldList.Count do
  90.   begin
  91.     if (y = FieldList.Count - 1) then Comma := '';
  92.  
  93.     if not (Dt.FieldByName(FieldList.Strings[y]).IsNull) then
  94.     begin
  95.       case Dt.Fields.Fields[y].DataType of
  96.         ftDateTime : Temp := '%''' + Format('mm/dd/yy hh:nn:ss',[Dt.FieldByName(FieldList.Strings[y]).AsDateTime]) + '%''';
  97.         ftDate : Temp := '%''' + Format('mm/dd/yy',[Dt.FieldByName(FieldList.Strings[y]).AsDateTime]) + '%''';
  98.         ftMemo : Temp := '%''' + Dt.FieldByName(FieldList.Strings[y]).AsString + '%''';
  99.         otherwise
  100.         begin
  101.           Temp := Dt.FieldByName(FieldList.Strings[y]).AsString;
  102.           Temp := Temp.Replace('''','''''');
  103.           Temp := '''' + Temp + '''';
  104.         end
  105.       end;
  106.       Body := Body + Temp + Comma;
  107.  
  108.     end
  109.     else Body := Body + 'Null' + Comma;
  110.     y := y+1;
  111.   end;
  112.  
  113.   FieldList.Free;
  114.   Result := Header + Body + ');';
  115. end;
  116.  
  117. function TForm1.OpenConn() : boolean;
  118. var
  119.   OpenOk : boolean;
  120.  
  121. begin
  122.   try
  123.     DbaOpr.Close(true);
  124.     DbaOpr.Open;
  125.     TrsOpr.Active:= true;
  126.     OpenOk := true;
  127.   except on E: EDatabaseError do OpenOk := false;
  128.   end;
  129.   Result := OpenOk;
  130. end;
  131.  
  132. function TForm1.OpenDt() : boolean;
  133. var
  134.   OpenOk : boolean;
  135.  
  136. begin
  137.   try
  138.     Dba.Close(true);
  139.     Dba.Open;
  140.     Trs.Active:= true;
  141.     Dt.Open;
  142.     OpenOk := true;
  143.   except on E: EDatabaseError do OpenOk := false;
  144.   end;
  145.   Result := OpenOk;
  146. end;
  147.  
  148. procedure TForm1.FormCreate(Sender: TObject);
  149. begin
  150.   OpenDt();
  151.   Memo.Clear;
  152.   SQLScripts:= TStringList.Create;
  153. end;
  154.  
  155. procedure TForm1.DtBeforePost(DataSet: TDataSet);
  156. var
  157.   SQL : string;
  158.  
  159. begin
  160.   SQL := GetScriptUI('M_GRP',Dt);
  161.   Memo.Lines.Add(SQL);
  162.   Memo.Lines.Add(#13);
  163.   SQLScripts.Add(SQL);
  164. end;
  165.  
  166. procedure TForm1.DtBeforeDelete(DataSet: TDataSet);
  167. var
  168.   SQL : string;
  169.  
  170. begin
  171.   SQL := GetScriptDel('M_GRP',Dt,'ID');
  172.   Memo.Lines.Add(SQL);
  173.   Memo.Lines.Add(#13);
  174.   SQLScripts.Add(SQL);
  175. end;
  176.  
  177. procedure TForm1.btnSaveClick(Sender: TObject);
  178. var
  179.   y : integer;
  180.  
  181. begin
  182.   if OpenConn then
  183.   begin
  184.     try
  185.       if not TrsOpr.Active then TrsOpr.Active := true;
  186.       y:=0;
  187.       while y < SQLScripts.Count do
  188.       begin
  189.         IBSQL.SQL.Clear;
  190.         IBSQL.SQL.Add(SQLScripts.Strings[y]);
  191.         IBSQL.execquery;
  192.         y := y+1;
  193.       end;
  194.       TrsOpr.Commit;
  195.       DbaOpr.Close(true);
  196.       OpenDt;
  197.       SQLScripts.Clear;
  198.       MessageDlg('Info', 'Data saved.', mtInformation, [mbOK], 0);
  199.     except
  200.     on E: EDatabaseError do
  201.       begin
  202.         TrsOpr.Rollback;
  203.         MessageDlg('Error', 'Connection Problem. Please check your network connection and then try again', mtError, [mbOK], 0);
  204.       end;
  205.     end;
  206.   end
  207.   else MessageDlg('Error', 'Connection Problem. Please check your network connection and then try again', mtError, [mbOK], 0)
  208. end;
  209.  
  210.  

Those are a basic operation. You can modify it to suit your need.

 

TinyPortal © 2005-2018