Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2008年10月08日] [更新 2013年03月13日] Delphi サンプルプログラム集
   
002_アプリケーションの起動時間を測定・計測
動作確認等 Windows 7 U64(SP1) + Delphi XE Pro
002_AppStartTime.zip [1,185 KB] 2013年03月13日版(EXE同梱)



  • 2008年10月16日
  • Junki さんのマイクロ秒ストップウォッチのコードを追加
  • 2008年11月24日
  • コンボボックスの選択イベントを OnCloseUp から OnSelect に変更
    コンボボックス内フォーカスで,キーボードで上下操作,ホイールマウス上下操作による項目選択した場合に,Edit1 に結果が反映されなかった
  • 20013年03月12日
  • [01] DLL を使用しない,単なる CreateProcess による起動のサンプルに変更
  • [02] 起動したプロセスの全てが生成完了するまで待つコードに変更
  • 起動するアプリのパス名をファイルから読み出す方式に変更




アプリケーションの起動時間を測定・計測


BDS 2005 が登場した時に,起動に非常に時間かかかりました.そこで,実際にはどのくらい時間がかかるのかを計測するために作成したものです.CreateProcess 関数あるいは ShellExecuteEx 関数でアプリケーションを起動する参考コードぐらいに思ってください.
測定結果は,小数点以下 3 桁まで,つまり,ミリセコンドまで表示するようになっています.時間計測用のストップウォッチとして,Junkiさんが作成した マイクロ秒ストップウォッチのコードを利用しています.

アプリケーションの起動を検出するだけであれば,他にも方法があります.以下のリンクを参考にしてください.





01_CreateProcessを使用


CreateProcess 関数を使用してアプリを起動する例です.

Windows Vista 以降では,CreateProcess 関数は,自分自身より権限の高いアプリケーションは起動できません.例えば,システムフォルダ内や Program Files 内のプログラムがこれに該当します.これを回避するには,CreateProcess 関数を管理者権限で実行します.すると,起動したアプリケーションも同じレベルで実行されます.

このサンプルは,起動したプロセスのオーナーウィンドウが表示状態になるまで永久に待つようにし,それまでの時間を計測するようにしています.

起動するアプリケーションの指定は,次のように,アプリケーションのフルパスを起動オプション付きで,ApplicationFullPathList.txt というファイルに保存しておきます.
実行時に,このファイルからこのテキストを読みだして,コンボボックスに格納します.


リスト1
起動するアプリのフルパスをおさめたファイル ApplicationFullPathList.txt を用意する
"%ProgramFiles%\Borland\Delphi5\Bin\delphi32.exe"
"%ProgramFiles%\Borland\Delphi6\Bin\delphi32.exe"
"%ProgramFiles%\Borland\Delphi7\Bin\delphi32.exe"
"%ProgramFiles%\Borland\BDS\3.0\bin\bds.exe" /pDelphi
"%ProgramFiles%\Borland\BDS\4.0\bin\bds.exe" /pDelphi
"%ProgramFiles%\CodeGear\RAD Studio\5.0\bin\bds.exe" /pDelphi
"%ProgramFiles%\CodeGear\RAD Studio\6.0\bin\bds.exe" /pDelphi
"%ProgramFiles%\Embarcadero\RAD Studio\7.0\bin\bds.exe" /pDelphi
"%ProgramFiles%\Embarcadero\RAD Studio\8.0\bin\bds.exe" /pDelphi
"%ProgramFiles%\Embarcadero\RAD Studio\9.0\bin\bds.exe" /pDelphi
"%ProgramFiles%\Embarcadero\RAD Studio\10.0\bin\bds.exe" /pDelphi
"%ProgramFiles%\Microsoft Office\Office12\WINWORD.EXE"
"%ProgramFiles%\Microsoft Office\Office12\EXCEL.EXE"


サンプルプロジェクトには,アプリケーションマニフェストを組み込んでいます.したがって,EXE 起動時に,次のような,管理者への昇格ダイアログが表示されます.


図1
管理者への昇格ダイアログ
  • システムフォルダ内や Program Files 内のプログラムの起動が可能となる

設計時のフォームと実行結果の例です.
実際に計測してみると,Delphi の IDE の場合,IDE が完全に表示される前に計測が終了してしまっています.新規にプロジェクトを作成して,メインフォームが Visible になる時間と,完全表示された状態に時間差があるのと同じなのかも知れません.

そこで,[目視ストップ] をチェックしておけば,[スタート] ボタンで起動後,[ストップ] ボタンをクリックして,目で確認して計測できるようにしてみました.


図2
設計時画面
  • 5 回まで測定可能
  • [目視ストップ] をチェックすれば目視での計測ができる
図3
実行例
  • Delphi 2007 の計測結果
  • IDE の表示前に計測が終了してしまっている

リスト2
CreateProcess を使用してアプリの起動にかかる時間を測定
unit AppStartUpTimeUnit;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 StdCtrls, Buttons, ComCtrls, Dialogs, ExtCtrls, plJStopWatch;

type
 TAppStartUpTimeForm = class(TForm)
    Button3: TButton;
    ComboBox1: TComboBox;
    Button1: TButton;
    Button2: TButton;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    CheckBox1: TCheckBox;
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Select(Sender: TObject);
 protected
   procedure DisplayTime(i : Integer; msTime: Extended);
 private
   { Private declarations }
   strExePath  : String;
   TryCount    : Integer;
   MaxCount    : Integer;
   AStopWatch  : TplJStopWatch;
 public
   { Public declarations }
 end;

