Показать сообщение отдельно

  #5  
Старый 31.03.2009, 21:20
art2222
Участник форума
Регистрация: 28.04.2008
Сообщений: 172
Провел на форуме:
1191083

Репутация: 270
По умолчанию

Код:
uses 
Psapi, tlhelp32; 

procedure CreateWin9xProcessList(List: TstringList); 
var 
hSnapShot: THandle; 
ProcInfo: TProcessEntry32; 
begin 
if List = nil then Exit; 
hSnapShot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0); 
if (hSnapShot <> THandle(-1)) then 
begin 
   ProcInfo.dwSize := SizeOf(ProcInfo); 
   if (Process32First(hSnapshot, ProcInfo)) then 
   begin 
     List.Add(ProcInfo.szExeFile); 
     while (Process32Next(hSnapShot, ProcInfo)) do 
       List.Add(ProcInfo.szExeFile); 
   end; 
   CloseHandle(hSnapShot); 
end; 
end; 

procedure CreateWinNTProcessList(List: TstringList); 
var 
PIDArray: array [0..1023] of DWORD; 
cb: DWORD; 
I: Integer; 
ProcCount: Integer; 
hMod: HMODULE; 
hProcess: THandle; 
ModuleName: array [0..300] of Char; 
begin 
if List = nil then Exit; 
EnumProcesses(@PIDArray, SizeOf(PIDArray), cb); 
ProcCount := cb div SizeOf(DWORD); 
for I := 0 to ProcCount - 1 do 
begin 
   hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or 
     PROCESS_VM_READ, 
     False, 
     PIDArray[I]); 
   if (hProcess <> 0) then 
   begin 
     EnumProcessModules(hProcess, @hMod, SizeOf(hMod), cb); 
     GetModuleFilenameEx(hProcess, hMod, ModuleName, SizeOf(ModuleName)); 
     List.Add(ModuleName); 
     CloseHandle(hProcess); 
   end; 
end; 
end; 

 

procedure GetProcessList(var List: TstringList); 
var 
ovi: TOSVersionInfo; 
begin 
if List = nil then Exit; 
ovi.dwOSVersionInfoSize := SizeOf(TOSVersionInfo); 
GetVersionEx(ovi); 
case ovi.dwPlatformId of 
   VER_PLATFORM_WIN32_WINDOWS: CreateWin9xProcessList(List); 
   VER_PLATFORM_WIN32_NT: CreateWinNTProcessList(List); 
end 
end; 

 

function EXE_Running(FileName: string; bFullpath: Boolean): Boolean; 
var 
i: Integer; 
MyProcList: TstringList; 
begin 
MyProcList := TStringList.Create; 
try 
   GetProcessList(MyProcList); 
   Result := False; 
   if MyProcList = nil then Exit; 
   for i := 0 to MyProcList.Count - 1 do 
   begin 
     if not bFullpath then 
     begin 
       if CompareText(ExtractFileName(MyProcList.Strings[i]), FileName) = 0 then 
         Result := True 
     end 
     else if CompareText(MyProcList.strings[i], FileName) = 0 then Result := True; 
     if Result then Break; 
   end; 
finally 
   MyProcList.Free; 
end; 

end;
(c) DRKB

Проверяем так:

Код:
procedure CheckFile;
var
  f: TextFile;
  s: string;
begin
  AssignFile(f,'c:\1.txt');
  Reset(f);
  Readln(f,s);
  if s='123' then
  begin
    if EXE_Running('1.exe', False) then
      ShowMessage('EXE is running')
    else
      ShowMessage('EXE is not running');
  end;
  CloseFile(f);
end;
Потом в цикле вызываешь процедуру и все.

А вот как нужно убивать процесс зная только его имя (notepad.exe например)
Код:
uses 
Tlhelp32, Windows, SysUtils; 

function KillTask(ExeFileName: string): integer; 
const 
PROCESS_TERMINATE=$0001; 
var 
ContinueLoop: BOOL; 
FSnapshotHandle: THandle; 
FProcessEntry32: TProcessEntry32; 
begin 
result := 0; 
FSnapshotHandle := CreateToolhelp32Snapshot 
                    (TH32CS_SNAPPROCESS, 0); 
FProcessEntry32.dwSize := Sizeof(FProcessEntry32); 
ContinueLoop := Process32First(FSnapshotHandle, 
                                FProcessEntry32); 
while integer(ContinueLoop) <> 0 do 
begin 
   if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = 
        UpperCase(ExeFileName)) 
    or (UpperCase(FProcessEntry32.szExeFile) = 
        UpperCase(ExeFileName))) then 
     Result := Integer(TerminateProcess(OpenProcess( 
                       PROCESS_TERMINATE, BOOL(0), 
                       FProcessEntry32.th32ProcessID), 0)); 
   ContinueLoop := Process32Next(FSnapshotHandle, 
                                 FProcessEntry32); 
end;  
CloseHandle(FSnapshotHandle); 
end;

Последний раз редактировалось art2222; 31.03.2009 в 21:25..
 
Ответить с цитированием