[BlueLeaf1336]> PROGRAM>

Delphiでmdbを操作 - 003

history

TOP

2006/09/10:作成
2006/09/13:NULL許可のフィールドを空文字列許可に強制変更するためのメソッド追加
2006/09/14:同じ条件でデータベースを開きなおすメソッド追加

download

TOP

DatabaseIO.zip(5,012bytes)※ソースコードです。

overview

TOP

SELECT操作ができないまま、長い間ほったらかしにしていましたが、データベースを使ってみようか、と思い立ったのでついでに続きを書きました。

ひょっとしたら前よりも機能ダウンしているかも知れません。ベースになるクラスを汎用的に見える感じで書いていますが、mdb専用に変わりありません。

できること

• パスワードつきのデータベースへの接続・切断(多分)
• データベースが無い場合、ファイルを勝手に作成(できることではなく、やってしまうこと)
• トランザクション処理
• テーブル名の一覧取得
• 指定テーブルのフィールド名一覧取得
• 更新系クエリー発行(ひとつ・複数)
• SELECT操作(レコードセット作成・破棄)
• レコードセットの MoveNext
• レコードセットの BOF・EOF 判定
• レコードセットのフィールド数取得
• レコードセットのフィールド名取得
• レコードセットのフィールド値取得
• パスワード変更(多分)
• 最適化

言い訳

• DatabaseIO.pas に宣言してある DB: TDatabase と CS: TCriticalSection は、横着なだけです。
  使用するユニットで宣言すべきかと。
• マルチな接続は多分無理です。クエリーの発行やその他もろもろはひとつづつやりましょう。
  そのための CS: TCriticalSection です。CS.Enter() / CS.Leave() でこつこつと。

code

TOP

//=============================================================================
//  BlueLeaf1336 http://www.geocities.jp/fjtkt/
//-----------------------------------------------------------------------------
//  2006.09.09  作成
//  2006.09.10  TDatabaseJet.Open で mdb がなければ作成するようにした
//              TDatabaseJet.ChangePassword 追加(失敗対策適当)
//              TDatabaseJet.CompactDatabase 追加
//=============================================================================

{
    参考

    Collection.Count
    Collection.Item[i]
        Collection = Tables, Columns, Fields, Properties, etc.

    Table = Catalog.Tables[i]

        Table.Columns
        Table.Name
        Table.DateCreated
        Table.DateModified
        Table.Type

    Column = Table.Columns[i]

        Column.Name
        Column.Type
        Column.Attributes
        Column.DefinedSize
        Column.NumericScale
        Column.Precision

    Field = RecordSet.Fields[i]

        Columnの全部
        Field.Value
        Field.ActualSize

    Object.Properties
        Object = Table, Column, Field, etc.

    Property = Object.Properties[i]
        Property.Name
        Property.Value
}

unit DatabaseIO;

interface

uses
    Windows, SysUtils, Classes, ComObj, Variants, SyncObjs;

type
    //  ADO接続によるデータベースクラス
    TDatabase = class(TObject)
    protected
        FCatalog: OleVariant;
        FDatabase: OleVariant;
        FUser: String;
        FPass: String;
        FDatabaseName: String;
        FOpened: Boolean;
    protected
        function BuildConnectionString(const AUser, APass, ADatabaseName: String): String; virtual; abstract; 
    public
        constructor Create();
        destructor Destroy(); override;
        property User: String read FUser;
        property Pass: String read FPass;
        property DatabaseName: String read FDatabaseName;
        property Opened: Boolean read FOpened;
    public
        function Open(const AUser, APass, ADatabaseName: String; var Err: String): Boolean; virtual;
        procedure Close();
        function BeginTrans(var Err: String): Boolean; overload;
        function CommitTrans(var Err: String): Boolean; overload;
        function RollbackTrans(var Err: String): Boolean; overload;
        function BeginTrans(): Boolean; overload;
        function CommitTrans(): Boolean; overload;
        function RollbackTrans(): Boolean; overload;
        function Execute(const AQuery: String; var Err: String): Boolean; overload;
        function Execute(const AQueries: TStrings; var Err: String): Boolean; overload;
    public
        procedure GetTableNames(AList: TStrings);
        procedure GetTableFields(const ATableName: String; AList: TStrings);
        property Catalog: OleVariant read FCatalog;
        property Database: OleVariant read FDatabase;
    public
        function OpenQuery(const AQuery: String; var ASet: OleVariant; var Err: String): Boolean;
        procedure CloseQuery(var ASet: OleVariant);
        procedure MoveNext(const ASet: OleVariant);
        function IsEOF(const ASet: OleVariant): Boolean;
        function IsBOF(const ASet: OleVariant): Boolean;
        function IsXOF(const ASet: OleVariant): Boolean;
        function FieldCount(const ASet: OleVariant): Integer;
        function FieldName(const ASet: OleVariant; const AIndex: Integer): String;
        function FieldValue(const ASet: OleVariant; const AIndex: Integer): Variant; overload;
        function FieldValue(const ASet: OleVariant; const AName: String): Variant; overload;
    end;

    //  JET-DB専用データベースクラス
    TDatabaseJet = class(TDatabase)
    protected
        function BuildConnectionString(const AUser, APass, ADatabaseName: String): String; override;
    public
        function Open(const AUser, APass, ADatabaseName: String; var Err: String): Boolean; override;
        function ChangePassword(const ANewPass: String; var Err: String): Boolean;
        function CompactDatabase(var Err: String): Boolean;
    end;