var
 AppStartUpTimeForm: TAppStartUpTimeForm;

implementation

{$R *.DFM}

//-----------------------------------------------------------------------------
//  起動アプリのウィンドウハンドル取得のためのコールバック関数
//
//  検査条件
//  プロセスIDの値が一致している
//  トップレベルのウィンドウである(オーナーを持たない)
//  可視状態である
//-----------------------------------------------------------------------------
function EnumTopWindow(hTopWnd: HWND; lp: LPARAM): BOOL; stdcall;
var
  p         : LPDWORD;
  ProcessId : DWORD;
begin
  Result := True;

  GetWindowThreadProcessId(hTopWnd, @ProcessId);
  p := LPDWORD(lp);
  if (ProcessId = p^) and (GetWindow(hTopWnd, GW_OWNER) = 0)
                      and IsWindowVisible(hTopWnd) then begin
    p^ := hTopWnd;
    Result := False;
  end;
end;

//-----------------------------------------------------------------------------
//  アプリの起動(CreateProcess使用)
//-----------------------------------------------------------------------------
function WinExecAndWait32(FileName: String; Visibility: Integer): HWND;
var
  StartupInfo : TStartupInfo;
  ProcessInfo : TProcessInformation;
  Ret         : Cardinal;
  dwID        : DWORD;
