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


が参考になります。

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

VBスクリプトを動かす（動画付き）

先日、ツイッターでMicrosoft Scriptコントロールの話題がでたのでDelphiでMicrosoft Scriptコントロールを
使うサンプルを作ってみた。

Microsoft ScriptコントールをDelphiに取り込む必要がある。

Microsoft Scriptコントール取り込むには、コンポーネントの取り込みを選択し

ActiveXコントールの取り込みを選択する。

（ここでタイプライブラリの取り込みを選択するとクラスがつくられないみたい
なので要注意）

コントロールの一覧からMicroSoft Scriptコントロールを選択する。

あとは、画面の支持にしたがってファイルを作成し、Microsoft Scriptコントールを
組み込みたいプロジェクトに読み込む。

ここから、実際につくったサンプル。

サンプルは、

1) a,b二つの引数を持つVBSのＦＵＮＣＴＩＯＮプロシージャを実行する。
  2) VBSはメモコンポーネントに記述する。
3) メモコンポーネントに記述したFUNCTIONのリストをListBoxに表示する。
4) ListBoxから選んだFUNCTIONを実行し結果をラベルに表示する。

とゆうものです。

以下、ソースファイル

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    スクリプトを登録: TButton;
    ListBox1: TListBox;
    選択した関数を実行: TButton;
    実行結果: TLabel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure スクリプトを登録Click(Sender: TObject);
    procedure 選択した関数を実行Click(Sender: TObject);
  private
    { Private 宣言 }
    FScriptControl:TScriptControl;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ActiveX,VarUtils;

{$R *.dfm}

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

procedure TForm1.FormCreate(Sender: TObject);
begin
  FScriptControl := TScriptControl.Create(Self);
  {Jscriptを使用するときは、'VBSCRIPT'を'JScript'に変更する。}
  FScriptControl.Language := 'VBSCRIPT';
end;

procedure TForm1.スクリプトを登録Click(Sender: TObject);
var
  i : Integer;
begin

  ListBox1.Clear;
  
　{Scriptコントロールにコードを追加}
　FScriptControl.AddCode(WideString(Memo1.Text));

  {プロシージャコレクションを操作することでプロシージャーのリストを得る}
  for i := 0  to FScriptControl.Procedures.Count -1 do
  begin

    {VB(VB6,VBA)用のCOMのコレクションは1基数のものが多いので注意}
    ListBox1.Items.Add(FScriptControl.Procedures.Item[i+1].Name);
  end;

end;
procedure TForm1.選択した関数を実行Click(Sender: TObject);
var
  ResultStr : OleVariant;
  ParamArray : Variant;
  PParamArray : PVarArray;
  MyParams : PIntegerArray;
begin
  
  {パラメータはヴァリアント型の配列で渡す必要がある}
  ParamArray := VarArrayCreate([0, 1], varVariant);
  ParamArray[0] := 3;
  ParamArray[1] := 5;
  
  PParamArray := VarArrayAsPSafeArray(ParamArray);
  ResultStr := FScriptControl.Run(WideString(ListBox1.Items[ListBox1.ItemIndex]),
                              PSafeArray(PParamArray));
  Label2.Caption := VarToStr(ResultStr);

end;

end.

以下、コントロールの取り込みと上記プログラムを実行しているところのデモ動画