{ necessitam das units Windows e TlHelp32 }
function FindProcess(ProcessName: string): DWORD;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
Result := 0;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
while ContinueLoop and (not Boolean(Result)) do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ProcessName)) or
(UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ProcessName))) then
Result := FProcessEntry32.th32ProcessID;
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
end;
type
TProcessStatus = (pcsNotFound = -1, pcsNotResponding, pcsRunning);
const
ProcessStatusNames: array[TProcessStatus] of string =
('** NÃO ENCONTRADO **', 'Em Execução', 'Não Respondendo');
function ProcessResponding(AProcessName: string): TProcessStatus;
var
H: DWORD;
lngReturnValue: longint;
DWResult: DWORD;
begin
Result := pcsNotFound;
H := FindProcess(AProcessName);
if H> 0 then
begin
lngReturnValue := SendMessageTimeout(H, WM_NULL, 0, 0,
SMTO_ABORTIFHUNG and SMTO_BLOCK, 1000, DWResult);
Result := TProcessStatus(Ord((lngReturnValue> 0)));
end;
end;
Sds.,
Rubem Rocha
Manaus, AM
_________________________________________________________________
Instale a Barra de Ferramentas com Desktop Search e ganhe EMOTICONS para o
Messenger! É GRÁTIS!
http://www.msn.com.br/emoticonpack
