Если включить в настройках сервиса галочку "Разрешить взаимодействие с рабочим столом" и сделать окно Word видимым, то причина зависания проясняется: Word что-то сообщил пользователю и ждет нажатия кнопки. Процесс Word работает на невидимом рабочем столе, так что ответить ему никто никогда не сможет.
Причины появления сообщений об ошибках могут быть самыми разными - при гигантском разнообразии конвертируемых документов без ошибок не обойтись. Остается только периодически удалять ручками такие зависшие процессы. Но конечно же, лучше этот процесс автоматизировать.
Имеются два очевидных варианта автоматизации:
- Периодически проходить по списку процессов, определять время запуска каждого
windord.exeи вычислять длительность его работы. Если процесс работает слишком долго, завершать его. - Отслеживать время выполнения операции конвертирования. Если время выполнения операции превышает допустимое, находить и уничтожать соответствующий
winword.exe.
winword.exe будут успешно уничтожаться. Но в таком решении не все гладко:- Если процессы
winword.exeпроверять слишком часто, мы напрасно снизим производительность системы. Если слишком редко, количество зависших процессов может стать недопустимо большим. Дело в том, что в редких случаях зависаниеwinword.exeприводит к лавинному эффекту, когда каждый последующий запущенныйwinword.exeзависает .. и сервис валится - Нет возможности выполнить какие-либо действия непосредственно в момент подвисания (запись в лог, отправка сообщения на email, что угодно).
winword.exe, запущенный потоком, и принудительно его завершим. Но здесь есть две проблемы.
- Не ясно, как определить, какой именно
winword.exeбыл запущен нашим потоком. На самом деле, для конкретногоwinword.exeмы не только не можем определить родительский поток, но даже родительский процесс. Точнее, процесс то мы найдем, но это будетsvchost.exe, а вовсе не наш процесс - все потому, что мы имеем дело с сервисом, а не с обычным приложением. - Поток может благополучно завершится (мы не получим сообщение о таймауте), а процесс
winword.exeостанется висеть навсегда.
Word.Application можно помещать в заголовок окна Word некую уникальную строку. Например, GUID или путь к конвертируемому документу. В случае, если winword.exe зависнет, его можно будет найти по этой строке - достаточно будет перебрать все процессы winword.exe, в каждом перебрать все окна и проверить заголовок каждого окна на наличие этой уникальной строки. А вот вторая проблема, похоже, не решается никак. Так что на практике придется либо ограничится первым методом и смириться с его ограничениями, либо использовать оба метода: те зависания, которые можно отловить немедленно - отлавливать немедленно, плюс изредка проводить "сборку мусора".
Практическая реализация
Для своих целей я реализовал оба метода в модуле ProcessKiller.pas. В нем реализованы две функции для поиска и уничтожения зависших процессов:FindAndKillProcessByPid- находит и уничтожает все процессыwinword.exe, которые работают слишком долго.FindAndKillProcessByWindow- находит и уничтожает все процессыwinword.exe, содержащие окно с заданной строкой в заголовке.
//найти и уничтожить все процессы //у которых имя exe файла совпадает с processExeFileName //и которые созданы более чем timeOutMs миллисекунд назад function FindAndKillProcessByPid( const processExeFileName: String; const timeOutMs: Integer) : Integer; //возвращает количество уничтоженных процессов //найти и уничтожить все процессы //у которых имя exe файла совпадает с processExeFileName //и у которых имеется окно, содержащее в заголовке //строку strCaption function FindAndKillProcessByWindow( const processExeFileName: String; const strCaption: String): Integer;На практике функций, принимающих константы, скорее всего будет недостаточно. Нужна возможность варьировать критерии поиска "зависшего процесса", определения нужного exe-файла и нужного окна. Например, имена exe-файлов и уникальные строки могут задаваться списками; или может потребоваться уничтожить процесс, если он занимает слишком много памяти/CPU и т.д. На этот случай в ProcessKiller.pas, имеется другие варианты тех же функций
FindAndKillProcessByWindow и FindAndKillProcessByWindow, которые в качестве параметров вместо констант принимают функторы.Там же объявлена пара классов, с помощью которых можно определить функторы со стандартным поведением. Для удобства, привожу текст модуля ProcessKiller целиком.
unit ProcessKiller;
interface
uses Windows, SysUtils, Classes, tlhelp32, Messages;
type
tmatch_functor = function (srcName: PWideChar): Boolean of object;
pmatch_functor = ^tmatch_functor;
tpid_matcher_functor = function (srcPid: LongInt): Boolean of object;
ppid_matcher_functor = ^tpid_matcher_functor;
//finds process matched to fMatchExeName
//enumerates windows in the process and finds one with captionString in its title bar
//if window is found then the function kills the process
function FindAndKillProcessByWindow(
fMatchExeName: tmatch_functor; //selects process by exe filename
fMatchWindowCaption: tmatch_functor //selects window by window caption
): Integer; overload;//returns count killed processes
//finds process matched to fMatchExeName
//checks its start time. If process is outdated then kills it.
function FindAndKillProcessByPid(fMatchExeName: tmatch_functor; //selects process by exe filename
fMatchPid: tpid_matcher_functor //check PID and decide if process should be killed
): Integer; overload;//returns count killed processes
//**** simplified (and not flexible) versions of same functions
function FindAndKillProcessByPid(
const processExeFileName: String;
const timeOutMs: Integer)
: Integer; overload;
function FindAndKillProcessByWindow(
const processExeFileName: String;
const strCaption: String)
: Integer; overload;
type
//**** a couple of simple matchers to implement
//simplified versions of FindAndKillProcessByPid and FindAndKillProcessByWindow
TMatcher = class
public
constructor Create(const sample: String);
function EqualToI(srcName: PWideChar): Boolean;
function EndWithI(srcName: PWideChar): Boolean;
private
m_Sample: String;
end;
TPidOutdatedMatcher = class
public
constructor Create(intervalMS: Integer);
function IsOutdated(srcPid: LongInt): Boolean;
private
m_IntervalMS: Integer;
end;
//**** auxiliary functions:
//find all processes with exe file names that match to search criteria
procedure GetListProcesses(fMatchExeName: tmatch_functor; dest: TStringList);
//find all windows in specified process which captions match to search criteria
function FindWindowInProcess(const processId: Cardinal; fMatchWindowCaption: tmatch_functor): Boolean;
//kill specified process
procedure KillProcess(const processId: Cardinal);
implementation
procedure GetListProcesses(fMatchExeName: tmatch_functor; dest: TStringList);
var handle: THandle;
ProcStruct: PROCESSENTRY32; // from "tlhelp32" in uses clause
begin
handle := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
if handle <> 0 then try
ProcStruct.dwSize := sizeof(PROCESSENTRY32);
if Process32First(handle, ProcStruct) then repeat
if fMatchExeName(PWideChar(@ProcStruct.szExeFile)) then begin
dest.AddObject('', Pointer(ProcStruct.th32ProcessID));
end;
until not Process32Next(handle, ProcStruct);
finally
CloseHandle(handle);
end;
end;
function FindAndKillProcessByPid(fMatchExeName: tmatch_functor; fMatchPid: tpid_matcher_functor): Integer;
var list: TStringList;
i: Integer;
pid: Cardinal;
begin
Result := 0;
list := TStringList.Create;
try
GetListProcesses(fMatchExeName, list);
for i := 0 to list.Count - 1 do begin
pid := Cardinal(list.Objects[i]);
if fMatchPid(pid) then begin
KillProcess(pid);
inc(Result);
end;
end;
finally
list.Free;
end;
end;
function FindAndKillProcessByWindow(fMatchExeName: tmatch_functor; fMatchWindowCaption: tmatch_functor): Integer;
var list: TStringList;
i: Integer;
pid: Cardinal;
begin
Result := 0;
list := TStringList.Create;
try
GetListProcesses(fMatchExeName, list);
for i := 0 to list.Count - 1 do begin
pid := Cardinal(list.Objects[i]);
if FindWindowInProcess(pid, fMatchWindowCaption) then begin
KillProcess(pid);
inc(Result);
end;
end;
finally
list.Free;
end;
end;
type
wrapper = record //helper class to pass functor to enum_window_proc
m_F: tmatch_functor;
end;
pwrapper = ^wrapper;
function enum_window_proc(hWnd: HWND; lparam: LPARAM): BOOL; stdcall;
var buffer: String;
begin
SetLength(buffer, MAX_PATH);
Result := true;
if SendMessage(hWnd, WM_GETTEXT, MAX_PATH, Integer(@buffer[1])) <> 0 then begin
if pwrapper(lparam)^.m_F(@buffer[1]) then Result := false;
end;
end;
function FindWindowInProcess(const processId: Cardinal; fMatchWindowCaption: tmatch_functor): Boolean;
var snap_proc_handle: THandle;
next_proc: Boolean;
thread_entry: TThreadEntry32;
w: wrapper;
begin
w.m_F := fMatchWindowCaption;
Result := false;
snap_proc_handle := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0); //enumerate all threads
if (snap_proc_handle <> INVALID_HANDLE_VALUE) then try
thread_entry.dwSize := SizeOf(thread_entry);
next_proc := Thread32First(snap_proc_handle, thread_entry);
while next_proc do begin
if thread_entry.th32OwnerProcessID = processId then begin //check the owner Pid against the PID requested
if not EnumThreadWindows(thread_entry.th32ThreadID, @enum_window_proc, LPARAM(@w)) then begin
Result := true;
break;
end;
end;
next_proc := Thread32Next(snap_proc_handle, thread_entry);
end;
finally
CloseHandle(snap_proc_handle);
end;
end;
procedure KillProcess(const processId: Cardinal);
var nerror: Integer;
process: THandle;
fdwExit: DWORD;
begin //see http://stackoverflow.com/questions/4690472/error-invalid-handle-on-terminateprocess-vs-c
process := OpenProcess(PROCESS_TERMINATE, TRUE, processId);
fdwExit := 0;
GetExitCodeProcess(process, fdwExit);
if not TerminateProcess(process, fdwExit) then begin
nerror := GetLastError;
end;
CloseHandle(process);
end;
{ TMatcher }
constructor TMatcher.Create(const sample: String);
begin
m_Sample := sample;
end;
function TMatcher.EndWithI(srcName: PWideChar): Boolean;
var
len: Integer;
len_sample: Integer;
pw: PWideChar;
begin
Result := false;
len_sample := Length(m_Sample);
len := lstrlen(srcName);
if (len >= len_sample) then begin
pw := PWideChar(@srcName[len - len_sample]);
if lstrcmpi(pw, PWideChar(m_Sample)) = 0 then begin
Result := true;
end;
end;
end;
function TMatcher.EqualToI(srcName: PWideChar): Boolean;
begin
Result := lstrcmpi(srcName, PWideChar(m_Sample)) = 0;
end;
{ TPidOutdatedMatcher }
constructor TPidOutdatedMatcher.Create(intervalMS: Integer);
begin
m_IntervalMS := intervalMS;
end;
function TPidOutdatedMatcher.IsOutdated(srcPid: Integer): Boolean;
var tc, te, tk, tu, current: FILETIME;
u0, u1: ULARGE_INTEGER;
process: THandle;
st: SYSTEMTIME;
begin
Result := false;
process := OpenProcess(PROCESS_ALL_ACCESS, TRUE, srcPid);
try
if GetProcessTimes(process, tc, te, tk, tu) then begin
FileTimeToSystemTime(tc, st);
GetSystemTimeAsFileTime(current);
FileTimeToSystemTime(current, st);
u1.LowPart := current.dwLowDateTime;
u1.HighPart := current.dwHighDateTime;
u0.LowPart := tc.dwLowDateTime;
u0.HighPart := tc.dwHighDateTime;
if (u1.QuadPart - u0.QuadPart) / 10000 > m_IntervalMS then Result := true;
end;
finally
CloseHandle(process);
end;
end;
function FindAndKillProcessByPid(const processExeFileName: String; const timeOutMs: Integer): Integer;
var
me: TMatcher;
md: ProcessKiller.TPidOutdatedMatcher;
begin
md := nil;
me := TMatcher.Create(processExeFileName);
try
md := TPidOutdatedMatcher.Create(timeOutMs);
ProcessKiller.FindAndKillProcessByPid(me.EqualToI, md.IsOutdated);
finally
md.Free;
me.Free;
end;
end;
function FindAndKillProcessByWindow(const processExeFileName: String; const strCaption: String): Integer;
var
me: TMatcher;
ms: TMatcher;
begin
ms := nil;
me := TMatcher.Create(processExeFileName);
try
ms := TMatcher.Create(strCaption);
ProcessKiller.FindAndKillProcessByWindow(me.EqualToI, ms.EndWithI);
finally
me.Free;
ms.Free;
end;
end;
end.
Демонстрационное приложение WordKiller
Проверить работоспособность модуля ProcessKiller.pas можно с помощью тестового приложения WordKiller.Это сервис, способный выполнять две задачи.
- С заданной периодичностью проверять список процессов и уничтожать процессы, которые работают слишком долго (первый метод). Имя exe-файла процесса, интервал запуска и максимально допустимый период работы процессов задаются в конфигурационном файле
WordKiller.ini - С заданной периодичностью запускать Word, открывать в нем тестовый документ, а затем находить и уничтожать открытый процесс
winword.exeс помощьюFindAndKillProcessByWindow(второй метод).
WordKiller.ini.Чтобы установить сервис нужно выполнить команду
WordKiller.exe /install, чтобы деинсталлировать - WordKiller.exe /uninstall.Если вы найдете ошибку в приложении - буду признателен, если сообщите о ней в комментариях.
Исходные коды
Скачать исходные коды проекта WordKiller.Просмотреть online исходные коды WordKiller.
не компилится проект, говорит что отсутствует inifileman.
ОтветитьУдалитьесли можно ответьте как компильнуть проект под delphi 7 на почтуЖ oleg@delfist.ru
ОтветитьУдалитьОт inifileman можно избавиться, заменив реализацию функции TWordKillerService.load_config
ОтветитьУдалитьuses inifiles;
procedure TWordKillerService.load_config;
var f: inifiles.TIniFile;
function read_int(const srcParamName: String; DefaultValue: Integer): Integer;
var svalue: String;
begin
svalue := f.ReadString('data', srcParamName, '');
if svalue = ''
then Result := DefaultValue
else Result := StrToInt(svalue);
end;
function read_str(const srcParamName: String; DefaultValue: String): String;
var svalue: String;
begin
svalue := f.ReadString('data', srcParamName, '');
if svalue = ''
then Result := DefaultValue
else Result := svalue;
end;
begin
f := inifiles.TIniFile.Create(get_full_path_by_related_path('WordKiller.ini'),);
try
m_Config.ProcessExeFileName := read_str('ProcessExeFileName', 'winword.exe');
m_Config.IntervalForCheckOutdatedProcessesSEC := read_int('IntervalForCheckOutdatedProcessesSEC', 24*60*60);
m_Config.MaxAllowedTimeForProcessMS := read_int('MaxAllowedTimeForProcessMS', 10*60*1000);
m_Config.TestFindAndKillProcessByWindow := 0 <> read_int('TestFindAndKillProcessByWindow', 0);
m_Config.SrcFileNameForKillProcessByWindow := read_str('SrcFileNameForKillProcessByWindow', 'testdata\src.doc');
if ExtractFileDrive(m_Config.SrcFileNameForKillProcessByWindow) = '' then begin
m_Config.SrcFileNameForKillProcessByWindow := get_full_path_by_related_path(m_Config.SrcFileNameForKillProcessByWindow);
end;
finally
f.Free;
end;
end;
Проект писался под D2010, где дефолтные строки - unicode. Чтобы проект скомпилировался под D7, нужно в ProcessKiller перейти от unicode к ansi. Заменить lstrcmpi на lstrcmpiW, проверить корректность приведения строк к PWideChar и т.д.
А можно откомпилить и выложить куда нибудь. Я не имею понятия об этом языке и как с ним работать, но имею огромную проблему с winword.exe уже года два. Если можно киньте на мыло. krokodandiСобакаТочкаРу.
ОтветитьУдалитьВыложил скомпилированную версию: http://code.google.com/p/dvsrc/downloads/detail?name=WordKiller.rar
Удалить