DelphiでCreateOleObjecteにより起動したExcelが終了しないケースがあるかと思う。
くろねこの自宅ではExcel 2010を使用中であるが、幸いなことながらExcelが正常動作している際にはこのケースに遭遇したことは無い。しかしながら、勤務先のExcel 2003ではExcelの参照をもっている変数に対してunassignedを代入してもプロセスが解放されないと言うことが発生している。
このような際には、処理終了後Delphiの方からExcelプロセスの強制終了が必要になるかもしれない。
今回はこのようなときに役立つ処理を作成した。
また、この処理はハングアップした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. コメント (0件)