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

Guedda

Дата 25.2.2006, 15:31 (ссылка)

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

Загрузка ...

Подрывник

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

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

Короче...
Шаг за шагом объясняю 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;

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

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

Ll 2

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