SQL Server のデータベースのテーブルとフィールド名を表示する。（その2)

Sql Server 2005以上であれば、システムカタログに対してクエリを発行することで
テーブル名とフィールド名のリストの取得ができます。
(詳細は、システムカタログのクエリのQandAページを参照)

クエリを発行できるということは、

程度の画面であればマスターリンクを使ってノンコーディング
（クエリーは組む必要はありますが）でテーブルとフィールドのリストを表示できます。

このへんがDelphiのすごいところですね。

以下、フォーム表示をテキスト表示したもの


object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 535
  ClientWidth = 727
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object PageControl1: TPageControl
    Left = 0
    Top = 0
    Width = 727
    Height = 535
    ActivePage = TabSheet2
    Align = alClient
    TabOrder = 0
    object TabSheet1: TTabSheet
      Caption = 'TabSheet1'
      object Label1: TLabel
        Left = 192
        Top = 88
        Width = 56
        Height = 13
        Caption = #12501#12451#12540#12523#12489#21517
      end
      object Label2: TLabel
        Left = 16
        Top = 88
        Width = 50
        Height = 13
        Caption = #12486#12540#12502#12523#21517
      end
      object Label3: TLabel
        Left = 552
        Top = 88
        Width = 56
        Height = 13
        Caption = #12501#12451#12540#12523#12489#21517
      end
      object Label4: TLabel
        Left = 376
        Top = 88
        Width = 50
        Height = 13
        Caption = #12486#12540#12502#12523#21517
      end
      object Button1: TButton
        Left = 96
        Top = 16
        Width = 169
        Height = 33
        Caption = 'dbGo'#12398#12513#12477#12483#12489#12434#20351#29992
        TabOrder = 0
        OnClick = Button1Click
      end
      object ListBox1: TListBox
        Left = 16
        Top = 106
        Width = 169
        Height = 401
        ItemHeight = 13
        TabOrder = 1
        OnClick = ListBox1Click
      end
      object ListBox2: TListBox
        Left = 191
        Top = 106
        Width = 169
        Height = 401
        ItemHeight = 13
        TabOrder = 2
      end
      object ListBox3: TListBox
        Left = 376
        Top = 106
        Width = 169
        Height = 401
        ItemHeight = 13
        TabOrder = 3
        OnClick = ListBox3Click
      end
      object ListBox4: TListBox
        Left = 550
        Top = 106
        Width = 169
        Height = 401
        ItemHeight = 13
        TabOrder = 4
      end
      object Button2: TButton
        Left = 472
        Top = 16
        Width = 169
        Height = 33
        Caption = 'DbExpress'#12398#12513#12477#12483#12489#12434#20351#29992
        TabOrder = 5
        OnClick = Button2Click
      end
    end
    object TabSheet2: TTabSheet
      Caption = 'TabSheet2'
      ImageIndex = 1
      object DBGrid1: TDBGrid
        Left = 0
        Top = 0
        Width = 145
        Height = 507
        Align = alLeft
        DataSource = DataSource1
        TabOrder = 0
        TitleFont.Charset = DEFAULT_CHARSET
        TitleFont.Color = clWindowText
        TitleFont.Height = -11
        TitleFont.Name = 'Tahoma'
        TitleFont.Style = []
        Columns = <
          item
            Expanded = False
            FieldName = 'Name'
            Visible = True
          end>
      end
      object DBGrid2: TDBGrid
        Left = 145
        Top = 0
        Width = 160
        Height = 507
        Align = alLeft
        DataSource = DataSource2
        TabOrder = 1
        TitleFont.Charset = DEFAULT_CHARSET
        TitleFont.Color = clWindowText
        TitleFont.Height = -11
        TitleFont.Name = 'Tahoma'
        TitleFont.Style = []
        Columns = <
          item
            Expanded = False
            FieldName = 'NAME'
            Visible = True
          end>
      end
    end
    object TabSheet3: TTabSheet
      Caption = 'TabSheet3'
      ImageIndex = 2
      object DBGrid3: TDBGrid
        Left = 0
        Top = 0
        Width = 177
        Height = 507
        Align = alLeft
        DataSource = DataSource3
        TabOrder = 0
        TitleFont.Charset = DEFAULT_CHARSET
        TitleFont.Color = clWindowText
        TitleFont.Height = -11
        TitleFont.Name = 'Tahoma'
        TitleFont.Style = []
        Columns = <
          item
            Expanded = False
            FieldName = 'Name'
            Visible = True
          end>
      end
      object DBGrid4: TDBGrid
        Left = 177
        Top = 0
        Width = 184
        Height = 507
        Align = alLeft
        DataSource = DataSource4
        TabOrder = 1
        TitleFont.Charset = DEFAULT_CHARSET
        TitleFont.Color = clWindowText
        TitleFont.Height = -11
        TitleFont.Name = 'Tahoma'
        TitleFont.Style = []
        Columns = <
          item
            Expanded = False
            FieldName = 'NAME'
            Visible = True
          end>
      end
    end
  end
  object ADOConnection1: TADOConnection
    Connected = True
    ConnectionString =
      'Provider=SQLNCLI10.1;Integrated Security="";Persist Security Inf' +
      'o=False;User ID=sa;Initial Catalog=AdventureWorks;Data Source=SA' +
      'KANOTE-PC\SqlExpress;Initial File Name="";Server SPN=""'
    LoginPrompt = False
    Provider = 'SQLNCLI10.1'
    Left = 16
    Top = 456
  end
  object SQLConnection1: TSQLConnection
    ConnectionName = 'MSSQLConnection'
    DriverName = 'MSSQL'
    GetDriverFunc = 'getSQLDriverMSSQL'
    LibraryName = 'dbxmss.dll'
    LoginPrompt = False
    Params.Strings = (
      'SchemaOverride=%.dbo'
      'DriverUnit=DBXMSSQL'
    
        'DriverPackageLoader=TDBXDynalinkDriverLoader,DBXCommonDriver150.' +
        'bpl'
    
        'DriverAssemblyLoader=Borland.Data.TDBXDynalinkDriverLoader,Borla' +
        'nd.Data.DbxCommonDriver,Version=15.0.0.0,Culture=neutral,PublicK' +
        'eyToken=91d62ebb5b0d1b1b'
    
        'MetaDataPackageLoader=TDBXMsSqlMetaDataCommandFactory,DbxMSSQLDr' +
        'iver150.bpl'
    
        'MetaDataAssemblyLoader=Borland.Data.TDBXMsSqlMetaDataCommandFact' +
        'ory,Borland.Data.DbxMSSQLDriver,Version=15.0.0.0,Culture=neutral' +
        ',PublicKeyToken=91d62ebb5b0d1b1b'
      'GetDriverFunc=getSQLDriverMSSQL'
      'LibraryName=dbxmss.dll'
      'VendorLib=sqlncli10.dll'
      'MaxBlobSize=-1'
      'OSAuthentication=False'
      'PrepareSQL=True'
      'DriverName=MSSQL'
      'HostName=SAKANOTE-PC\SQLEXPRESS'
      'Database=AdventureWorks'
      'User_Name=sa'
      'Password=sysdba'
      'BlobSize=-1'
      'ErrorResourceFile='
      'LocaleCode=0000'
      'IsolationLevel=ReadCommitted'
      'OS Authentication=False'
      'Prepare SQL=False'
      'ConnectTimeout=60'
      'Mars_Connection=False')
    VendorLib = 'sqlncli10.dll'
    Connected = True
    Left = 464
    Top = 56
  end
  object ADOQuery1: TADOQuery
    Connection = ADOConnection1
    CursorType = ctStatic
    Parameters = <>
    SQL.Strings = (
      'SELECT Object_ID, Name FROM SYS.TABLES')
    Left = 16
    Top = 488
  end
  object DataSetProvider1: TDataSetProvider
    DataSet = ADOQuery1
    Left = 56
    Top = 504
  end
  object ClientDataSet1: TClientDataSet
    Active = True
    Aggregates = <>
    Params = <>
    ProviderName = 'DataSetProvider1'
    Left = 88
    Top = 504
  end
  object DataSource1: TDataSource
    DataSet = ClientDataSet1
    Left = 24
    Top = 184
  end
  object ADOQuery2: TADOQuery
    Connection = ADOConnection1
    CursorType = ctStatic
    Parameters = <
      item
        Name = 'Object_ID'
        DataType = ftInteger
        Value = 14623095
      end>
    SQL.Strings = (
      'SELECT Object_ID , NAME FROM sys.columns')
    Left = 144
    Top = 504
  end
  object ClientDataSet2: TClientDataSet
    Active = True
    Aggregates = <>
    IndexFieldNames = 'Object_ID'
    MasterFields = 'Object_ID'
    MasterSource = DataSource1
    PacketRecords = 0
    Params = <>
    ProviderName = 'DataSetProvider2'
    Left = 208
    Top = 504
  end
  object DataSetProvider2: TDataSetProvider
    DataSet = ADOQuery2
    Left = 176
    Top = 504
  end
  object DataSource2: TDataSource
    DataSet = ClientDataSet2
    Left = 96
    Top = 176
  end
  object ClientDataSet3: TClientDataSet
    Active = True
    Aggregates = <>
    Params = <>
    ProviderName = 'DataSetProvider3'
    Left = 464
    Top = 112
  end
  object DataSetProvider3: TDataSetProvider
    DataSet = SQLQuery1
    Left = 464
    Top = 168
  end
  object SQLQuery1: TSQLQuery
    MaxBlobSize = -1
    Params = <>
    SQL.Strings = (
      'SELECT Object_ID, Name FROM SYS.TABLES')
    SQLConnection = SQLConnection1
    Left = 464
    Top = 216
  end
  object DataSource3: TDataSource
    DataSet = ClientDataSet3
    Left = 456
    Top = 280
  end
  object DataSetProvider4: TDataSetProvider
    DataSet = SQLQuery2
    Left = 600
    Top = 176
  end
  object ClientDataSet4: TClientDataSet
    Active = True
    Aggregates = <>
    IndexFieldNames = 'Object_ID'
    MasterFields = 'Object_ID'
    MasterSource = DataSource3
    PacketRecords = 0
    Params = <>
    ProviderName = 'DataSetProvider4'
    Left = 592
    Top = 104
  end
  object DataSource4: TDataSource
    DataSet = ClientDataSet4
    Left = 576
    Top = 280
  end
  object SQLQuery2: TSQLQuery
    MaxBlobSize = -1
    Params = <
      item
        DataType = ftInteger
        Name = 'Object_ID'
        ParamType = ptInput
        Value = 14623095
      end>
    SQL.Strings = (
      'SELECT Object_ID , NAME FROM sys.columns')
    SQLConnection = SQLConnection1
    Left = 584
    Top = 240
  end
