DelphiでExcelブック内のシート一覧を取得し表示する(dbGo経由)

前のブログで、ExcelのTypeライブラリーを使ってシート一覧を取得しましたが
ついでといっては、なんですが、dbGo(Ado)を使って、シート一覧を取得してみます。

TAdoQueryを使ってSQL文で、テーブル一覧を取得できないか、ちょっと調べたましたが
無理そうだったので、ここでは、

TADOConnection.OpenSchema (
 　　　　　　　 const Schema: TSchemaInfo;  
　　　　　　　　const Restrictions: OleVariant;
　　　　　　　  const SchemaID: OleVariant;
                 DataSet: TADODataSet);

メソッドを使ってテーブルを取得します。

方法は、簡単で、

OpenSchema関数のパラメータ

　　　　　Schemaに　TSchemaInfo.siTables
　　　　　DataSetに　スキーマ取得結果の書き込み先のレコードセットを指定します。

　　　　　 
　　　　　また、今回は、RestrictionsとSchemaIDは使用しませんのでEmptyParamを指定します。


さて、やってみます。

フォームにTADOConnectionを配置し、ConnectionStringの

　　　ProviderにMicrosoft.ACE.OLEDB.12.0
　　　Data SourceにExcelのワークブックのパス
　　　Extended PropertiesにExcel 12.0(Excel2010の場合)

を指定します。

（ConnectionStringについては、http://connectionstrings.com/ が参考になります。)


次に結果格納先としての TADODataSetコンポーネントを配置し、Connectionプロパティに
上記の TADOConnectionコンポーネントを指定します。

あとは、通常の操作で、DataSource,DbGridを配置し、それぞれ接続します。

あとはボタンなどを配置しそのイベントハンドラに

  ADOConnection1.Connected := true;
  ADOConnection1.OpenSchema(siTables, EmptyParam, EmptyParam,ADODataSet1);
 
のようなコードを書きます。

で実行すれば、

のように結果が得られます（右側)

 
 
なお、torry's Delphiのページにもうちょっと詳しいサンプルがあります。http://www.swissdelphicenter.ch/torry/showcode.php?id=1433

また、AdoでのExcelのSchema,については、MSのHELP
http://support.microsoft.com/kb/257819/ja


が参考になります。

DelphiでExcelブック内のシート一覧を取得し表示する

先日、DelphiでExcelのWorkSheetを列挙しながらSheetを編集する処理を作成したとき、
思いもよらずはまったので、自分メモとして保存。

DelphiからExcelを操作する方法としては、

1. Excelのタイプライブラリーをインポート
2. dbGoを使用する
3. サードパーティのコンポーネントを使用する
4. ・・・

などの方法があげらるが、

今回は、1.タイプタイプライブラリーをインポートしてExcelを操作しシート名を一覧表示する
処理をつかった。

以下、ソース

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Excel_TLB,System.Win.ComObj;
const
  LCID = LOCALE_SYSTEM_DEFAULT;


procedure TForm1.Button1Click(Sender: TObject);
Var
  ExcelApp : Excel_TLB.ExcelApplication;
  ExcelBook : Excel_TLB.ExcelWorkbook;
  ExcelSheet : Excel_TLB.ExcelWorksheet;
  BookPath : String;
  i : integer;
begin
  ListBox1.Clear;
  ExcelApp := CreateComObject(CLASS_ExcelApplication) as ExcelApplication;
  ExcelApp.DisplayAlerts[LCID] := false;

  BookPath := IncludeTrailingPathDelimiter(ExtractFileDir(Application.ExeName)) + 'Test.xlsx';

  ExcelBook := ExcelApp.Workbooks.Add(BookPath, LCID);

  (* このように書きたいが
  　 'GetEnumerator' のメンバが含まれていないかアクセスできないため）
      通常では使用不可　　　
  for  ExcelSheet in  ExcelBook.Worksheets do
  begin
     ListBox1.Items.Add(ExcelSheet.Name);
  end;
  *)


  // Excelのコレクションは1基数なので1からカウントを始める。
  for i := 1 to ExcelBook.Worksheets.Count do
  begin
    ExcelSheet := ExcelBook.Worksheets.Item[i] As  Excel_TLB.ExcelWorksheet;
    ListBox1.Items.Add(ExcelSheet.Name);
  end;

  ExcelSheet := nil;
  ExcelBook.Close(false,BookPath,false,LCID);
  ExcelBook := nil;

  if Assigned(ExcelApp) then
  begin
    ExcelApp.Quit;
    ExcelApp := nil;
  end;


