Mengoptimalkan kemampuan VCL IBX (Interbase Express)

Seperti diketahui bersama banyak sekali vcl untuk koneksi data Interbase menggunakan Delphi, salah satunya dan yang kaya fitur adalah FIBPlus, sayangnya FIBplus ini berbayar.

Pada kesempatan kali ini kita akan mencoba mengoptimalkan VCL IBX (IBExpress) dengan pertimbangan IBX ini adalah VCL bawaan Delphi.

Kita akan mencoba memasukkan beberapa fitur yang ada di FIBPlus kedalam IBX.

Beberapa fitur yang akan kita tambahkan diantaranya :

  • Auto Commit .. Commit otomatis setelah Post
  • Simple Query .. Query sederhana tanpa komponen
  • GetServerTime .. Membaca jam pada server
  • Gen_ID  .. Mengambil nilai generator (Auto Number)
  • Default Value .. Nilai default akan terisi otomatis
  • Numeric Format .. Field Numeric akan ditampilkan berformat
  • Show Memo Text .. Text asli akan ditampilkan di Field Memo
  • Konfirmasi penghapusan (pada Actionlist)

Langsung saja ini source kodenya ..

unit IBXPlus;
(*
  Advanced IBExpress by Imam Chalimi
  First Release November 11, 2012
  Last Update November 24, 2012

  Feature :
  - Delete Confirmation (ActionList)
  - Simple Query
  - Gen_ID
  - GetServerTime
  - AutoCommit
  - AutoFill Default Value
  - AutoFormat Numeric Field
  - Show Memo Text
*)

interface

uses Windows, IBCustomDataSet, IBDataBase, DB, SysUtils,
     Classes, Variants, DBActns, Forms, VsrWindows;

type
  TDataSetDelete = class(DBActns.TDataSetDelete)
  public
    procedure ExecuteTarget(Target: TObject); override;
  end;
  TIBDataBase = class(IBDataBase.TIBDataBase)
  public
    function QueryValue(sSQL:string;sParam:array of Variant):Variant;
    function QueryValues(sSQL:string;sParam:array of Variant):Variant;
    function Gen_ID(sGenID:string;iStep:Int64):Int64;
    function Execute(sSQL:string;sParam:array of Variant):Boolean;
    function GetServerTime:TDateTime;
  end;
  TIBDataSet = class(IBCustomDataSet.TIBDataSet)
  private
    procedure InternalCommit;
  public
    procedure AutoGenerateSQLs;
  published
    procedure DoAfterPost; override;
    procedure DoOnNewRecord; override;
    procedure DoAfterDelete; override;
    procedure DoAfterOpen; override;
  end;
  TIBBCDField = class(IBCustomDataSet.TIBBCDField)
  public
    constructor Create(AOwner: TComponent); override;
  end;
  TMemoField = class(DB.TMemoField)
    procedure GetText(var Text: string;
              DisplayText: Boolean); override;
  end;

{Global Variable}
var
   IBX_AutoComit,
   IBX_ShowID,
   IBX_ShowBlob,
   IBX_DefaultValue: Boolean;

implementation

{ TIBDataSet }

procedure TIBDataSet.AutoGenerateSQLs;
begin
(*
  == Menyusul ... ==
*)
//     InsertSQL.Text:='';
//     DeleteSQL.Text:='';
//     ModifySQL.Text:='';
//     RefreshSQL.Text:='';
end;

procedure TIBDataSet.DoAfterDelete;
begin
  inherited;
  InternalCommit;
end;

procedure TIBDataSet.DoAfterOpen;
var
   i: Integer;
begin
  inherited;
  for i:=0 to Fields.Count-1 do
  with Fields[i] do
  case DataType of
       ftInteger: if ((FieldName='ID') or
                     (Copy(FieldName,Length(FieldName)-3,3)='_ID')) then
                  begin
                       DisplayWidth:=5;
                       if FieldName='ID' then
                          ReadOnly:=True;
                       Visible:=IBX_ShowID;
                  end;
       ftBlob: Visible:=IBX_ShowBlob;
       ftDate: EditMask:='99/99/9999';
  end;
end;

procedure TIBDataSet.DoAfterPost;
begin
  inherited;
  InternalCommit;
end;

procedure TIBDataSet.DoOnNewRecord;
var
   i: Integer;
   s: string;