end

SQL Server のデータベースのテーブルとフィールド名を表示する。（その1)

仕事でSql Serverのテーブルリストを表示する必要があったので・・・

DelphiでSQl Srerverのテーブルリストを表示する方法をいくつか


1. dbGOのConnectionのGetTableNamesメソッドとGetFieldNamesメソッドを利用する。


dbGoのGetTableNamesを利用すればInitial_Catalogで指定したデータベースの
テーブルリストを取得できます。

また、GetFieldNamesを利用すれば、指定したテーブルのフィールドのリストを表示できます。

ソースは、こんな感じ・・・
（ボタンをクリックするとテーブルのリストを表示し、リストの中のテーブルをクリックすると
クリックしたテーブルのリストを表示します。）

procedure TForm1.Button1Click(Sender: TObject);
begin
  ADOConnection1.Connected := true;
  ADOConnection1.GetTableNames(ListBox1.Items,false);
  ADOConnection1.Connected := false;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
var
  TableName : String;
begin
   if ListBox1.Items.Count > 0 then
   begin
      TableName := ListBox1.Items[ListBox1.ItemIndex];
      if Length(TableName) > 0 then
      begin
        ADOConnection1.Connected := true;
        ADOConnection1.GetFieldNames(TableName,ListBox2.Items);
        ADOConnection1.Connected := false;
      end;
   end;