begin
  Result:= 0;

  FillChar(StartupInfo, SizeOf(StartupInfo), #0);
  StartupInfo.cb          := SizeOf(StartupInfo);
  StartupInfo.dwFlags     := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := Visibility;

  //参照カウンタ対策
  UniqueString(FileName);
  if not CreateProcess(
      nil,
      PChar(FileName),      // pointer to command line string
      nil,                  // pointer to process security attributes
      nil,                  // pointer to thread security attributes
      False,                // handle inheritance flag
      CREATE_NEW_CONSOLE or // creation flags
      NORMAL_PRIORITY_CLASS,
      nil,                  //pointer to new environment block
      nil,                  // pointer to current directory name
      StartupInfo,          // pointer to STARTUPINFO
      ProcessInfo           // pointer to PROCESS_INF
      ) then begin
    //起動に失敗したら終了
    exit;
  end else begin
    //起動開始まで待つ
    repeat
      Ret := WaitForInputIdle(ProcessInfo.hProcess, 50);
      Application.ProcessMessages;
    until Ret <> WAIT_TIMEOUT;

    //プロセスIDに相当するウィンドウが表示状態になるまでループ
    //起動したので,必ずウィンドウハンドルは見つかるハズ
    //表示しないアプリの場合は永久ループになるので注意
    //EnumWindowsの第2引数にウィンドウハンドルが戻ってくる
    if Ret = 0 then begin
      while True do begin
        Sleep(100);
        dwID := ProcessInfo.dwProcessId;
        EnumWindows(@EnumTopWindow, LPARAM(@dwID));
        if dwID <> ProcessInfo.dwProcessId then begin
          Result := dwID;
          break;
        end;
        Application.ProcessMessages;
      end;  
    end;

    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
  end;
end;

//=============================================================================
//  フォーム生成時の処理
//  起動に要する時間の測定にはTplJStopWatch(同梱)を使用
//  計測時間の表示にはTPanelを使用
//=============================================================================
procedure TAppStartUpTimeForm.FormCreate(Sender: TObject);
var
  SL : TStringList;
begin
  //測定結果等の表示クリア
  Button3Click(nil);

  //ストップウォッチ生成
  AStopWatch := TplJStopWatch.Create(Self);

  //ファイルから起動するアプリのフルパスを格納したテキストを取得
  SL := TStringList.Create;
  try
    SL.LoadFromFile('ApplicationFullPathList.txt');
    ComboBox1.Items.Assign(SL);
    ComboBox1.DropDownCount := SL.Count;
  finally
    FreeAndNil(SL);
  end;
end;

//=============================================================================
//  [スタート]ボタン
//  アプリを起動
//  コンボボックスのテキストが起動するアプリのフルパス(起動オプションも含む)
//=============================================================================
procedure TAppStartUpTimeForm.Button1Click(Sender: TObject);

  //---------------------------------------------------------------------------
  //  環境変数を含んだパス名を,実際のパス名に変換する関数
  //---------------------------------------------------------------------------
  function ExpandEnvironmentString(S: String): String;
  var
    DstChar : array [0..MAX_PATH - 1] of Char;
  begin
    ExpandEnvironmentStrings(PChar(S), DstChar, MAX_PATH);
    Result := DstChar;
  end;
  //---------------------------------------------------------------------------

var
  Ret   : THandle;
  ATime : Extended;
begin
  Button1.Enabled := False;

  //最大測定数を超えたら測定継続不可
  if TryCount >= MaxCount then begin
    Button1.Enabled := False;
    Button2.Enabled := False;
    MessageBox(Handle,
               '最大測定回数を超えました.結果をクリアして下さい.',
               '回数制限',
               MB_ICONASTERISK);
    exit;
  end;
  inc(TryCount);

  Button2.Enabled := CheckBox1.Checked;
  if ComboBox1.Text <> '' then begin
    //アプリの情報をセット
    strExePath  := ComboBox1.Text;

    //計測開始
    AStopWatch.Start;

    //環境変数を含んだパス名を実際のパス名に変換
    strExePath := ExpandEnvironmentString(strExePath);
    Ret := WinExecAndWait32(PChar(strExePath), SW_SHOWNORMAL);

    if Ret = 0 then begin
      Button1.Enabled := True;
      Button2.Enabled := False;
      Button3.Enabled := True;
      MessageBox(Handle, '起動に失敗しました.', '起動失敗', MB_ICONASTERISK);
    end else begin
      //CheckBox1.Checkedの場合は[ストップ]をクリックするまで計測を継続
      if not CheckBox1.Checked then begin
        ATime := AStopWatch.Stop;
        DisplayTime(TryCount, ATime);
      end;
    end;
  end;
end;

//=============================================================================
//  [ストップ]ボタン
//  ストップウォッチを強制停止
//=============================================================================
procedure TAppStartUpTimeForm.Button2Click(Sender: TObject);
var
  ATime : Extended;
begin
  if AStopWatch <> nil then begin
    ATime := AStopWatch.Stop;
    DisplayTime(TryCount, ATime);
  end;
end;

//=============================================================================
//  [クリア]ボタン
//  ストップウォッチの表示をクリア
//=============================================================================
procedure TAppStartUpTimeForm.Button3Click(Sender: TObject);
begin
  //測定結果の表示クリア
  Panel1.Caption := '';
  Panel2.Caption := '';
  Panel3.Caption := '';
  Panel4.Caption := '';
  Panel5.Caption := '';

  Button1.Enabled := True;
  Button2.Enabled := False;

  //測定回数をクリア
  TryCount := 0;
  //5回まで定可能とする.これはFormに配置した計測時間表示用TPanelの数と同じ
  MaxCount := 5;
end;

//=============================================================================
//  TComboBoxのOnSelectイベント処理
//  ComboBoxのアイテムを変更したら結果の表示をクリア
//=============================================================================
procedure TAppStartUpTimeForm.ComboBox1Select(Sender: TObject);
begin
  Button3Click(nil);
end;

//=============================================================================
//  引数の値に応じた時間を小数点以下3桁の秒単位で表示
//  つまり1/1000秒(ミリセコンド)まで表示
//  TplStopWatchの返値はミリセコンド
//=============================================================================
procedure TAppStartUpTimeForm.DisplayTime(i: Integer; msTime: Extended);
var
  APanel : TPanel;
begin
  //表示対象のi番目のTPanelを検出
  APanel := FindComponent('Panel' + IntToStr(i)) as TPanel;
  APanel.Caption := Format('%5.3f ', [msTime / 1000.0]);

  //計測ボタンを使用可能に
  Button1.Enabled := True;
  Button2.Enabled := False;
  Button3.Enabled := True;
end;

end.




02_ShellExecuteExを使用


上のサンプルでは,Delphi の IDE のようなアプリでは,実際に感じる起動時間とは差があることがわかりました.
そこで,Delphi 2009 が起動時にどのくらいのオブジェクトを生成するのかを調べてみました.下のリストがその結果です.ウィンドウハンドルを持つコントロールたけを検出しています. これを見ると,Delphi の IDE そのものも Delphi で出来ていることが分かります.


リスト3
Windows 7 U64(SP1) で Delphi 2009 Pro 版を起動した時に生成されるウィンドウのリスト
468 のウィンドウを生成している
OleMainThreadWndClass
TPUtilWindow
IME
TApplication
GDI+ Hook Window Class
TPUtilWindow
IME
TPUtilWindow
TPUtilWindow
TForm
CicMarshalWndClass
MSCTFIME UI
{DB9300A3-B9FD-4BB4-830D-53CFD9BEC5B6}.message
OleMainThreadWndClass
TfrmITESearchForm
TPageControl
TTabSheet
TPanel
TITEHistoryComboBox
ComboLBox
Edit
TTabSheet
TPanel
TITEHistoryComboBox
ComboLBox
Edit
TGroupBox
TPanel
TPanel
TCheckListBox
TfrmITESearchResults
TITEListBox
TfrmSelectFontDlg
TListView
SysHeader32
Edit
tooltips_class32
Edit
TAppBuilder
CLIPBRDWNDCLASS
TPUtilWindow
TPUtilWindow
TControlBar
TActionMainMenuBar
TPUtilWindow
TStructureViewForm
TStructureViewForm
TVirtualStringTree
TDockToolBar
TTRepositoryForm
TTRepositoryForm
TRepositoryFrame
TITEToolBar
TPageScroller
TToolBar
TRepositoryFrame
TToolBar
TPUtilWindow
TITERepositoryGrid
TITERepositoryGrid
TStatusBar
TPropertyInspector
TPropertyInspector
TPanel
TListButton
TPopupListBox
TPUtilWindow
TPUtilWindow
THTMLDesignerCommands
THTMLDesignerCommands
TToolBar
TComboBoxEx
ComboBox
ComboLBox
Edit
Auto-Suggest Dropdown
SysListView32
SysHeader32
Edit
tooltips_class32
ScrollBar
ScrollBar
TComboBoxEx
ComboBox
ComboLBox
Edit
Auto-Suggest Dropdown
SysListView32
SysHeader32
Edit
tooltips_class32
ScrollBar
ScrollBar
TPUtilWindow
TPUtilWindow
TToolBar
TToolBar
TToolBar
TDockToolBar
TDockToolBar
TDockToolBar
OleDdeWndClass
TFindReferencesForm
TFindReferencesForm
TRefactoringForm
TRefactoringForm
TObjectTreeView
TObjectTreeView
TPUtilWindow
TTreeView
tooltips_class32
TToolBar
TPUtilWindow
WindowsForms10.Window.8.app.0.e4c6c4
WindowsForms10.Window.8.app.0.e4c6c4
WindowsForms10.Window.8.app.0.e4c6c4
TDockToolBar
TTemplateView
TTemplateView
TPanel
TVirtualStringTree
TToolBar
TPUtilWindow
WorkerW
TPUtilWindow
TDockToolBar
TToolForm
TToolForm
TCategoriesPopup
TIDECategoryButtons
TToolBar
TPanel
TButtonedEdit
TEditButton.TGlyph
TDockToolBar
TProjectManagerForm
TProjectManagerForm
TProjectManagerForm
TToolBar
TPUtilWindow
TDockToolBar
TDesktopComboBox
ComboLBox
Edit
TComboBoxEx
ComboBox
ComboLBox
Edit
TComboBoxEx
ComboBox
ComboLBox
Edit
TComboBoxEx
ComboBox
ComboLBox
Edit
TComboBoxEx
ComboBox
ComboLBox
Edit
TComboBoxEx
ComboBox
ComboLBox
Edit
TComboBoxEx
ComboBox
ComboLBox
Edit
DDEMLMom
DDEMLEvent
TTabDockHostForm
TTabDockHostForm
TTabDockHostForm
TPUtilWindow
TTabDockHostForm
TTabDockHostForm
TTabDockHostForm
TPUtilWindow
TEditWindow
TPUtilWindow
TPUtilWindow
TPUtilWindow
TPUtilWindow
TPUtilWindow
TPUtilWindow
TEditWindow
TPUtilWindow
TPUtilWindow
TPUtilWindow
TFileHistoryFrame
TPageControl
TTabSheet
TEditControl
TTabSheet
TEditControl
TPUtilWindow
TPUtilWindow
TPUtilWindow
TPUtilWindow
TPUtilWindow
TPUtilWindow
TPUtilWindow
TPUtilWindow
THTMLViewFrame
TControlBar
TDockToolBar
TDockToolBar
TDockToolBar
TDockToolBar
TComboBoxEx
ComboBox
ComboLBox
Edit
TComboBoxEx
ComboBox
ComboLBox
Edit
TComboBoxEx
ComboBox
ComboLBox
Edit
TComboBoxEx
ComboBox
ComboLBox
Edit
TComboBoxEx
ComboBox
ComboLBox
Edit
TComboBoxEx
ComboBox
ComboLBox
Edit
TMessageViewForm
TMessageViewForm
TPUtilWindow
TPanel
TPanel
TPanel
TStatusBar
TEditorDockableForm
TEditorDockableForm
TPUtilWindow
TPUtilWindow
TIDECategoryButtons
TToolBar
TAppBuilder
TStructureViewForm
TVirtualStringTree
TToolForm
TIDECategoryButtons
TToolBar
TPanel
TButtonedEdit
TEditButton.TGlyph
TTRepositoryForm
TPropertyInspector
TFindReferencesForm
TRefactoringForm
TTemplateView
TProjectManagerForm
TTabDockHostForm
TTabDockHostForm
TEditWindow
TPanel
TPanel
TPanel
TStatusBar
TMessageViewForm
TEditorDockableForm
TControlBar
TDockToolBar
TActionMainMenuBar
TDockToolBar
TDockToolBar
TDockToolBar
TDesktopComboBox
ComboLBox
Edit
TDockToolBar
TDockToolBar
TDockToolBar
TEditorDockPanel
TIDECategoryButtons
TToolBar
TToolForm
TIDECategoryButtons
TToolBar
TPanel
TButtonedEdit
TEditButton.TGlyph
TDebugLogView
TDebugLogView
TDebugLogView
TStringGrid
TThreadStatus
TThreadStatus
TLocalVarsWindow
TLocalVarsWindow
TCallStackWindow
TCallStackWindow
TCallStackWindow
TWatchWindow
TWatchWindow
TPUtilWindow
TWatchWindow
TFileExplorerForm
TFileExplorerForm
TPopupExplorerDropDown
TPopupExplorerTree
TOwnerDrawScrollbar
TPopupAutoCompleteDropDown
TPopupAutoCompleteTree
TPanel
TVirtualExplorerCombobox
TComboEdit.UnicodeClass
TVirtualExplorerTreeview
TPUtilWindow
vstVirtualNotifyWndClass
IME
WorkerW
TToDoListWindow
TToDoListWindow
TToDoListWindow
TTDStringGrid
TDataExplorer
TDataExplorer
TModelView
TModelView
TClassBrowser
TClassBrowser
TToolBar
TPropertyInspector
TPanel
TListButton
TStatusBar
TPanel
TInspListBox
TPropSelection
TPropInspEdit
TListButton
TDescriptionPane
THotCommands
TBPWindow
TBPWindow
TBPWindow
TToolBar
TEditWindow
TPanel
TPanel
TPanel
TStatusBar
TEditorDockPanel
TEditorDockPanel
TEditorDockPanel
TIDEDockTabSet
TIDEDockTabSet
TIDEDockTabSet
TEditorDockPanel
TPanel
TPanel
TEditorDockPanel
TPanel
TPanel
TPanel
TIDEGradientTabSet
TPanel
TPanel
TTabSet
TStructureViewForm
TVirtualStringTree
TTabDockHostForm
TPanel
TTabSet
TPanel
TProjectManagerForm
TToolBar
TVirtualStringTree
TPanel
TModelView
TPanel
TDataExplorer
TStructureViewForm
TVirtualStringTree
TTabDockHostForm
TPanel
TPanel
TRefactoringForm
TPanel
TFindReferencesForm
TDockToolBar
TDockToolBar
TDockToolBar
TDockToolBar
TDockToolBar
TDockToolBar
TDockToolBar
TDesktopComboBox
ComboLBox
Edit
TDockToolBar
TDesktopComboBox
ComboLBox
Edit
TDockToolBar
TDockToolBar
TActionMainMenuBar
TDockToolBar
TDockToolBar
TDockToolBar
TDockToolBar
TDockToolBar
TDockToolBar
TDockToolBar
TDockToolBar
TDockToolBar
TDockToolBar
TDockToolBar
TDockToolBar
TDockToolBar
TInspListBox
TPropSelection
TPropInspEdit
TListButton
TWelcomePageFrame
TToolBar
THistoryPropComboBox
ComboLBox
Edit
TWelcomePageFrame
TToolBar
THistoryPropComboBox
ComboLBox
Edit
Shell Embedding
TClosableTabScroller
Shell DocObject View
URL Moniker Notification Window
Internet Explorer_Hidden
TTemplateView
TMessageViewForm
TEditorDockableForm
TDebugLogView
TStringGrid
TThreadStatus
TLocalVarsWindow
TCallStackWindow
TWatchWindow
TFileExplorerForm
TToDoListWindow
TClassBrowser
TBPWindow
.NET-BroadcastEventWindow.2.0.0.0.e4c6c4.0
TForm1
TGrabHandle
TGrabHandle
TGrabHandle
TGrabHandle
TGrabHandle
TGrabHandle
TGrabHandle
TGrabHandle
TEditControl
TEditorStatusControlForm
TToolBar
TCodeEditorTabControl
Internet Explorer_Server
TToolBar


上のサンプルでは,トップウィンドウの表示を検出した時点で起動完了としましたが,このサンプルでは,全てのウィンドウの生成が終了するまでの時間を計測することにします.
ウィンドウの生成が全て終了したというメッセージはありません.そこで,ウィンドウが生成される度に時刻を取得して経過時間を表示します.そして,ある一定時間経過しても生成のメッセージが来なければ起動完了とすることにします.

他のプロセスのメッセージを受信するわけですから,グローバルフックが必要です.
ここでは,[270_ウインドウの生成を知る WH_CBTフック] でも使用している WH_CBT フックを使用しています.DLL から HCBT_CREATEWND を受け取った時にウィンドウの生成とします.

[待ち時間 (秒)] の設定を設けています.次のウィンドウの生成に時間がかかるような場合,この値を大きくします.この時間内に次のウィンドウ生成メッセージが届かない場合は起動完了とみなすことにします.この待ち時間は,最初のトップレベルのウィンドウの検出の時間は含まれません.その後のウィンドウが生成される時間間隔のことです.

多くのアプリケーションは,閉じる時にも何らかのウインドを生成して処理しています.Delphi も例外ではありません.したがって,起動終了を目で確認しても,この時間内に閉じてしまうと,時間が加算されます.辛抱強くお待ちください.急ぐ場合は [ストップ] ボタンをクリックしてください.

折角ですので,このサンプルでは ShellExecuteEx 関数を使用することにします.
アプリケーションのパス名は,上のサンプルと同じく,ApplicationFullPathList.txt という名前のテキストファイルに保存しておきます.
起動オプションは,上のサンプルと同じく,コンボボックスで項目を選択すると,分解して Edit1 に表示します.この Edit1 の値を起動オプションにしてアプリを起動します.コンポボックスに表示されている起動オプションは,アプリ起動開始前に自動で削除するようにしています.



  • 図4
  • 設計時画面

CreateProcess 関数と同じく ShellExecuteEx でも管理者に昇格してアプリを起動します.そうしないと失敗する場合があります.そこで,上のサンプルと同じく,アブケーションマニフェストをプロジェクトに組み込んでいます.EXE を起動すると以下のようなダイアログが現れます.

また,メッセージの送受信は,ドラッグ・アンド・ドロップ同様,ユーザーインターフェイス特権の分離 (UIPI) の影響を受けますが,管理者に昇格することで,このサンプルから起動するアプリケーションも同じ権限レベルで起動することになり,DLL からのメッセージの受信が可能となります.

ただし,このサンプルでは 32 ビット版の DLL を使用しています.したがって,64 ビットのアプリケーションの起動は検出できません.また,ShellExecute 関数実行時にタイムラグを設けています.起動時間が短いアプリケーションの起動時間も計測できません.



図5
管理者への昇格ダイアログ
  • システムフォルダ内や Program Files 内のプログラムの起動が可能となる
  • メッセージの受信も可能となる

筆者の環境で,Delphi XE3 を起動した結果です.1 番目の値は,コンピュータの起動直後に測定しています.起動時間がかなり長くなっています.
Delphi の IDE の場合,スプラッシュ表示までと,スプラッシュの次のウィンドウ生成に時間がかかるようです.待ち時間をある程度長くしておかないと途中で計測が終了してしまいます.


  • 図6
  • Delphi XE3 の起動時間を測定した結果の例
  • ここでは 10 秒以上次のウィンドウの生成メッセージがない場合,起動完了とみなす設定
  • Delphi の場合,初回起動時には,待ち時間を 10 〜 15 秒程度にしておけばいいようである

マイクロソフト・ワードを起動して測定した結果例です.
マイクロソフト・ワードの場合,実際には,1 秒以内にウィンドウが表示されています.したがって,表示後に何かしらの内部処理をしていることになります.測定結果の数値が,完全に全てのウィンドウの生成が終了した時間ということになります.
事実,ワード起動直後に,マウスカーソルが砂時計になっていることがあります.体感的な起動時間の測定であれば,待ち時間は 2 秒もあれば十分かも知れません.


  • 図7
  • マイクロソフト・ワードの起動時間を測定した結果

リスト4
ShellExecuteEx を使用してアプリの起動にかかる時間を測定
unit AppStartUpTimeUnit;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 StdCtrls, Buttons, ComCtrls, Dialogs, ExtCtrls, ShellAPI, plJStopWatch, Spin;

type
 TAppStartUpTimeForm = class(TForm)
    Button3: TButton;
    ComboBox1: TComboBox;
    Button1: TButton;
    Button2: TButton;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    Edit1: TEdit;
    CheckBox1: TCheckBox;
    Timer1: TTimer;
    SpinEdit1: TSpinEdit;
    Label1: TLabel;
    procedure FormDestroy(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Select(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
 protected
   procedure WndProc(var msg: TMessage);override;
   procedure DisplayTime(i : Integer; msTime: Extended);
 private
   { Private declarations }
   AStopWatch   : TplJStopWatch;
   TryCount     : Integer;
   MaxCount     : Integer;
   StartExeTime : Extended;
   StopExeTime  : Extended;
 public
   { Public declarations }
 end;

var
  AppStartUpTimeForm: TAppStartUpTimeForm;

implementation

uses ShLwApi;

{$R *.DFM}

function StartCBTHook(Wnd: HWND): Boolean; stdcall; external 'PLHOOKCBT.DLL';
procedure StopCBTHook; stdcall; external 'PLHOOKCBT.DLL';
function  GetHookMsgString:PChar;stdcall; external 'PLHOOKCBT.DLL';

var
  hHookLib    : THANDLE;
  HookMessage : String;
  MsgHooking  : WORD;

//-----------------------------------------------------------------------------
//  起動アプリのウィンドウハンドル取得のためのコールバック関数
//
//  検査条件
//  プロセスIDの値が一致している
//  トップレベルのウィンドウである(オーナーを持たない)
//  可視状態である
//-----------------------------------------------------------------------------
function EnumTopWindow(hTopWnd: HWND; lp: LPARAM): BOOL; stdcall;
var
  p         : LPDWORD;
  ProcessId : DWORD;
begin
  Result := True;

  GetWindowThreadProcessId(hTopWnd, @ProcessId);
  p := LPDWORD(lp);
  if (ProcessId = p^) and (GetWindow(hTopWnd, GW_OWNER) = 0)
                      and IsWindowVisible(hTopWnd) then begin
    p^ := hTopWnd;
    Result := False;
  end;
end;

//-----------------------------------------------------------------------------
//  アプリの起動用(ShellExecuteEx使用)
//  戻り値は起動したウインドウのハンドル
//  失敗した場合は0を返す
//
//  ShellExecuteExの使用にはusesにShellAPIが必要
//-----------------------------------------------------------------------------
function RunExeFile(hWnd: HWND; AFile: String; AParameters: String): Cardinal;
var
  AInfo      : TShellExecuteInfo;
  Ret        : DWORD;
  dwIDOrigin : DWORD;
  dwID       : DWORD;
begin
  Result := 0;

  FillChar(AInfo, SizeOf(AInfo), #0);
  AInfo.cbSize := SizeOf(AInfo);
  AInfo.Wnd    := hWnd;
  AInfo.fMask  := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_NO_UI;

  //WindowsのバージョンがVista以上の場合
  //runsを指定すると,アプリ起動の際に管理者への昇格ダイアログが表示される
  if CheckWin32Version(6, 0) then begin
    AInfo.lpVerb := 'runas';
  end else begin
    AInfo.lpVerb := 'Open';
  end;

  AInfo.lpFile       := PChar(AFile);
  AInfo.lpParameters := PChar(AParameters);
  AInfo.nShow        := SW_SHOWNORMAL;

  ShellExecuteEx(@AInfo);

  //ShellExecuteExは成功するとhInstAppにERROR_SHARING_VIOLATIONを超える値を返す
  if AInfo.hInstApp > ERROR_SHARING_VIOLATION then begin
    //起動まで待つための処理
    repeat
      Ret := WaitForInputIdle(AInfo.hProcess, 50);
      Application.ProcessMessages;
    until Ret <> WAIT_TIMEOUT;
    //プロセスIDを取得
    dwIDOrigin := GetProcessId(AInfo.hProcess);

    //プロセスIDに相当するウィンドウが表示状態になるまでループ
    //起動したので,必ずウィンドウハンドルは見つかるハズ
    //表示しないアプリの場合は永久ループになるので注意
    //EnumWindowsの第2引数にウィンドウハンドルが戻ってくる
    if Ret = 0 then begin
      while True do begin
        Sleep(100);
        dwID := dwIDOrigin;
        EnumWindows(@EnumTopWindow, LPARAM(@dwID));
        if dwID <> dwIDOrigin then begin
          Result := dwID;
          break;
        end;
        Application.ProcessMessages;
      end;
    end;
  end;

  CloseHandle(AInfo.hProcess)
end;

//=============================================================================
//  フォーム生成時の処理
//  起動に要する時間の測定にはTplJStopWatch(同梱)を使用
//  計測時間の表示にはTPanelを使用
//=============================================================================
procedure TAppStartUpTimeForm.FormCreate(Sender: TObject);
var
  SL : TStringList;
begin
  //測定結果等の表示クリア
  Button3Click(nil);
  Edit1.Text := '';

  //ストップウォッチ生成
  AStopWatch := TplJStopWatch.Create(Self);
  //その他の初期化
  Timer1.Enabled := False;
  SpinEdit1.MinValue := 1;
  SpinEdit1.MaxValue := 200;
  SpinEdit1.Value    := 5;

  //ファイルから起動するアプリのフルパスを格納したテキストを取得
  SL := TStringList.Create;
  try
    SL.LoadFromFile('ApplicationFullPathList.txt');
    ComboBox1.Items.Assign(SL);
    ComboBox1.DropDownCount := SL.Count;
  finally
    FreeAndNil(SL);
  end;

  //DLLのロード
  if hHookLib = 0 then begin
    hHookLib := LoadLibrary('plHookCBT.dll');
  end;
end;

//=============================================================================
//  本Form破棄の時にはフックを解除
//=============================================================================
procedure TAppStartUpTimeForm.FormDestroy(Sender: TObject);
begin
  StopCBTHook;
  if hHookLib <> 0 then FreeLibrary(hHookLib);
end;

//=============================================================================
//  [スタート]ボタン
//  アプリを起動
//  コンボボックスのテキストが起動するアプリの実行ファイル名
//  Edit1.Textは起動時のオプション
//=============================================================================
procedure TAppStartUpTimeForm.Button1Click(Sender: TObject);

  //---------------------------------------------------------------------------
  //  環境変数を含んだパス名を,実際のパス名に変換する関数
  //---------------------------------------------------------------------------
  function ExpandEnvironmentString(S: String): String;
  var
    DstChar : array [0..MAX_PATH - 1] of Char;
  begin
    ExpandEnvironmentStrings(PChar(S), DstChar, MAX_PATH);
    Result := DstChar;
  end;
  //---------------------------------------------------------------------------

var
  Ret         : Cardinal;
  ExeFullPath : String;
begin
  Button1.Enabled := False;

  //最大測定数を超えたら測定継続不可
  if TryCount >= MaxCount then begin
    Button1.Enabled := False;
    Button2.Enabled := False;
    MessageBox(Handle,
               '最大測定回数を超えました.結果をクリアして下さい.',
               '回数制限',
               MB_ICONASTERISK);
    exit;
  end;

  if ComboBox1.Text <> '' then begin

    //計測開始
    StartExeTime := AStopWatch.Start;

    //ComboBoxの文字列から実行ファイル名だけを取得
    ExeFullPath := ComboBox1.Text;
    ShLwApi.PathRemoveArgs(PChar(ExeFullPath));

    //環境変数を含んだパス名を実際のパス名に変換
    ExeFullPath := ExpandEnvironmentString(ExeFullPath);

    //独立して起動するので第1引数は0とする
    Ret := RunExeFile(0, ExeFullPath, Trim(Edit1.Text));

    if Ret <= ERROR_SHARING_VIOLATION then begin
      Button1.Enabled := True;
      Button2.Enabled := False;
      Button3.Enabled := True;
      //SysErrorMessage(GetLastError);
      MessageBox(Handle, '起動に失敗しました.', '起動失敗', MB_ICONASTERISK);
    end else begin
      //オーナーウィンドウが起動したのでフック開始
      //フック用のメッセージを登録
      StartCBTHook(Handle);
      HookMessage := GetHookMsgString;
      MsgHooking  := RegisterWindowMessage(PChar(HookMessage));

      //タイマー等をセット
      StopExeTime     := AStopWatch.Time;
      Timer1.Interval := 100;
      Timer1.Enabled  := True;

      Button2.Enabled := True;
      Button3.Enabled := False;
      inc(TryCount);
    end;
  end;
end;

//=============================================================================
//  [ストップ]ボタン
//  ストップウォッチを強制停止
//  自動計測の場合は計測時間の表示は変わらない
//=============================================================================
procedure TAppStartUpTimeForm.Button2Click(Sender: TObject);
var
  ATime : Extended;
begin
  StopCBTHook;
  Timer1.Enabled := False;

  if AStopWatch <> nil then begin
    if CheckBox1.Checked then begin
      ATime := AStopWatch.Time;
      DisplayTime(TryCount, ATime);
    end;

    //計測ボタンを使用可能に
    Button1.Enabled := True;
    Button2.Enabled := False;
    Button3.Enabled := True;
  end;
end;

//=============================================================================
//  [クリア]ボタン
//  ストップウォッチの表示をクリア
//=============================================================================
procedure TAppStartUpTimeForm.Button3Click(Sender: TObject);
begin
  //測定結果の表示クリア
  Panel1.Caption := '';
  Panel2.Caption := '';
  Panel3.Caption := '';
  Panel4.Caption := '';
  Panel5.Caption := '';

  Button1.Enabled := True;
  Button2.Enabled := False;

  //測定回数をクリア
  TryCount := 0;
  //5回まで定可能とする.これはFormに配置した計測時間表示用TPanelの数と同じ
  MaxCount := 5;
end;

//=============================================================================
//  TComboBoxのOnSelectイベント処理
//
//  ComboBoxのアイテムを変更したら
//  Edit1に機動オプションの文字列をセット
//=============================================================================
procedure TAppStartUpTimeForm.ComboBox1Select(Sender: TObject);
begin
  Button3Click(nil);

  //文字列からコマンドラインオプションだけを取り出して表示
  Edit1.Text := ShLwApi.PathGetArgs(PChar(ComboBox1.Text));
end;

//=============================================================================
//  TTimerのOnTimerイベント処理
//
//  最後に検出したウィンドウの生成時刻から一定時間経過したら起動終了とみなす
//  アプリによっては,起動中に停止のような状態が長く続くことがある
//  その場合は検出の時間をTSpinEditの値で調整する
//=============================================================================
procedure TAppStartUpTimeForm.Timer1Timer(Sender: TObject);
begin
  //手動計測の場合
  if CheckBox1.Checked then exit;

  if ((AStopWatch.Time - StopExeTime) > (SpinEdit1.Value * 1000)) then begin
    StopCBTHook;
    Timer1.Enabled := False;

    //計測ボタンを使用可能に
    Button1.Enabled := True;
    Button2.Enabled := False;
    Button3.Enabled := True;
  end;
end;

//=============================================================================
//  引数の値の時刻から計測時間を小数点以下3桁の秒単位で表示
//  つまり1/1000秒(ミリセコンド)まで表示
//  TplStopWatchの返値はミリセコンド
//=============================================================================
procedure TAppStartUpTimeForm.DisplayTime(i: Integer; msTime: Extended);
var
  APanel : TPanel;
begin
  //起動開始時刻を引き算
  msTime := msTime - StartExeTime;
  //表示対象のi番目のTPanelを検出してそこに表示
  APanel := FindComponent('Panel' + IntToStr(i)) as TPanel;
  APanel.Caption := Format('%5.3f ', [msTime / 1000.0]);
end;

//=============================================================================
//  DLLからメッセージ通知を受取る
//  ここではフォームのWndProcメソッドを使用
//  Delphiの場合,IDEを閉じる時もHCBT_CREATEWNDメッセージが発生するので注意
//=============================================================================
procedure TAppStartUpTimeForm.WndProc(var msg: TMessage);
begin
  inherited WndProc(msg);
  if not Self.Visible then exit;

  //plHookCBT.dllからHCBT_CREATEWNDメッセージが届いたことを意味する
  if msg.Msg = MsgHooking then begin
    StopExeTime := AStopWatch.Time;
    DisplayTime(TryCount, StopExeTime);
  end;
end;

end.


アプリケーションマニフェストを使用しない場合,Windows Vista 以降では,ShellExecuteEx でアプリケーションを起動しようとすると,下図のようなダイアログを表示します.


図8
昇格ダイアログ
  • デジタル署名を取得しているアプリケーションの場合
  • Delphi では,起動環境の OS に対応しているバージョンの場合
図9
昇格ダイアログ
  • デジタル署名のないアプリの場合
  • Delphi では,起動環境の OS に対応していないバージョンの場合




03_マイクロ秒ストップウォッチのコード


Junki さんのサイト (めもニャンだむ) の該当コードは,現在掲載されていません.そこで,ここにそのコードを転載しておきます.このコードで使用している QueryPerformanceCounter 関数を使用したコンポーネント [29 万年まで計測可能なマイクロ秒ストップウォッチ] が公開されています.これも参考になるでしょう.

Delphi 2010 の Diagnostics ユニットには,TStopWatch (レコード型) を使用したストップウォッチが追加されています.これも QueryPerformanceCounter 関数を使用しています.



リスト5
マイクロ秒ストップウォッチ
unit plJStopWatch;

interface

uses
  Windows, Classes;

type
TplJStopWatch = class(TComponent)
private
  FFrequency : int64;
  FStart     : int64;
  FStop      : int64;
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  function Start: extended;
  function Stop: extended;
  function Time: extended;
end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('plXRAY', [TplJStopWatch]);
end;

constructor TplJStopWatch.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  QueryPerformanceFrequency(FFrequency);
end;

destructor TplJStopWatch.Destroy;
begin

  inherited;
end;

function TplJStopWatch.Start: extended;
begin
  QueryPerformanceCounter(FStart);
  result := FStart * 1000 / FFrequency;
end;

function TplJStopWatch.Stop: extended;
begin
  QueryPerformanceCounter(FStop);
  result := (FStop - FStart) * 1000 / FFrequency;
end;

function TplJStopWatch.Time: extended;
var
    V : Int64;
begin
  QueryPerformanceCounter(V);
  result := V * 1000 / FFrequency;
end;

end.