Unified Interbaseコンポーネントをつかってみた（その4）

Unified Interbaseコンポーネントをつかってみた（その3）で、ClientDataSet接続用に
TUIBDataSetをカスタマイズした。このカスタマイズしたコンポーネントを使って
TClientDataSet及びTDataSetProviderを使ってのデータ更新を試してみた。

以下、その備忘録

DBExpressドライバを使えば、フラットなテーブルや簡単なリンクテーブルであれば
自動的にデータ操作のSQLを作ってDBに書き込んでくれる。

しかし、複雑なJoin等でデータを表示する場合はDbExpressドライバを使っても
テーブルへの操作は自前で実施する必要がある。

また、FlameRobin、黒猫 SQL Studio、A5:SQL Mk-2のツールでデータ更新用の
SQLである程度自動で作成できるので 自前で実施してもそんなに手間ではないので
データの更新を手動で行う。

DataSetProviderで、データの更新を自分で実施する方法は、エンバカデロさんのヘルプ
に手順が書いてあるのでこれに従って更新処理を書いた。

その実装は、以下のとおり

フォームのUIBTransactionコンポーネントを配置し、UIBDatabaseコンポーネントを
接続する。また今回はテストなので、暗黙のトランザクションになるようの
コンポーネントを設定した。（下図）

UIBQueryコンポーネントを配置し上記のUIBTransactionオブジェクトに接続する。

DataSetProviderのUpdateModeを実際の処理に合わせて設定する。
（今回は、"upWhereChanged"に設定)

DataSetProviderのBeforeUpdateRecordイベントハンドラにDB更新の処理を
記述する。このとき、更新処理が終わったら、

Applied := true

とし、ClientDataSetのキャッシュの更新終了状態にする。

今回のテストで書いた処理は下のとおり、

view plainprint?