end;

2. DbExpressを利用する。

DbExpressのSQLConnectionにもGetTableNamesメソッドとGetFieldNamesがあるので
dbGOと同様に処理できます。

ただし、試した中では、DbExpressでは、スキーマを指定しないとdboスキーマのテーブル
しか取得しないようなので、GetSchemaNamesでスキーマ名のリストを取得したうえで
スキーマ毎にテーブルを取得する必要がありました。

でソースはこんな感じ。スキーマ名を取得してる関係でちょっと複雑です。

procedure TForm1.Button1Click(Sender: TObject);

procedure TForm1.Button2Click(Sender: TObject);
var
  GetSchemaNames : TStringList;
  TableNames : TStringList;
  i,j : Integer;
begin
  ListBox3.Items.Clear;
  SQLConnection1.Connected := true;
  GetSchemaNames := TStringList.Create;
  try
    SQLConnection1.GetSchemaNames(GetSchemaNames);
    for i := 0 to GetSchemaNames.Count -1 do
    begin
      TableNames := TStringList.Create;
      try
        SQLConnection1.GetTableNames(TableNames,GetSchemaNames.Strings[i],false);
        for j := 0 to TableNames.Count-1 do
        begin
          ListBox3.Items.Add(GetSchemaNames.Strings[i] + '.' + TableNames.Strings[j]);
        end;
      finally
        TableNames.Free;
      end;
    end;
  finally
    GetSchemaNames.Free;
  end;
  SQLConnection1.Connected := false;
end;

procedure TForm1.ListBox3Click(Sender: TObject);
var
  TableName : String;
begin
   if ListBox1.Items.Count > 0 then
   begin
      TableName := ListBox3.Items[ListBox3.ItemIndex];
      if Length(TableName) > 0 then
      begin
        SQLConnection1.Connected := true;
        SQLConnection1.GetFieldNames(TableName,ListBox4.Items);
        SQLConnection1.Connected := false;
      end;

   end;
end;

JoinStringはないの？（その２）

Delフサさんから指摘を受けましたので、オープン配列版のJoinString関数を
作成してみました。(Delフサ様ご指摘ありがとうございます。）

でついでに、文字列の最後にDelemeterを付加するかどうかを指定できる
オーバーロード関数をも作ってみました。

以下、ソースコード

unit VbLikeStringUtil;

interface

uses
  StrUtils,Types;

  function JoinString(AStrings : Array of String; Delemeter: String) : String overload;
  function JoinString(AStrings : Array of String; Delemeter: String; AddLastDelemeter : Boolean) : String overload;


implementation

uses
  SysUtils;


function JoinString(AStrings : Array of String; Delemeter: String) : String overload;
begin
  Result := JoinString(AStrings,Delemeter,false);
end;

function JoinString(AStrings : Array of String; Delemeter: String; AddLastDelemeter : Boolean) : String overload;
var
  i : Longint;
begin

  Result := '';
  if (Length(AStrings) > 0) then
  begin

    //最後の
    for i := low(AStrings) to high(AStrings)-1 do
    begin
      Result := Result + AStrings[i] + Delemeter;
    end;

    //文字配列の最後の要素
    Result := Result + AStrings[high(AStrings)];

    //最後にデリミターを付加する場合
    if AddLastDelemeter then
    begin
      Result := Result + Delemeter;
    end;

  end;
end;

でテストコードはこんな感じ。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  StrUtils,Types, VbLikeStringUtil;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  JoinItems : TStringDynArray;
begin


  SetLength(JoinItems,5);

  JoinItems[0] := 'イージス';
  JoinItems[1] := 'ジャスティス';
  JoinItems[2] := 'ザク';
  JoinItems[3] := 'セイバー';
  JoinItems[4] := 'グフ';

  Assert('イージス|ジャスティス|ザク|セイバー|グフ'=JoinString(JoinItems,'|'));

  Label1.Caption := JoinString(JoinItems,'|');



end;

procedure TForm1.Button2Click(Sender: TObject);
begin

  //空配列の場合は空文字を返す
  Assert(''=JoinString([],'|'));

  //通常の場合
  Assert('ミリアリア|キラ|メイリン|バルトフェルド'
     = JoinString(['ミリアリア','キラ','メイリン','バルトフェルド'],'|'));

  //オプションの第３引数にTrueを指定すると文字列の最後にデリミタを付加します。
  Assert('ミリアリア|キラ|メイリン|バルトフェルド|'
     = JoinString(['ミリアリア','キラ','メイリン','バルトフェルド'],'|',true));

  Label1.Caption := JoinString(['ミリアリア','キラ','メイリン','バルトフェルド'],'|',true);
end;

end.

ちなみに、今回の文字列は、Seedの自分の好きなキャラシリーズです。

JoinStringはないの？

VB6のJoin関数および.Net FrameworkのString.Joinメソッドは、
XEで追加されたほどSplitString使用頻度は多くないがたまに必要に
なることがある。

Help,ソースをざっくり見たところなさそうだったので実装してみた。
（といっても文字列を連結しただけですが・・・)

