Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > Как узнать если запущена программа?

Автор: Pavelbej 16.8.2006, 16:25

Как можно узнать, по ее EXE, что программа запущена (например FlaskGet.exe) и если работает, то выключить ее.

Автор: _hunter 16.8.2006, 16:34

можно сделать список процессов и поискать в нем

Автор: Rennigth 16.8.2006, 16:36

Поиск...

или вот:

Код


function GetLastErrorString: string;
var
  lz: Cardinal;
  lErr: array[0..512] of Char;
begin
  lz := GetLastError;
  FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, lz, 0, @lErr, 512, nil);
  Result := string(lErr);
end;

function GetProcessID(const AProcessName: string): DWord;
var
  lSnapHandle: THandle;
  lProcStruct: PROCESSENTRY32;
  lProcessName, lSnapProcessName: string;
  lOSVerInfo: TOSVersionInfo;
begin
  Result := INVALID_HANDLE_VALUE;
  lSnapHandle := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
  if lSnapHandle = INVALID_HANDLE_VALUE then
    Exit;

  lProcStruct.dwSize := SizeOf(PROCESSENTRY32);

  lOSVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  GetVersionEx(lOSVerInfo);
  case lOSVerInfo.dwPlatformId of
    VER_PLATFORM_WIN32_WINDOWS: lProcessName := AProcessName;
    VER_PLATFORM_WIN32_NT: lProcessName := ExtractFileName(AProcessName);
  end;

  if Process32First(lSnapHandle, lProcStruct) then
  begin
    try
      repeat
        lSnapProcessName := lProcStruct.szExeFile;
        if AnsiUpperCase(lSnapProcessName) = AnsiUpperCase(lProcessName) then
        begin
          Result := lProcStruct.th32ProcessID;
          Break;
        end;
      until not Process32Next(lSnapHandle, lProcStruct);
    finally
      CloseHandle(lSnapHandle);
    end;
  end;
end;

function KillProcess(const AProcessName: string): Boolean;
var
  lPID, lCurrentProcPID: DWord;
  lProcHandle: DWord;
begin
  Result := False;
  try
    lCurrentProcPID := GetCurrentProcessId;
    lPID := GetProcessID(AProcessName);
    if (lPID <> INVALID_HANDLE_VALUE) and (lCurrentProcPID <> lPID) then
    begin
      lProcHandle := OpenProcess(PROCESS_TERMINATE, False, lPID);
      Windows.TerminateProcess(lProcHandle, 0);
      WaitForSingleObject(lProcHandle, Infinite);
      CloseHandle(lProcHandle);
      Result := True;
    end;
  except
    raise EExternalException.Create(GetLastErrorString);
  end;
end;

Автор: Sunvas 16.8.2006, 17:13

Цитата(Pavelbej @ 16.8.2006, 16:25

)

то выключить ее

А что значит "Выключить"? (убить процес, приостановить ...)

Автор: Pavelbej 16.8.2006, 17:44

Sunvas, нужно приостановить программу с возможностью сохранения данных.

Rennigth, спасибо, вроде то что надо, но как я уже говорил нужно приостановить программу и не могу разобратся как всетаки узнать запущена программа или нет. То есть ProcessID я узнаю, а как создать условие не пойму.

Обьясню подробнее: В программе имеется CheckListBox в котором находятся программы. Если возле имени программы стоит галочка то нужно ее запускать но прежде надо проверить не работает ли она уже. Вот собственно и все.

Автор: Rennigth 16.8.2006, 17:49

Цитата(Pavelbej @ 16.8.2006, 17:44

)

То есть ProcessID я узнаю, а как создать условие не пойму.

Код


function ProcessIsRun(const AName: string): Boolean;
begin
   Result := GetProcessID('Flashget.exe') <> INVALID_HANDLE_VALUE;
end;

Автор: Alexeis 16.8.2006, 17:52

Цитата(Pavelbej @ 16.8.2006, 17:44

)

но прежде надо проверить не работает ли она уже

Код


if FindWindow('Имя класса главного окна', 'заголовок окна')
then
  showmessage('запущена');

--------------------------
Пожалуй вариант Rennigth лучше, поскольку не все программы имеют окна smile

Автор: Rennigth 16.8.2006, 17:52

т.е.

Код