end;

end. 

for　～　in doの構文が使えると、基数のこと意識しなくても良いが、コンパイルすると

 E2431 for-in ステートメントはコレクション型 'Sheets' で動作できません（'Sheets' に 'GetEnumerator' のメンバが含まれていないかアクセスできないため）

のメッセージが、出てEXEが作れないため、従来のfor文で列挙している。

  Excelのコレクションが1基数なので、for 文は、1からシート数まででにしていのが
 ポイントです。（ポイントというもののものではありませんが・・・）

 まあ、Excelに限らず、Win32版のVisual Basic(VB6,VB5)とか、VBAのコレクションInterface
 は基本1基数なのですが・・・

 下図のようなブックに対して

 上のような処理を実行すると

 のような結果がえられます。


以下は、余談ですが、

自分 、Excelのコレクションが1基数だということをすっかり忘れていて、結果、午前中つぶしちゃいました。

Unified Interbaseコンポーネントをつかってみた（番外編:Delphi Xe2で使う）

Unified Interbaseのリポジトリには、Delphi Xe2用のパッケージ(プロジェクト）がありますので

Unified InterbaseのコンポーネントはDelphi Xe2にインストール可能です。

Xe２のバージョン管理リポジトリから開く機能を使って
としてソースをダウンロードし、
ダウンロード先、packagesフォルダから、UIBD16Win32.groupprojを開いて
ビルドすればインストールできます。

インストールしたコンポーネントは、

な感じになります。（64ビットもサポートされたてます。）

あとは、Unified Interbaseコンポーネントをつかってみた（その1)と同様にして
Firebirdと接続が可能です。

LiveBindingを試してみる。

DelphiXE2のLiveBindingの機能を使って、現在時刻を更新する処理を

チュートリアルを参考作ってみた。

処理としては、時刻が更新されると、登録した通知先（作った例場合はフォーム）の

表示を更新する処理になっています。

以下ソース

まずは、時計のソース、タイマーを使って定周期で時刻を更新し、登録先の

更新通知を行っています。

また、変更通知先を登録する処理を書いています。

unit Unit4;

interface

uses
 System.SysUtils, System.Classes,Vcl.ExtCtrls, Data.Bind.EngExt,
 Vcl.Bind.DBEngExt, System.Rtti, System.Bindings.Outputs, Vcl.Bind.Editors,
 Data.Bind.Components,
 System.Bindings.EvalProtocol,
 System.Bindings.Expression,
 System.Bindings.ObjEval,
 System.Bindings.Helper;

type
 TDataModule4 = class(TDataModule)
   FTimer: TTimer;
   procedure FTimerTimer(Sender: TObject);
   procedure DataModuleCreate(Sender: TObject);
   procedure DataModuleDestroy(Sender: TObject);
 private
   { Private 宣言 }
   FNowString : String;
   BindingExpression1: TBindingExpression;
 public
   procedure AddBindingList(const InputScopes: array of IScope; const BindExprStr: string; const OutputScopes: array of IScope; const OutputExpr: string);
   published
   { Public 宣言 }
   property NowString : String read FNowString;
 end;

var
 DataModule4: TDataModule4;

implementation

{%CLASSGROUP 'Vcl.Controls.TControl'}

uses Unit1;

{$R *.dfm}

procedure TDataModule4.AddBindingList(const InputScopes: array of IScope;
 const BindExprStr: string; const OutputScopes: array of IScope;
 const OutputExpr: string);
begin

 BindingExpression1 :=  TBindings.CreateManagedBinding(
       InputScopes,
       BindExprStr,
       OutputScopes,
       OutputExpr,
       nil);

end;

procedure TDataModule4.DataModuleCreate(Sender: TObject);
begin
 //BindScope1.Active := true;
end;

procedure TDataModule4.DataModuleDestroy(Sender: TObject);
begin
 //BindScope1.Active := false;
end;

procedure TDataModule4.FTimerTimer(Sender: TObject);
begin
 FNowString := DateTimeToStr(Now);
 TBindings.Notify(Self, 'NowString');

end;

end.

次に、時計を表示するソース。比較のためにポーリング処理で上記のソースのプロパティを使って
タイムスタンプを更新する処理もあります。