function Quote(const S: String): String;
function NVL(const V, ADefault: Variant): Variant;

var
    CS: TCriticalSection = nil;
    DB: TDatabase = nil;

implementation

//=============================================================================
//  Utility

//-----------------------------------------------------------------------------
//  二重引用符で囲む
function Quote(const S: String): String;
begin
    Result := AnsiQuotedStr(S, '"');
end;

//-----------------------------------------------------------------------------
//  NULL対策
function NVL(const V, ADefault: Variant): Variant;
begin
    Result := V;
    if (VarIsNull(V)) then Result := ADefault;
end;

//-----------------------------------------------------------------------------
//  テンポラリファイル名取得
//  http://www.mesuttop.com/delphi/tip_files.htm
function TempFileName(const ADir: String): String;
var
    LBuffer: array[0..MAX_PATH] of Char;
begin
    FillChar(LBuffer, SizeOf(LBuffer), 0);
    GetTempFileName(PChar(ADir), '!mdb', 0, LBuffer);
    Result := String(LBuffer);
end;

//=============================================================================
//  TDatabase

//-----------------------------------------------------------------------------
//  コンストラクタ
constructor TDatabase.Create();
begin
    inherited Create();
    FCatalog := Unassigned;
    FDatabase := Unassigned;
end;

//-----------------------------------------------------------------------------
//  デストラクタ
destructor TDatabase.Destroy();
begin
    Close();
    inherited Destroy();
end;

//-----------------------------------------------------------------------------
//  データベースに接続
function TDatabase.Open(const AUser, APass, ADatabaseName: String; var Err: String): Boolean;
begin
    Close();
    Result := False;
    try
        FCatalog := CreateOleObject('ADOX.Catalog');
        FCatalog.ActiveConnection := BuildConnectionString(AUser, APass, ADatabaseName);
        FDatabase := FCatalog.ActiveConnection;
        FOpened := True;
        FUser := AUser;
        FPass := APass;
        FDatabaseName := ADatabaseName;
        Result := True;
    except
        on E:Exception do
        begin
            Err := E.Message;
            Close();
        end;
    end;
end;

//-----------------------------------------------------------------------------
//  データベースから切断
procedure TDatabase.Close();
begin
    if (FOpened) then
    begin
        FDatabase.Close;
    end;
    FUser := '';
    FPass := '';
    FDatabaseName := '';
    FDatabase := Unassigned;
    FCatalog := Unassigned;
    FOpened := False;
end;

//-----------------------------------------------------------------------------
//  トランザクション処理
function TDatabase.BeginTrans(var Err: String): Boolean;
begin
    Result := False;
    try
        FDatabase.BeginTrans;
        Result := True;
    except
        on E:Exception do Err := E.Message;
    end;
end;

//-----------------------------------------------------------------------------
function TDatabase.CommitTrans(var Err: String): Boolean;
begin
    Result := False;
    try
        FDatabase.CommitTrans;
        Result := True;
    except
        on E:Exception do Err := E.Message;
    end;
end;

