VPF::Следить за процессом - Форум программистов

SoWa

Дата 23.12.2004, 09:17 (ссылка)

(нет голосов)

Загрузка ...

Харекришна

Профиль
Группа: Комодератор
Сообщений: 2422
Регистрация: 18.10.2004

Репутация: 2
Всего: 74

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

--------------------

Всем добра smile

Rennigth

Дата 23.12.2004, 10:40 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 49
Всего: 76

Чтонибудь вреде этого...

Код


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 в какомто случае полный путь файлу(с раширением) а в другом только имя процесса (безпути и расширения файла)

--------------------

(* Honesta mors turpi vita potior *)

Palladin

Дата 24.2.2006, 16:49 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 932
Регистрация: 15.5.2007
Где: Беларусь г.Гомель

Репутация: 3
Всего: 17

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

--------------------

Глуп тот кто полагается на истину авторитета, а не на авторитет истины
[color=red]KAV&KIS==Evil[/color]

Guedda

Дата 24.2.2006, 17:44 (ссылка)

(нет голосов)

Загрузка ...

Подрывник

Профиль
Группа: Завсегдатай
Сообщений: 3137
Регистрация: 27.12.2005
Где: Ростов-на-Дону

Репутация: 14
Всего: 78

Используй эту функцию с параметром:

Код


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

--------------------

Ll 2

Palladin

Дата 24.2.2006, 21:27 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 932
Регистрация: 15.5.2007
Где: Беларусь г.Гомель

Репутация: 3
Всего: 17

Короче я в сети админ сервера 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.

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

Это сообщение отредактировал(а) Girder - 26.2.2006, 11:55

--------------------

Глуп тот кто полагается на истину авторитета, а не на авторитет истины
[color=red]KAV&KIS==Evil[/color]

Guedda

Дата 24.2.2006, 21:37 (ссылка)

(нет голосов)

Загрузка ...

Подрывник

Профиль
Группа: Завсегдатай
Сообщений: 3137
Регистрация: 27.12.2005
Где: Ростов-на-Дону

Репутация: 14
Всего: 78

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

Код


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.

Это сообщение отредактировал(а) Guedda - 24.2.2006, 21:38

--------------------

Ll 2

Palladin

Дата 24.2.2006, 21:43 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 932
Регистрация: 15.5.2007
Где: Беларусь г.Гомель

Репутация: 3
Всего: 17

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

--------------------

Глуп тот кто полагается на истину авторитета, а не на авторитет истины
[color=red]KAV&KIS==Evil[/color]

Guedda

Дата 24.2.2006, 21:48 (ссылка)

(нет голосов)

Загрузка ...

Подрывник

Профиль
Группа: Завсегдатай
Сообщений: 3137
Регистрация: 27.12.2005
Где: Ростов-на-Дону

Репутация: 14
Всего: 78

Код


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

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

--------------------

Ll 2

Palladin

Дата 24.2.2006, 21:54 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 932
Регистрация: 15.5.2007
Где: Беларусь г.Гомель

Репутация: 3
Всего: 17

Возьми меня в ученики о великий Guedda smile

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

--------------------

Глуп тот кто полагается на истину авторитета, а не на авторитет истины
[color=red]KAV&KIS==Evil[/color]

Guedda

Дата 24.2.2006, 22:09 (ссылка)

(нет голосов)

Загрузка ...

Подрывник

Профиль
Группа: Завсегдатай
Сообщений: 3137
Регистрация: 27.12.2005
Где: Ростов-на-Дону

Репутация: 14
Всего: 78

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

Код


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]

--------------------

Ll 2

Palladin

Дата 24.2.2006, 22:15 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 932
Регистрация: 15.5.2007
Где: Беларусь г.Гомель

Репутация: 3
Всего: 17

[Error] Unit1.pas(76): Undeclared identifier: 'MatchesMask'

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

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

--------------------

Глуп тот кто полагается на истину авторитета, а не на авторитет истины
[color=red]KAV&KIS==Evil[/color]

Guedda

Дата 24.2.2006, 22:22 (ссылка)

(нет голосов)

Загрузка ...

Подрывник

Профиль
Группа: Завсегдатай
Сообщений: 3137
Регистрация: 27.12.2005
Где: Ростов-на-Дону

Репутация: 14
Всего: 78

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

Код


uses
  ..., Masks;

--------------------

Ll 2

Palladin

Дата 24.2.2006, 22:27 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 932
Регистрация: 15.5.2007
Где: Беларусь г.Гомель

Репутация: 3
Всего: 17

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

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

--------------------

Глуп тот кто полагается на истину авторитета, а не на авторитет истины
[color=red]KAV&KIS==Evil[/color]

SPrograMMer

Дата 24.2.2006, 23:08 (ссылка)

(нет голосов)

Загрузка ...

Спамер :)

Профиль
Группа: Участник
Сообщений: 442
Регистрация: 5.11.2004
Где: Краснодар

Репутация: 2
Всего: 6

Цитата(RooR @ 24.2.2006, 22:27

)

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

угу
Proc(PAnsiString(YourString))

--------------------

животное = зверь
законченный гентушник

Slaad

Дата 24.2.2006, 23:08 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 10
Регистрация: 10.2.2006

Репутация: нет
Всего: нет

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

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »