DelphiでCreateOleObjecteにより起動したExcelが終了しないケースがあるかと思う。
くろねこの自宅ではExcel 2010を使用中であるが、幸いなことながらExcelが正常動作している際にはこのケースに遭遇したことは無い。しかしながら、勤務先のExcel 2003ではExcelの参照をもっている変数に対してunassignedを代入してもプロセスが解放されないと言うことが発生している。

このような際には、処理終了後Delphiの方からExcelプロセスの強制終了が必要になるかもしれない。
今回はこのようなときに役立つ処理を作成した。

また、この処理はハングアップしたExcelプロセスを強制終了する際にも役に立つだろう。
通常、ハングアプリケーションの明確な定義ない。しかし、通常ハングアップという状態では、該当のプロセスはいくつかの処理が"ビジー"になっていて、ユーザーから見た際に応答を停止している状態であると思われる。

次の処理は、アプリケーションがまだ一定時間で応答する際には通常に処理を実行しているとみなし、そうで無い場合にはハングアップしていると見なすこととした。

1. LaunchボタンはExcelプロセスを作成し起動する。
2. CheckボタンはExcelプロセスの実行を確認する。
3. TermボタンはExcelプロセスを通常に終了させようと試みる。
   ただし、この行為が失敗した場合には、強制終了を行う。

unit UXlsOpenTerm;

interface

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

type
  TForm1 = class(TForm)
    btnLaunch: TButton;
    btnCheck: TButton;
    btnKill: TButton;
    procedure btnLaunchClick(Sender: TObject);
    procedure btnCheckClick(Sender: TObject);
    procedure btnTermClick(Sender: TObject);
  private
  public
    FXls: OLEVariant;
    FXlshWnd: THandle;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  Variants;

procedure TForm1.btnLaunchClick(Sender: TObject);
begin
  FXls := CreateOleObject('Excel.Application');
  FXls.Visible := true;
  FXls.WorkBooks.Add;
  FXls.WorkBooks.Close;
  FXlshWnd := FXls.hwnd;
end;

procedure TForm1.btnCheckClick(Sender: TObject);
var
  nRes: DWORD;
  nRet: longint;
begin
  nRet := SendMessageTimeout(FXlshWnd, WM_NULL, 0, 0,
    SMTO_ABORTIFHUNG OR SMTO_BLOCK, 1000, nRes);
  if (nRet > 0) then
    ShowMessage('正常処理中!!')
  else
    ShowMessage('返事がない、ただの屍のようだ...');
end;

procedure TForm1.btnTermClick(Sender: TObject);
var
  ProcessID: DWORD;
  Process: THandle;
  nRes: DWORD;
  nRet: longint;
begin
  GetWindowThreadProcessId(FXlshWnd, @ProcessID);
  FXls.Quit;
  FXls := unassigned;

  nRet := SendMessageTimeout(FXlshWnd, WM_NULL, 0, 0,
    SMTO_ABORTIFHUNG or SMTO_BLOCK, 1000, nRes);
  if (nRet > 0) then
  begin
    Process := OpenProcess(PROCESS_ALL_ACCESS, false, ProcessID);
    TerminateProcess(Process, 0);
  end;
end;

end.