//-----------------------------------------------------------------------------
function TDatabase.RollbackTrans(var Err: String): Boolean;
begin
    Result := False;
    try
        FDatabase.RollbackTrans;
        Result := True;
    except
        on E:Exception do Err := E.Message;
    end;
end;

//-----------------------------------------------------------------------------
//  トランザクション処理(エラー内容不要版)
function TDatabase.BeginTrans(): Boolean;
var
    LErr: String;
begin
    Result := BeginTrans(LErr);
end;

//-----------------------------------------------------------------------------
function TDatabase.CommitTrans(): Boolean;
var
    LErr: String;
begin
    Result := CommitTrans(LErr);
end;

//-----------------------------------------------------------------------------
function TDatabase.RollbackTrans(): Boolean;
var
    LErr: String;
begin
    Result := RollbackTrans(LErr);
end;

//-----------------------------------------------------------------------------
//  クエリー発行
function TDatabase.Execute(const AQuery: String; var Err: String): Boolean;
begin
    Result := False;
    try
        FDatabase.Execute(AQuery);
        Result := True;
    except
        on E:Exception do Err := E.Message;
    end;
end;

//-----------------------------------------------------------------------------
//  クエリー一括発行(空行無視)
function TDatabase.Execute(const AQueries: TStrings; var Err: String): Boolean;
var
    i: Integer;
    LQuery: String;
begin
    Result := False;
    for i := 0 to AQueries.Count - 1 do
    begin
        LQuery := AQueries.Strings[i];
        if (LQuery <> '') then
        begin
            Result := Execute(LQuery, Err);
            if (not Result) then Break;
        end;
    end;
end;

//-----------------------------------------------------------------------------
//  テーブル名の一覧取得
procedure TDatabase.GetTableNames(AList: TStrings);
var
    LTables: OleVariant;
    LTable: OleVariant;
    i: Integer;
begin
    LTables := FCatalog.Tables;
    for i := 0 to LTables.Count - 1 do
    begin
        LTable := LTables.Item[i];
        AList.Add(LTable.Name);
    end;
end;

//-----------------------------------------------------------------------------
//  指定テーブルのフィールド名の一覧取得
procedure TDatabase.GetTableFields(const ATableName: String; AList: TStrings);
var
    LTables: OleVariant;
    LTable: OleVariant;
    LColumns: OleVariant;
    LColumn: OleVariant;
    i: Integer;
begin
    LTables := FCatalog.Tables;
    LTable := LTables.Item[ATableName];
    LColumns := LTable.Columns;
    for i := 0 to LColumns.Count - 1 do
    begin
        LColumn := LColumns.Item[i];
        AList.Add(LColumn.Name);
    end;
end;

//-----------------------------------------------------------------------------
//  レコードセット作成
function TDatabase.OpenQuery(const AQuery: String; var ASet: OleVariant; var Err: String): Boolean;
begin
    Result := False;
    ASet := Unassigned;
    try
        ASet := CreateOleObject('ADODB.Recordset');
        ASet.Open(AQuery, FDatabase);
        Result := True;
    except
        on E:Exception do Err := E.Message;
    end;
end;

//-----------------------------------------------------------------------------
//  レコードセット破棄
procedure TDatabase.CloseQuery(var ASet: OleVariant);
begin
    ASet.Close;
    ASet := Unassigned;
end;

//-----------------------------------------------------------------------------
//  次のレコードへ移動
procedure TDatabase.MoveNext(const ASet: OleVariant);
begin
    ASet.MoveNext;
end;

//-----------------------------------------------------------------------------
//  レコードセットがEOFかどうか
function TDatabase.IsEOF(const ASet: OleVariant): Boolean;
begin
    Result := ASet.EOF;
end;

//-----------------------------------------------------------------------------
//  レコードセットがBOFかどうか
function TDatabase.IsBOF(const ASet: OleVariant): Boolean;
begin
    Result := ASet.BOF;
end;

//-----------------------------------------------------------------------------
//  レコードセットがEOFまたはBOFかどうか
function TDatabase.IsXOF(const ASet: OleVariant): Boolean;
begin
    Result := IsEOF(ASet) or IsBOF(ASet);
end;

//-----------------------------------------------------------------------------
//  レコードセットのフィールド数
function TDatabase.FieldCount(const ASet: OleVariant): Integer;
begin
    Result := ASet.Fields.Count;    
end;

