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.

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.

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.