Если программа запущена то...Delphi

В общем нужно сдлеать маленькую программу ))на делфе.Ее суть:
Допустим открыли программу(ничего не происходит) как только пользователь открыл wow.exe вылетает сообщение "........"

 

Вылетает кукушка и лупить пользователя по лицу пока он не закроет wow если он не успевает закрыть wow кукушка активирует опцию фаталити - и после чего самоуничтожаеться перегружая компьютер - а лучше сделать версию ЗВОНОК 2 - как толькот открыл вов гаснет в клубе свет включаеться телек баб имя юзера говорит что он умрет через Х дней и что бы - не умереть - нужно заплатить админу косарь )

 

Получать список процессов и искать в нем wow.exe.
Или попробовать hook на создание окна.

 

Аналогичный вопрос - http://www.cyberforum.ru/delphi-beginners/thread698008.html#post3701769

 

Code:

Uses
  Windows, Classes, SysUtils, ActiveX, WinInet, ShellAPI, ShlObj,  Tlhelp32,PsAPI;

function IsRunning(sName: string): boolean;
var
 han: THandle;
 ProcStruct: PROCESSENTRY32;
 sID: string;
begin
 Result:=false;
 han:=CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
 try
  if han=0 then exit;
  ProcStruct.dwSize := sizeof(PROCESSENTRY32);
  if Process32First(han, ProcStruct) then
   begin
    repeat
     sID := ExtractFileName(ProcStruct.szExeFile);
     if uppercase(copy(sId, 1, length(sName))) = uppercase(sName) then
      begin
       Result := true;
       Break;
      end;
    until
     not Process32Next(han, ProcStruct);
   end;
 finally
  CloseHandle(han);
 end;
end;

Какие именно нужны юниты что бы работала функция точно не помню, поэтому вставил все что в юните у себя юзал

Пишешь:

Code:

 if IsRunning('wow.exe') then .... 

 

или так:

Code:

uses
  Windows, TLHelp32;

function ProcessExists(procname:string): boolean;
var
  hSnap:THandle;
  pe:TProcessEntry32;
begin
 pe.dwSize:=SizeOf(pe);
 hSnap:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
  If Process32First(hSnap,pe) then
    While Process32Next(hSnap,pe) do
    if (Pos(procname,pe.szExeFile)<>0) then begin
      Result := True;
      break;
    end
    else begin
    Result := false;
  end;
  CloseHandle(hSnap);
end;

while true do begin
  if ProcessExists('wow.exe') then MessageBoxA(0, 'text', 'title', MB_OK);
  Sleep(1000);
end;

 

Ругается на while!Получается я создал unit с этим кодом!Потом привязал его к форме.И не робит((

 

Ребят стукните в аську!327032 помогите плз!

 

а нахрена тебе в отдельный юнит пихать это? делаешь вот так:

Code:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, TLHelp32, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function ProcessExists(procname:string): boolean;
var
  hSnap:THandle;
  pe:TProcessEntry32;
begin
 pe.dwSize:=SizeOf(pe);
 hSnap:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS  ,0);
  If Process32First(hSnap,pe) then
    While Process32Next(hSnap,pe) do
    if (Pos(procname,pe.szExeFile)<>0) then begin
      Result := True;
      break;
    end
    else begin
    Result := false;
  end;
  CloseHandle(hSnap);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  while true do begin
    if ProcessExists('wow.exe') then MessageBoxA(0, 'text', 'title', MB_OK);
    Sleep(1000);
  end;
end;

end.

а если уж и это скопипастить не сможешь, то никто тебе помочь не сможет.

 

С этим разобрался!Только вот результата 0.У меня семерка стоит мб из за этого?

 

что-то не так делаешь, все норм на 7 работает, TLHelp32 подключить не забыл?

 

Code:

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, tlhelp32, ExtCtrls, StdCtrls;

type
 TForm1 = class(TForm)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);

 private
 { Private declarations }
 public
 { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

function processExists(exeFileName: string): Boolean;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
Result := False;
while Integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName))) then
begin
Result := True;
end;
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;



procedure TForm1.FormCreate(Sender: TObject);
begin
Application.ShowMainForm := False;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if processExists('game.exe') then
ShowMessage('Процесс запущен');
end;

end.

Вот рабочий код 100%.Такая проблема.Получается когда я запустил игру,потом запустил программу вылетает тысяча сообщений.Если сначало прогу потом игру ничего не пишет.Как с этим бороться?Надо допустим чтоб она работала в автономном режиме,допустим зустил процесс вылезло сообщение,потом через пол часа опять запустил процесс опять вылезло сообщение

 

на win8 не работает(((хелп плз

 

Как вариант (через жопу, но работать будет; камнями не кидайте - ТСу простой вариант нужен, а не стабильный и быстрый):
1) Из делфи создаем и запускаем батник на гетпроцессес
2) Получаем список, проверяем на соответствие нужному процессу, делаем мессаджбокс.
3) Все это в цикле

 

На самом деле приведенный выше код должен работать, только выполняется он похоже с ограниченными правами, поэтому не получает или получает не полностью список процессов.

p.s.: а вообще как бы некропост)