begin
  if IBX_DefaultValue then
  for i:=0 to FieldCount-1 do
  begin
       s:='SELECT F.RDB$DEFAULT_SOURCE ' +
          'FROM RDB$RELATION_FIELDS F ' +
          'WHERE F.RDB$RELATION_NAME=:X ' +
          'AND F.RDB$FIELD_NAME=:Y ' +
          'AND F.RDB$DEFAULT_SOURCE STARTING WITH ''DEFAULT''';
          s:=TIBDataBase(Database).
             QueryValue(s,[PSGetTableName,Fields[i].FieldName]);
          System.Delete(s,1,8);
          s:='SELECT '+Trim(s)+' FROM RDB$DATABASE';
          try
             Fields[i].Value:=TIBDataBase(Database).QueryValue(s,[]);
          except
          end;
  end;
  inherited;
end;

procedure TIBDataSet.InternalCommit;
begin
  if IBX_AutoComit and
     (Tag<>999) then
     Transaction.CommitRetaining;
end;

{ TIBBCDField }

constructor TIBBCDField.Create(AOwner: TComponent);
begin
  inherited;
  DisplayFormat:='#,##0.00';
end;

{ TIBDataBase }

function TIBDataBase.Execute(sSQL: string; sParam: array of Variant): Boolean;
var
   i: Integer;
begin
     with TIBDataSet.Create(nil) do
     begin
          Database:=Self;
          SelectSQL.Text:=sSQL;
          Prepare;
          if Length(sParam)>0 then
          begin
               for i:=0 to Length(sParam)-1 do
                   Params[i].Value:=sParam[i];
               Prepare;
          end;
          ExecSQL;
          InternalCommit;
          Free;
     end;
end;

function TIBDataBase.Gen_ID(sGenID: string; iStep: Int64): Int64;
begin
     with TIBDataSet.Create(nil) do
     begin
          Database:=Self;
          SelectSQL.Text:=Format('SELECT GEN_ID(%s,%d) ' +
                                 'FROM RDB$DATABASE',[sGenID,iStep]);
          Open;
          Result:=Fields[0].AsInteger;
          Close;
          Free;
     end;
end;

function TIBDataBase.QueryValue(sSQL: string;sParam:array of Variant): Variant;
var
   i: Integer;
begin
     with TIBDataSet.Create(nil) do
     begin
          Database:=Self;
          SelectSQL.Text:=sSQL;
          if Length(sParam)>0 then
          begin
               for i:=0 to Length(sParam)-1 do
                   Params[i].Value:=sParam[i];
               Prepare;
          end;
          Open;
          Result:=Fields[0].Value;
          Close;
          Free;
     end;
end;

function TIBDataBase.QueryValues(sSQL: string;
  sParam: array of Variant): Variant;
var
   i: Integer;
begin
     with TIBDataSet.Create(nil) do
     begin
          Database:=Self;
          SelectSQL.Text:=sSQL;
          if Length(sParam)>0 then
          begin
               for i:=0 to Length(sParam)-1 do
                   Params[i].Value:=sParam[i];
               Prepare;
          end;
          Open;
          Result:=VarArrayCreate([0,FieldCount-1],varVariant);
          for i:=0 to Fields.Count-1 do
              Result[i]:=Fields[i].Value;
          Close;
          Free;
     end;
end;

function TIBDataBase.GetServerTime: TDateTime;
begin
     with TIBDataSet.Create(nil) do
     begin
          Database:=Self;
          SelectSQL.Text:='SELECT CURRENT_TIMESTAMP ' +
                          'FROM RDB$DATABASE';
          Open;
          Result:=Fields[0].AsDateTime;
          Close;
          Free;
     end;
end;

{ TDataSetDelete }

procedure TDataSetDelete.ExecuteTarget(Target: TObject);
begin
     if MessageBox(Application.Handle,'Yakin Dihapus ?','Konfirmasi',MB_YESNO)=IDYES then
        inherited;
end;

{ TMemoField }

procedure TMemoField.GetText(var Text: string; DisplayText: Boolean);
begin
  Text:=GetAsString;
end;

initialization
  IBX_AutoComit:=True;
  IBX_ShowID:=False;
  IBX_ShowBlob:=False;
  IBX_DefaultValue:=False;

end.

Untuk menggunakan unit ini cukup mudah, tambahkan IBXPlus pada klausa uses.

Yang perlu diperhatikan penulisan IBXPlus pada klausa uses harus diletakkan paling belakang atau setelah unit uses IBxxxx.

contoh:

Windows, Messages, SysUtils, Variants, Classes, Graphics, 
Controls, Forms, Dialogs, ExtCtrls, DBCtrls, Grids, DBGrids, 
DB, IBCustomDataSet, IBDatabase, IBXPlus;

Unit yang sudah siap pakai (khusus delphi 7 dan Delphi 2006/Turbo Delphi) dapat di download di:

Semoga bermanfaat

No Comments

Leave a Reply

Your email address will not be published. Required fields are marked *

-