Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Общие вопросы > Следить за процессом


Автор: SoWa 23.12.2004, 09:17
Есть ли такая функция, которая на входе имеет имя процеса(типа STRING), а на выходе
boolean? Т.е. если такой процесс запущен, то возвращать true, а если не запущен, то
возвращать false. Если стандартной функции нет, то подкиньте исходник плиз smile

Автор: Rennigth 23.12.2004, 10:40
Чтонибудь вреде этого...

Код

Uses  tlhelp32;
...

function ExistProcess(AName : PChar ) : boolean; StdCall;
var
 lSnapHandle, lProcHandle: THandle;
 ProcStruct : PROCESSENTRY32;
 lProcessPath : Pchar;
 PID : Cardinal;
begin
 Result := false;
 lSnapHandle := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
 if lSnapHandle = 0 then
   exit;
 ProcStruct.dwSize := sizeof( PROCESSENTRY32 );

 if Process32First(lSnapHandle, ProcStruct) then
 begin
   try
     repeat
       lProcessPath := ProcStruct.szExeFile;
       if uppercase(lProcessPath) = uppercase(AName) then
       begin
         PID := ProcStruct.th32ProcessID; //если понадобиться
         Result := true;
         Break;
       end;
     until not Process32Next(lSnapHandle, ProcStruct);
   finally
     CloseHandle(lSnapHandle);
   end;
 end;
end;


Добавлено @ 10:42
единственное я замечал разницу между Win9x и WinNT
ProcStruct.szExeFile в какомто случае полный путь файлу(с раширением) а в другом только имя процесса (безпути и расширения файла)

Автор: Palladin 24.2.2006, 16:49
Допустим мне надо чтоб мояпрограмма следила за состоянием проги под названием winamp.exe и если винамп не ключён то прога должна включить, то мне надо написать так
lProcessPath := Winamp.exe; ?????

Автор: Guedda 24.2.2006, 17:44
Используй эту функцию с параметром:
Код

if ExistProcess('Winamp.exe') then
  ShowMessage('Winamp запущен!');

Автор: Palladin 24.2.2006, 21:27
Короче я в сети админ сервера WoW хочу сделать прогу которая будет следить за тем работает сервак или нет, и если не работает то запускает его, вот мой код но здесь что-то не так, екзешник емуля wowemu.exe он такой же и в диспетчере задач, что здесь не так?

Код

procedure TForm1.Button1Click(Sender: TObject);
function ExistProcess(AName : PChar ) : boolean; StdCall;
begin
if ExistProcess('WoWEMU.exe') then
ShowMessage('сервак пашет')
else
 ShowMessage('Сервак полетел');
end;
begin
existprocess(здесь не понял что писать????);
end;
end.



помогите плиззз

Автор: Guedda 24.2.2006, 21:37
Все не так... Зачем ты засунул объявление функции в процедуру, да еще и заранее...
Вот тебе вариант:
Код

unit Unit1;

interface

uses
  ..., TLHelp32 ,...

function ExistProcess(AName : PChar ) : boolean; StdCall;

implementation

function ExistProcess(AName : PChar ) : boolean; StdCall;
var
  lSnapHandle, lProcHandle: THandle;
  ProcStruct : PROCESSENTRY32;
  lProcessPath : Pchar;
  PID : Cardinal;
begin
  Result := false;
  lSnapHandle := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
  if lSnapHandle = 0 then
    exit;
  ProcStruct.dwSize := sizeof( PROCESSENTRY32 );
  if Process32First(lSnapHandle, ProcStruct) then
  begin
    try
      repeat
        lProcessPath := ProcStruct.szExeFile;
        if uppercase(lProcessPath) = uppercase(AName) then
        begin
          PID := ProcStruct.th32ProcessID; //если понадобиться
          Result := true;
          Break;
        end;
      until not Process32Next(lSnapHandle, ProcStruct);
    finally
      CloseHandle(lSnapHandle);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender : TOBject);
begin
  if ExistProcess('WoWEMU.exe') then
    ShowMessage('Сервак пашет')
  else  
    ShowMessage('сервак полетел');
end;

end.

Автор: Palladin 24.2.2006, 21:43
Сенкс всё пашет, ща другой вопрос как дописать ф-ию чтобы она автоматом запускала его если полетел?????