//-----------------------------------------------------------------------------
//  レコードセットの指定番目のフィールド名
function TDatabase.FieldName(const ASet: OleVariant; const AIndex: Integer): String;
begin
    Result := ASet.Fields[AIndex].Name;
end;

//-----------------------------------------------------------------------------
//  レコードセットの指定番目の値
function TDatabase.FieldValue(const ASet: OleVariant; const AIndex: Integer): Variant;
begin
    Result := ASet.Fields[AIndex].Value;
end;

//-----------------------------------------------------------------------------
//  レコードセットの値
function TDatabase.FieldValue(const ASet: OleVariant; const AName: String): Variant;
begin
    Result := ASet.Fields[AName].Value;
end;

//=============================================================================
//  TDatabaseJet

//-----------------------------------------------------------------------------
//  接続文字列作成
function TDatabaseJet.BuildConnectionString(const AUser, APass, ADatabaseName: String): String;
const
    JET_OLEDB = 'Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=%s;Data Source=%s';
begin
    Result := Format(JET_OLEDB, [APass, ADatabaseName]);
end;

//-----------------------------------------------------------------------------
//  データベースを開く(なければ作る)
//  TDatabase.Open とほとんど同じなのがもったいない
function TDatabaseJet.Open(const AUser, APass, ADatabaseName: String; var Err: String): Boolean;
begin
    Close();
    Result := False;
    try
        FCatalog := CreateOleObject('ADOX.Catalog');

        //  なければ作る
        if (not FileExists(ADatabaseName)) then
        begin
            FCatalog.Create(BuildConnectionString(AUser, APass, ADatabaseName));
        end;

        //  接続する
        FCatalog.ActiveConnection := BuildConnectionString(AUser, APass, ADatabaseName);
        FDatabase := FCatalog.ActiveConnection;
        FOpened := True;
        FUser := AUser;
        FPass := APass;
        FDatabaseName := ADatabaseName;
        Result := True;
    except
        on E:Exception do
        begin
            Err := E.Message;
            Close();
        end;
    end;
end;

//-----------------------------------------------------------------------------
//  パスワード変更
function TDatabaseJet.ChangePassword(const ANewPass: String; var Err: String): Boolean;
var
    LUser, LPass, LDatabaseName: String;
    LEngine: OleVariant;
    LTemp: String;
    LSrc, LDst: String;
begin
    Result := False;

    LUser := FUser;
    LPass := FPass;
    LDatabaseName := FDatabaseName;

    //  閉じる
    Close();

    //  一時ファイル名
    LTemp := TempFileName(ExtractFilePath(LDatabaseName));
    DeleteFile(LTemp);

    //  接続文字列作成
    LSrc := BuildConnectionString(LUser, LPass, LDatabaseName);
    LDst := BuildConnectionString(LUser, ANewPass, LTemp);

    try
        try
            //  パスワード変更(正確には最適化)
            LEngine := CreateOleObject('JRO.JetEngine');
            LEngine.CompactDatabase(LSrc, LDst);

            //  置き換える
            DeleteFile(LDatabaseName);
            RenameFile(LTemp, LDatabaseName);
        finally
            LEngine := Unassigned;
        end;
        Result := True;
    except
        on E:Exception do Err := E.Message;
    end;

    //  開く
    if Result then
    begin
        Result := Open(LUser, ANewPass, LDatabaseName, Err);
    end
    else
    begin
        Result := Open(LUser, LPass, LDatabaseName, Err);
    end;
end;

//-----------------------------------------------------------------------------
//  データベース最適化
function TDatabaseJet.CompactDatabase(var Err: String): Boolean;
begin
    Result := ChangePassword(FPass, Err);
end;

//-----------------------------------------------------------------------------
initialization
    CS := TCriticalSection.Create();
finalization
    CS.Free();
end.

sample

TOP

このユニットのテストに使ったプログラムです。mdb は Microsoft Access のサンプルデータベース NWIND.MDB を使用しました。

クラスにできることを呼び出しているだけなので、面白いことはしていません。「mdb選択」で指定した mdb のテーブル一覧を表示して、選択したテーブルの全レコードをグリッドに表示します。

ちなみにこのサンプルではパスワードつきのデータベースは開けません。パスワード入力欄を設けるのが邪魔くさかったからで、逆に言うとパスワードつきのデータベースを開くテストはしていません。