function ProcessIsRun(const AName: string): Boolean;
begin
   Result := GetProcessID(AName) <> INVALID_HANDLE_VALUE;
end;

Автор: BUGOR 16.8.2006, 18:06

Цитата

Sunvas, нужно приостановить программу с возможностью сохранения данных.

Не совсем понятно, но как вариант это создавать новый поток и в нём перечисляя все треды останавливать их(ессно кроме текущего):

Код


Procedure StopThreads;
var
 h, CurrTh, ThrHandle, CurrPr: dword;
 Thread: TThreadEntry32;
begin
 CurrTh := GetCurrentThreadId;
 CurrPr := GetCurrentProcessId;
 h := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0);
 if h <> INVALID_HANDLE_VALUE then
   begin
    Thread.dwSize := SizeOf(TThreadEntry32);
    if Thread32First(h, Thread) then
    repeat
     if (Thread.th32ThreadID <> CurrTh) and (Thread.th32OwnerProcessID = CurrPr) then
      begin
       ThrHandle := OpenThread(THREAD_SUSPEND_RESUME, false, Thread.th32ThreadID);
       if ThrHandle>0 then
         begin
          SuspendThread(ThrHandle);
          CloseHandle(ThrHandle);
         end;
       end;
    until not Thread32Next(h, Thread);
   CloseHandle(h);
   end;
end;

Код


Procedure RunThreads;
var
 h, CurrTh, ThrHandle, CurrPr: dword;
 Thread: TThreadEntry32;
begin
 CurrTh := GetCurrentThreadId;
 CurrPr := GetCurrentProcessId;
 h := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0);
 if h <> INVALID_HANDLE_VALUE then
   begin
    Thread.dwSize := SizeOf(TThreadEntry32);
    if Thread32First(h, Thread) then
    repeat
     if (Thread.th32ThreadID <> CurrTh) and (Thread.th32OwnerProcessID = CurrPr) then
      begin
       ThrHandle := OpenThread(THREAD_SUSPEND_RESUME, false, Thread.th32ThreadID);
       if ThrHandle>0 then
         begin
          ResumeThread(ThrHandle);
          CloseHandle(ThrHandle);
         end;
       end;
    until not Thread32Next(h, Thread);
   CloseHandle(h);
   end;
end;

Автор: Pavelbej 16.8.2006, 18:44

Всем спасибо, вроде все работает. Подарю вам по плюсику но после ста постов.

Автор: COOLHack 15.6.2008, 01:36

Цитата

if FindWindow('Имя класса главного окна', 'заголовок окна')
then
showmessage('запущена');

А если я знаю только имя процесса, как узнать запущен ли он в данный момент?

Автор: Rennigth 15.6.2008, 08:44

Цитата(COOLHack @ 15.6.2008, 01:36

)

А если я знаю только имя процесса, как узнать запущен ли он в данный момент?

А если топик повнимательнее посмотреть? smile

Даю наводку

Цитата(Rennigth @ 16.8.2006, 17:52

)

ProcessIsRun

Автор: MetalFan 15.6.2008, 21:05

Цитата(Rennigth @ 16.8.2006, 17:52

)

function ProcessIsRun(const AName: string): Boolean;
begin
Result := GetProcessID(AName) <> INVALID_HANDLE_VALUE;
end;

хм, а ничо, что:

Цитата(MSDN)

GetProcessId
Retrieves the process identifier of the specified process.

DWORD WINAPI GetProcessId(
HANDLE Process
);

Parameters
Process
[in] A handle to the process. The handle must have the PROCESS_QUERY_INFORMATION access right.

Автор: dumb 15.6.2008, 21:17

MetalFan, в данном случае это своя функция(http://forum.vingrad.ru/index.php?showtopic=108112&view=findpost&p=823823). хотя и негоже, Rennigth, имена такие давать своим функциям. smile

Автор: MetalFan 15.6.2008, 22:25

dumb, точно, не увидел сего ньанса. да, согласен, не очень хорошо давать своим функциям имена виндовых системных.

Автор: COOLHack 15.6.2008, 23:59

Гы, пасиб, сделал то что задумал

Автор: Rennigth 16.6.2008, 02:38

dumb,
MetalFan,
Ребят, ну сильно не бейте smile

Топик 2006-го года

, древность подняли... smile

Автор: MetalFan 16.6.2008, 07:35

Rennigth, да, и правда некрофилия)