Автор: Guedda 24.2.2006, 21:48
Код

procedure TForm1.Button1Click(Sender : TOBject);
begin
  if ExistProcess('WoWEMU.exe') then
    ShowMessage('Сервак пашет')
  else  
    WinExec('WoWEMU.exe', SW_SHOWNORMAL);
end;

Только в WinExec напиши полный путь к программе...

Автор: Palladin 24.2.2006, 21:54
Возьми меня в ученики о великий Guedda smile

всё пашет сенкс, вот только проблема, а нельзя ли както сделать так чтоб прога сама искала этот файл????
Добавлено @ 22:02
Хотя ладно забей на поиск, пропишу как есть, подскажи лучше что сделать чтоб прога начинала проверку каждые 5 минут

Автор: Guedda 24.2.2006, 22:09
Можно... Но это муторно. Так что лучше сделай так:
Создай константу, скомпиль прогу и все. Вот те код (примерный, конечно):
Код

procedure TForm1.Button1Click(Sender : TOBject);
const
  WoHryenVsyakaya = 'C:\Program Files\VsyakayaHren\WoWEMU.exe'; //Здесь прописываешь путь к программе...
begin
  if ExistProcess('WoWEMU.exe') then
    ShowMessage('Сервак пашет')
  else  
    WinExec(WoHryenVsyakaya, SW_SHOWNORMAL);
end;


Но, конечно, вот тебе процедура для поиска файлов. Можешь искать любые файлы:
Код

procedure FindFiles(Folder, Mask : string; SubFolders : boolean = true);
var
  SearchRec : TSearchRec;
  Result    : Integer;
begin
  Folder := IncludeTrailingBackSlash(Folder);
  Result := FindFirst(Folder + '*.*', faAnyFile, SearchRec);
  try
    while Result = 0 do
    with SearchRec do begin
      if (Attr and faDirectory) <> 0 then begin
        if SubFolders and (Name <> '.') and (Name <> '..') then

        FindFiles(Folder + Name, Mask, SubFolders);
      end { if Attr } else begin
        if MatchesMask(Name, Mask) then begin
        //Здесь пишешь все, что находишь...
        //Для твоей задачи тебе нужно Folder + Name
        end; { if }
      end; { else }
      Result := FindNext(SearchRec);
    end; { with }
  finally { try }
    FindClose(SearchRec);
  end; { finally }
  FindClose(SearchRec);
end;


Вот полный код:
Код

interface

procedure FindFiles(Folder, Mask : string; SubFolders : boolean = true);

implementation

var
  YourProg : string;

procedure FindFiles(Folder, Mask : string; SubFolders : boolean = true);
var
  SearchRec : TSearchRec;
  Result    : Integer;
begin
  Folder := IncludeTrailingBackSlash(Folder);
  Result := FindFirst(Folder + '*.*', faAnyFile, SearchRec);
  try
    while Result = 0 do
    with SearchRec do begin
      if (Attr and faDirectory) <> 0 then begin
        if SubFolders and (Name <> '.') and (Name <> '..') then

        FindFiles(Folder + Name, Mask, SubFolders);
      end { if Attr } else begin
        if MatchesMask(Name, Mask) then begin
           YourProg := Folder + Name;
        end; { if }
      end; { else }
      Result := FindNext(SearchRec);
    end; { with }
  finally { try }
    FindClose(SearchRec);
  end; { finally }
  FindClose(SearchRec);
end;

procedure TForm1.Button1Click(Sender : TOBject);
begin
  if ExistProcess('WoWEMU.exe') then
    ShowMessage('Сервак пашет')
  else begin 
    FindFiles('C:\', 'WoWEMU.exe');
    if YourProg <> '' then
    WinExec(YourProg, SW_SHOWNORMAL);
  end;
end;


Можешь задавать вопросы на [email protected]

Автор: Palladin 24.2.2006, 22:15
[Error] Unit1.pas(76): Undeclared identifier: 'MatchesMask'

вот такая вот ошибка

понятно нету идендификатора в варе но какого формата нада string?????

Автор: Guedda 24.2.2006, 22:22
MatchesMask - это функция...
Просто в разделе uses подключи Masks.
У тебя должно получиться что-то типа:
Код

uses
  ..., Masks;

Автор: Palladin 24.2.2006, 22:27
Сенкс, Guedda ты в аське не сидиш там бы проще было общатся, а то на форуме ответа долго ждать, а по почте муторно
Добавлено @ 22:32
щас пишет ошибку
[Error] Unit1.pas(105): Incompatible types: 'String' and 'PAnsiChar'

несоответствие тмпов чтоли?

Автор: SPrograMMer 24.2.2006, 23:08
Цитата(RooR @ 24.2.2006, 22:27 Найти цитируемый пост)
несоответствие тмпов чтоли
угу
Proc(PAnsiString(YourString))

Автор: Slaad 24.2.2006, 23:08
PAnsiChar это строка с завершающим нулевым символом которая служит в основном для интерфейса с функциями WIn API.
Так что нужно использовать либо
SomeFuncWinAPi(...,'somestring',...)
либо
SomeFuncWinAPi(...,PChar(st),...)
где st - переменная типа String.

Автор: Guedda 25.2.2006, 15:31
Короче...
Шаг за шагом объясняю smile
Создаешь проект. Открываешь код страницы. Пишешь после:
Код

var
  Form1 : TForm1;
  YourProgFullName : PChar;//Вот это дописываешь.

Сразу после этих строк прописываешь следующее:
Код

function ExistProcess(AName : PChar ) : boolean; StdCall;
procedure FindFiles(Folder, Mask : string; SubFolders : boolean = true);

Спускаешься ниже, и после строки {$R *.dfm} пишешь следующее:
Код

function ExistProcess(AName : PChar ) : boolean; StdCall;
var
  lSnapHandle, lProcHandle: THandle;
  ProcStruct : PROCESSENTRY32;
  lProcessPath : Pchar;
  PID : Cardinal;
begin
  Result := false;
  lSnapHandle := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
  if lSnapHandle = 0 then
    exit;
  ProcStruct.dwSize := sizeof( PROCESSENTRY32 );
  if Process32First(lSnapHandle, ProcStruct) then
  begin
    try
      repeat
        lProcessPath := ProcStruct.szExeFile;
        if uppercase(lProcessPath) = uppercase(AName) then
        begin
          PID := ProcStruct.th32ProcessID;
          Result := true;
          Break;
        end;
      until not Process32Next(lSnapHandle, ProcStruct);
    finally
      CloseHandle(lSnapHandle);
    end;
  end;
end;

procedure FindFiles(Folder, Mask : string; SubFolders : boolean = true);
var
  SearchRec : TSearchRec;
  Result : Integer;
begin
  Folder := IncludeTrailingBackSlash(Folder);
  Result := FindFirst(Folder + '*.*', faAnyFile, SearchRec);
  try
    while Result = 0 do
    with SearchRec do begin
      if (Attr and faDirectory) <> 0 then begin
        if SubFolders and (Name <> '.') and (Name <> '..') then
        FindFiles(Folder + Name, Mask, SubFolders);
      end { if Attr } else begin
        if MatchesMask(Name, Mask) then begin
          YourProg := PChar(Folder + Name);
        end; { if }
      end; { else }
      Result := FindNext(SearchRec);
    end; { with }
  finally { try }
    FindClose(SearchRec);
  end; { finally }
  FindClose(SearchRec);
end;

После этого кидаешь на форму TTimer и в свойствах прописываешь:
Interval = 30000
Enabled = false;
После этого кликаешь два раза на таймере. Между begin и end напиши следующее:
Код

if ExistProcess('winamp.exe') then
  ShowMessage('Winamp запущен!')
else begin
  FindFiles('C:\', 'Winamp.exe');
  if YourProgFullName <> '' then
    WinExec(YourProgFullName, SW_SHOWNORMAL);
end;

После этого кидаешь на форму Button1, и в его коде пропиши:
Код

procedure TForm1.Button1Click(Sender : TObject);
begin
  Timer1.Enabled := true; //Запускаем сканирование
end;

Кидаешь вторую кнопку, остановки сканирования:
Код

procedure TForm1.Button2Click(Sender : TObject);
begin
  Timer1.Enabled := false; //Останавливаем сканирование
end;


Все. Повтори все шаги без пропусков. И у тебя все получится...
Только вчитывайся внимательно... Если будут ошибки, пиши...

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)