今回レコードセットのフィールド名を取り出せるようにしているので、任意の SELECT 文の一覧表示が簡単にできる、はずです。ただしサンプルでは、「SELECT *」限定なのとテストのため、レコードセットからフィールドを取り出さず、テーブル自体の列を表示しています。

このとき存在しないファイルを指定すると、そういうファイル名でデータベースファイルを作成します。勝手に。

「最適化」は最適化を実行します。ソースのコメントにも書いてありますが、失敗対策が適当なので(失敗したことありませんが)、大切な mdb ファイルで試すのはやめたほうがよいです。

「SQL」テストは、エディットボックスに入力したクエリーを BeginTrans() と RollbackTrans() ではさんで実行します。ただ、ここに CREATE TABLE 文などを書くと多分ロールバックできないと思います。その辺はだいたいで。

Jet20060910.zip(229,101bytes)※ソースコードと実行ファイルです。

NULL許可のフィールドを空文字列許可に強制変更するためのメソッド(2006/09/13)

TOP

探求其之弐 マイクロソフト技術情報目次作成 > 再始動 のところで、このクラスを通して CREATE TABLE 文を発行することで、テーブルを作成できることを確認しました。当然、あるフィールドは NOT NULL だし、逆に NULL 可 のフィールドもあります。

あれ? mdb って、NULL可 だけじゃだめで「空文字列許可」も設定しないとだめですやん。

と言うわけで、指定したテーブルの全てのフィールドについて、それが文字列フィールドで NULL可 なら、空文字列も強制的に許可するメソッドを追加しました。ひょっとすると CREATE TABLE 文の書き方で対処できるのかも知れませんが、今はインターネットにつなげないので強引に押し切ることにします。

以下の処理ですが、ColumnTypeIsText というのは、数値型や他の文字列型でないフィールドまで処理してしまわないように、その列が文字列型かどうかをチェックする関数です。なくてもエラーにならないようなのではしょります。(ダウンロードファイルを覗いてもらえば書いてあります)

//-----------------------------------------------------------------------------
//  指定テーブルの NULL可 のフィールドの 空文字列許可フラグを立てる
function TDatabaseJet.SyncNullableAllowZeroLength(const ATableName: String; var Err: String): Boolean;
var
    LTables: OleVariant;
    LTable: OleVariant;
    LColumns: OleVariant;
    LColumn: OleVariant;
    i: Integer;
begin
    Result := False;

    LTables := FCatalog.Tables;
    LTable := LTables.Item[ATableName];
    LColumns := LTable.Columns;

    try
        for i := 0 to LColumns.Count - 1 do
        begin
            LColumn := LColumns.Item[i];

            //  文字列型のみ対象にする
            if (not ColumnTypeIsText(LColumn)) then Continue;

            //  NULL許可列のみ対象にする
            if (not LColumn.Properties['Nullable']) then Continue;

            //  空文字列許可に設定する
            LColumn.Properties['Jet OLEDB:Allow Zero Length'] := True;
        end;

        Result := True;
    except
        on E:Exception do Err := E.Message;
    end;
end;

Windows XP に Office2000 Professional の Access2000 (SR1 + SP3) をインストールした状態では、これで動いています。

同じ条件でデータベースを開きなおすメソッド (2006/09/14)

TOP

mdb に対してクエリーを発行して、テーブルやビューを作成すると、何故かそのままでは参照することができません。多分何かの方法はあるはずですが、いったん閉じて改めて開きなおすとちゃんと参照できるので、ここではそういうメソッドを追加することにしました。

わざわざこんなメソッドを準備するのは、Close() によりデータベースから切断したとき、パスワードやファイル名をクリアしてしまっているからです。そういうわけで、Close() するまえに パスワードやファイル名を覚えておいて、その情報を使って開きなおす、というなにやらおかしな感じのメソッドを用意したというわけです。

//-----------------------------------------------------------------------------
//  いったん閉じて再度開く
function TDatabase.ReOpen(var Err: String): Boolean;
var
    LUser, LPass, LDatabaseName: String;
begin
    LUser := FUser;
    LPass := LPass;
    LDatabaseName := FDatabaseName;

    //  閉じる
    Close();

    //  開く
    Result := Open(LUser, LPass, LDatabaseName, Err);
end;

EOF

TOP