1. procedure TForm1.DataSetProvider1BeforeUpdateRecord(Sender: TObject;  
2.   SourceDS: TDataSet; DeltaDS: TCustomClientDataSet; UpdateKind: TUpdateKind;  
3.   var Applied: Boolean);  
4. var  
5.     i : Integer;  
6.   SQL : String;  
7.   ValueStr : String;  
8.   NewStr : String;  
9.   OldStr : String;  
10.   //UIBDeltaDs : TUIBClientDataSet;  
11. begin  
12.   
13.   //UIBDeltaDs := TUIBClientDataSet.Create(Self);  
14.   //UIBDeltaDs := DeltaDS.CloneCursor();  
15.   
16.   UIBQuery1.SQL.Clear;  
17.   
18.   UIBQuery1.SQL.Add('UPDATE EMPLOYEE SET ' + #13#10);  
19.   
20.   while not(DeltaDS.eof) do  
21.   begin  
22.       //DeltaDS  
23.      SQL := '';  
24.      for i := 0 to DeltaDS.FieldCount - 1 do  
25.      begin  
26.        //UIBDeltaDs.DataConvert(  
27.        if not(VarIsEmpty(DeltaDS.Fields[i].NewValue)) then  
28.        begin  
29.           //UIBQuery1.SQL.Add  
30.           NewStr := VarToStr(DeltaDS.Fields[i].NewValue);  
31.           OldStr := IfThen(not(VarIsNull(DeltaDs.Fields[i].OldValue)), VarToStr(DeltaDS.Fields[i].OldValue));  
32.   
33.           if CompareText(NewStr,OldStr) <> 0 Then  
34.           begin  
35.              if (DeltaDs.Fields[i].DataType = ftDatetime) then  
36.              begin  
37.                 ValueStr := FormatDateTime(  
38.                                  'yyyy/mm/dd hh:nn:ss',  
39.                                  VarToDateTime(DeltaDs.Fields[i].NewValue)  
40.                             );  
41.                    ValueStr := QuotedStr(ValueStr);  
42.              end  
43.              else  
44.              begin  
45.                        ValueStr := VarToStr(DeltaDS.Fields[i].NewValue);  
46.                      if   (DeltaDs.Fields[i].DataType = ftString)  
47.                        Or (DeltaDs.Fields[i].DataType = ftWideString)  
48.                      then  
49.                      begin  
50.                         ValueStr := QuotedStr(ValueStr);  
51.                      end  
52.                 end;  
53.             end;  
54.   
55.              SQL := SQL + ', ' + DeltaDS.Fields[i].FieldName + ' = ' + ValueStr + #13#10;  
56.                  ListBox1.Items.Add(DeltaDS.Fields[i].FieldName);  
57.                  ListBox1.Items.Add(NewStr);  
58.                  ListBox1.Items.Add(OldStr);  
59.           end;  
60.        end;  
61.   
62.      if Length(Trim(SQL)) > 0 then  
63.      begin  
64.        Sql := RightStr(Sql,Length(Sql)-1);  
65.      end;  
66.   
67.      UIBQuery1.SQL.Add(SQL);  
68.   
69.      UIBQuery1.SQL.Add('WHERE EMP_NO = ' + VarToStr(DeltaDS.FieldByName('EMP_NO').OldValue));  
70.   
71.      Memo1.Lines.Assign(UIBQuery1.SQL);  
72.   
73.      UIBQuery1.ExecSQL;  
74.   
75.       DeltaDS.Next;  
76.   end;  
77.     Applied := true;  
78.   //UIBDeltaDs.Free;  
79. end;  

procedure TForm1.DataSetProvider1BeforeUpdateRecord(Sender: TObject;
  SourceDS: TDataSet; DeltaDS: TCustomClientDataSet; UpdateKind: TUpdateKind;
  var Applied: Boolean);
var
    i : Integer;
  SQL : String;
  ValueStr : String;
  NewStr : String;
  OldStr : String;
  //UIBDeltaDs : TUIBClientDataSet;
begin

  //UIBDeltaDs := TUIBClientDataSet.Create(Self);
  //UIBDeltaDs := DeltaDS.CloneCursor();

  UIBQuery1.SQL.Clear;

  UIBQuery1.SQL.Add('UPDATE EMPLOYEE SET ' + #13#10);

  while not(DeltaDS.eof) do
  begin
      //DeltaDS
     SQL := '';
     for i := 0 to DeltaDS.FieldCount - 1 do
     begin
       //UIBDeltaDs.DataConvert(
       if not(VarIsEmpty(DeltaDS.Fields[i].NewValue)) then
       begin
          //UIBQuery1.SQL.Add
          NewStr := VarToStr(DeltaDS.Fields[i].NewValue);
          OldStr := IfThen(not(VarIsNull(DeltaDs.Fields[i].OldValue)), VarToStr(DeltaDS.Fields[i].OldValue));

          if CompareText(NewStr,OldStr) <> 0 Then
          begin
             if (DeltaDs.Fields[i].DataType = ftDatetime) then
             begin
                ValueStr := FormatDateTime(
                                 'yyyy/mm/dd hh:nn:ss',
                                 VarToDateTime(DeltaDs.Fields[i].NewValue)
                            );
                   ValueStr := QuotedStr(ValueStr);
             end
             else
             begin
                       ValueStr := VarToStr(DeltaDS.Fields[i].NewValue);
                     if   (DeltaDs.Fields[i].DataType = ftString)
                       Or (DeltaDs.Fields[i].DataType = ftWideString)
                     then
                     begin
                        ValueStr := QuotedStr(ValueStr);
                     end
                end;
            end;

             SQL := SQL + ', ' + DeltaDS.Fields[i].FieldName + ' = ' + ValueStr + #13#10;
                 ListBox1.Items.Add(DeltaDS.Fields[i].FieldName);
                 ListBox1.Items.Add(NewStr);
                 ListBox1.Items.Add(OldStr);
          end;
       end;

     if Length(Trim(SQL)) > 0 then
     begin
       Sql := RightStr(Sql,Length(Sql)-1);
     end;

     UIBQuery1.SQL.Add(SQL);

     UIBQuery1.SQL.Add('WHERE EMP_NO = ' + VarToStr(DeltaDS.FieldByName('EMP_NO').OldValue));

     Memo1.Lines.Assign(UIBQuery1.SQL);

     UIBQuery1.ExecSQL;

      DeltaDS.Next;
  end;
    Applied := true;
  //UIBDeltaDs.Free;
end;

ここで、テーブルに対する操作は、UpdateKindで、変更対象のレコードは、DeltaDS
で取得できる。

あとは、適当なタイミングでClientDataSetのApplyUpdateメソッドをよびだせば、
データの更新ができる。(今回はボタンのクリックに割り当てた。)

以下、ソース例

view plainprint?

1. procedure TForm1.Button1Click(Sender: TObject);  
2. begin  
3.   //ClientDataSet1.Post;  
4.     UIBClientDataSet1.ApplyUpdates(-1);  
5. end;  

procedure TForm1.Button1Click(Sender: TObject);
begin
  //ClientDataSet1.Post;
    UIBClientDataSet1.ApplyUpdates(-1);
end;

Unified Interbaseコンポーネントをつかってみた（その３）

Unified Interbaseコンポーネントをつかってみた（その1）でUIBDataSet経由でDBグリッドに
データを表示した。

しかし、UIBDataSetはReadOnlyのデータセットなので、編集が不可となっています。
(前回のサンプルを実行してもグリッドに入力ができません。)

いくつか、実験をおこなった結果、UIBDataSetは、単方向データセットとして機能している
ようなので、ClientDataSetを経由で接続すれば、DbExpressドライバのように使えるはず
だと思い試してみた。

以下、試して確認できたことを備忘録代わりに記述

フォームにTClientDataSetコンポーネントとTDataSetProviderコンポーネントを配置し、
UIBDataset → DatasetProvieder → ClientDataset → DataSourceにリンク変更


ここで、ClientDataset をActiveにするとタイムスタンプがうまく処理できないようでエラーが
発生するので、ClinetDataSet、およびUIBDataSetのソースを調べた結果、以下のとおり
データ形式の不整合があった。

UIBDataSet -> TDatetime型
ClinetDataSet　→ 通算のミリ秒(ftDatetime指定時）

そこで、ClientDatasetと時刻データが正しく連携が取れるようUIBDataSetを拡張したコンポーネントで、接続した。
以下、ソース

view plainprint?

1. unit UIBCdsDataSet;  
2.   
3. interface  
4.   
5. uses  
6.   SysUtils, Classes, DB, uibdataset;  
7.   
8. type  
9.   TUIBCdsDataSet = class(TUIBDataSet)  
10.   private  
11.     { Private 宣言 }  
12.   protected  
13.     { Protected 宣言 }  
14.   public  
15.     { Public 宣言 }  
16.     function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload;{$IFNDEF FPC} override; {$ENDIF}  
17.     {$IFNDEF FPC}  
18.     function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload; override;  
19.     {$ENDIF}  
20.   published  
21.     { Published 宣言 }  
22.   end;  
23.   
24. procedure Register;  
25.   
26. implementation  
27.   
28. uses uiblib;  
29.   
30. procedure Register;  
31. begin  
32.   RegisterComponents('UIB', [TUIBCdsDataSet]);  
33. end;  
34.   
35. { TUIBCdsDataSet }  
36.   
37. function TUIBCdsDataSet.GetFieldData(FieldNo: Integer;  
38.   Buffer: Pointer): Boolean;  
39. var  
40.   doubleBuf : TDateTime;  
41.   aFieldType: TUIBFieldType;  
42.   tsbuf : TTimeStamp;  
43. begin  
44.   
45.  Result := inherited GetFieldData(FieldNo, Buffer);  
46.   if not(Result) then Exit;  
47.   if Buffer = nil then Exit;  
48.   
49.   aFieldType := Self.InternalFields.FieldType[FieldNo -1];  
50.   
51.   if aFieldType = uftTimestamp then  
52.   begin  
53.    doubleBuf := TDateTime(Buffer^);  
54.     tsbuf := DateTimeToTimeStamp(doubleBuf);  
55.   
56.    Double(Buffer^) :=  TimeStampToMSecs(tsbuf);  
57.  end;  
58. end;  
59.   
60. function TUIBCdsDataSet.GetFieldData(Field: TField; Buffer: Pointer;  
61.   NativeFormat: Boolean): Boolean;  
62. var  
63.  //SF : TSQLResult;  
64.   doubleBuf : TDateTime;  
65.   aFieldType: TUIBFieldType;  
66.   tsbuf : TTimeStamp;  
67. begin  
68.   
69.   Result := inherited GetFieldData(Field, Buffer,NativeFormat);  
70.   if not(Result) then Exit;  
71.   if Buffer = nil then Exit;  
72.   
73.   //SF := Self.InternalFields;  
74.   aFieldType := Self.InternalFields.FieldType[Field.FieldNo-1];  
75.   
76.   if aFieldType = uftTimestamp then  
77.   begin  
78.    doubleBuf := TDateTime(Buffer^);  
79.     tsbuf := DateTimeToTimeStamp(doubleBuf);  
80.   
81.    Double(Buffer^) :=  TimeStampToMSecs(tsbuf);  
82.   end;  
83.   
84. end;  
85.   
86. end.  

unit UIBCdsDataSet;

interface

uses
  SysUtils, Classes, DB, uibdataset;

type
  TUIBCdsDataSet = class(TUIBDataSet)
  private
    { Private 宣言 }
  protected
    { Protected 宣言 }
  public
    { Public 宣言 }
    function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload;{$IFNDEF FPC} override; {$ENDIF}
    {$IFNDEF FPC}
    function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload; override;
    {$ENDIF}
  published
    { Published 宣言 }
  end;

procedure Register;

implementation

uses uiblib;

procedure Register;
begin
  RegisterComponents('UIB', [TUIBCdsDataSet]);
end;

{ TUIBCdsDataSet }

function TUIBCdsDataSet.GetFieldData(FieldNo: Integer;
  Buffer: Pointer): Boolean;
var
  doubleBuf : TDateTime;
  aFieldType: TUIBFieldType;
  tsbuf : TTimeStamp;
begin

 Result := inherited GetFieldData(FieldNo, Buffer);
  if not(Result) then Exit;
  if Buffer = nil then Exit;

  aFieldType := Self.InternalFields.FieldType[FieldNo -1];

  if aFieldType = uftTimestamp then
  begin
   doubleBuf := TDateTime(Buffer^);
    tsbuf := DateTimeToTimeStamp(doubleBuf);

   Double(Buffer^) :=  TimeStampToMSecs(tsbuf);
 end;
end;

function TUIBCdsDataSet.GetFieldData(Field: TField; Buffer: Pointer;
  NativeFormat: Boolean): Boolean;
var
 //SF : TSQLResult;
  doubleBuf : TDateTime;
  aFieldType: TUIBFieldType;
  tsbuf : TTimeStamp;
begin

  Result := inherited GetFieldData(Field, Buffer,NativeFormat);
  if not(Result) then Exit;
  if Buffer = nil then Exit;

  //SF := Self.InternalFields;
  aFieldType := Self.InternalFields.FieldType[Field.FieldNo-1];

  if aFieldType = uftTimestamp then
  begin
   doubleBuf := TDateTime(Buffer^);
    tsbuf := DateTimeToTimeStamp(doubleBuf);

   Double(Buffer^) :=  TimeStampToMSecs(tsbuf);
  end;

end;

end.

これで時刻型のフィールドでエラーが発生することなく連携ができた。