unit Unit1;

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,
 Data.Bind.EngExt, Vcl.Bind.DBEngExt, System.Rtti, System.Bindings.Outputs,
 Unit4,
 System.Bindings.Expression,
 System.Bindings.ObjEval,
 System.Bindings.Helper,
 Vcl.Bind.Editors, Data.Bind.Components;


type
 TForm1 = class(TForm)
   Label1: TLabel;
   Label3: TLabel;
   Timer1: TTimer;
   Label2: TLabel;
   Label4: TLabel;
   procedure Timer1Timer(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
 private
   { Private 宣言 }
   FSakaClock : TDataModule4;
 public
   { Public 宣言 }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 //FSakaClock.Free;
 FSakaClock.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 FSakaClock := TDataModule4.Create(Self);
 FSakaClock.AddBindingList(
      { inputs }
     [TBindings.CreateAssociationScope([
       Associate(FSakaClock, 'I1')
     ])],
     'I1.NowString',
     { outputs }
     [TBindings.CreateAssociationScope([
       Associate(Label3, 'O1')
     ])],
     'O1.Caption');

 //FSakaClock := TSakaClock.Create(Self);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 Label1.Caption := FSakaClock.NowString;
end;

end.

CPUのコア数を数える。

Delphiのドキュメントによれば、System.CPUCount変数を参照すればCPUのコア数が
表示できるようだ。

たとえば、

Label1.Caption := IntToStr(System.CpuCount)

でラベルにCPUのコア数が表示できる。

自分のPCで試したけど、シングルコアのCPUなので

当然のことながら1と表示された。

指定したウインドウを最前面にもってくる

VBAから指定したアプリが起動してない場合は起動し、既に起動済みの場合は、最前面に持ってくる
という処理が必要になったので、Delphiで作成してみた。

以下、指定したアプリを前面に持ってくるサンプル。

procedure TForm1.Button1Click(Sender: TObject);
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation
Uses JclSysInfo;

{$R *.dfm}
function AllowSetForegroundWindow(dwProcessID: Cardinal): BOOL; stdcall; external 'user32.DLL';


procedure TForm1.Button1Click(Sender: TObject);
var
  ProcessList : TStringList;
  i : Integer;
  Pid : Cardinal;
  Wnd: THandle;
begin

  ProcessList := TStringList.Create;
  try
    //起動するアプリは、自前のものではないので
    //プロセスがいるかどうかは、プロセスのリストを総当りで
    //確認
    JclsysInfo.RunningProcessesList(ProcessList,true);
    i := -1;
    ProcessList.Find(LabeledEdit1.Text,i);
    if i >= 0 then
    begin
      Pid := GetPidFromProcessName(ProcessList.Strings[i]);
      Wnd :=GetMainAppWndFromPid(Pid);
      //いつぞやのバージョンのwindowsから前面に出す許可を
      //しておくことが必要
      AllowSetForegroundWindow(Pid);
      //最小化されているのでアイコンからもとのサイズに
      //戻す
      if IsIconic(Wnd) then
      begin
        OpenIcon(Wnd);
      end
      else
      begin
        //指定したウインドウを前面に
        SetForegroundWindow(wnd);
        //場合によっては、AttachThreadInputで
        //前面に出したいウインドのスレッドにあタッチが必要
      end;
    end;

  finally
  　ProcessList.Free;
　　end;
end;

end.

プロセスリストを表示する（その２）

Project jediのJclのJclSysInfoユニットにある。RunningProcessesList関数を使用すると
プロセスリストが簡単にとれます。

以下、サンプル

procedure TForm1.Button1Click(Sender: TObject);
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation
Uses JclSysInfo;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
　ProcessList : TStringList;
  i : Integer;
  Pid : Cardinal;

begin
　ListBox1.Clear;
  ProcessList := TStringList.Create;
  try
　　JclsysInfo.RunningProcessesList(ProcessList,true);
    for i := 0 to ProcessList.Count-1 do
    begin
      Pid := GetPidFromProcessName(ProcessList.Strings[i]);
      ListBox1.Items.Add('(' + IntToStr(Pid) + ')' + ProcessList.Strings[i]);
    end;

  finally
  　ProcessList.Free;
  end;

end;

RunningProcessesListは、引数で指定したTStringsを継承した型インスタンスに
プロセスのリストを返してくれます。

このJclSysInfoユニット、ざっと見た感じで、便利そうなものが一杯あった。
サンプルプログラムを元にもうチョットみてみよう。