以下、ソースコード

unit VbLikeStringUtil;

interface

uses
  StrUtils,Types;

  function JoinString(AStrings: TStringDynArray; Delemeter : String) : String;

implementation

uses
  SysUtils;

function JoinString(AStrings: TStringDynArray; Delemeter : String) : String;
var
  i : Longint;
begin

  Result := '';
  for i := low(AStrings) to high(AStrings) do
  begin
    Result := Result + AStrings[i];
    if i < high(AStrings) then Result := Result + Delemeter;
  end;


end;

end.

実際の使用方法のサンプルは、こんな感じ

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  StrUtils,Types, VbLikeStringUtil;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  JoinItems : TStringDynArray;
begin


  SetLength(JoinItems,5);

  JoinItems[0] := 'イージス';
  JoinItems[1] := 'ジャスティス';
  JoinItems[2] := 'ザク';
  JoinItems[3] := 'セイバー';
  JoinItems[4] := 'グフ';


  Label1.Caption := JoinString(JoinItems,'|');


end;

end.

SplitStringを試してみる。

Delphi XEでSplitString関数が追加された。VBにあって、Delphiになかった関数で
個人的には気になってた関数です。（欲しかった関数です。）

で、ちょっとためしてみた。

以下、ソースコード

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  StrUtils,Types;

procedure TForm1.Button1Click(Sender: TObject);
var
  TestString : String;
  SplitResult:TStringDynArray;
begin
  TestString := 'フリーダム,ジャスティス,デストロイ,セイバー';
  SplitResult := SplitString(TestString,',');
  Label1.Caption := TestString;

  for TestString in SplitResult do begin
    ListBox1.Items.Add(TestString);
  end;

end;

end.

Visual Basicライクで非常に簡単に使えます。

内部的には、FindDelimiter関数を使ってDelemeterをみつけ
Copy関数で部分文字列を切り出してます。

これなら、下位バージョンでも実装できそうですね。

ところでFindDelimiter関数は、いつから存在したのでしょうか？
個人的には、Delphiにはまだまだ知らない便利な関数が一杯ありそうです。


2010.09.10 山本隆の開発日記で紹介して頂いたので
調子にのってC++ Builderで書いてみました。
(C++は自信がないので、役に立つかどうかわかりませんが・・・)

//---------------------------------------------------------------------------

#include 
#include 
#pragma hdrstop

#include "Unit1.h"
//---------------------------------------------------------------------------
#pragma package(smart_init)
#pragma resource "*.dfm"
TForm1 *Form1;
//---------------------------------------------------------------------------
__fastcall TForm1::TForm1(TComponent* Owner)
 : TForm(Owner)
{

}
//---------------------------------------------------------------------------
void __fastcall TForm1::Button1Click(TObject *Sender)
{

 UnicodeString TestString = "イージス|バスター|デュエル|ブリッツ|ストライク";

 LabeledEdit1->Text = TestString;

 TStringDynArray SplitResult = SplitString(TestString,"|");

 for (int i = 0; i < SplitResult.Length; i ++) {
  ListBox1->Items->Add(SplitResult[i]);
 }

 SplitResult.set_length(0);

}
//---------------------------------------------------------------------------