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

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by .Light., 25 Nov 2012.

  1. .Light.

    .Light. New Member

    Joined:
    12 Jul 2010
    Messages:
    197
    Likes Received:
    4
    Reputations:
    0
    В общем нужно сдлеать маленькую программу ))на делфе.Ее суть:
    Допустим открыли программу(ничего не происходит) как только пользователь открыл wow.exe вылетает сообщение "........"
     
  2. Adio

    Adio Elder - Старейшина

    Joined:
    23 May 2005
    Messages:
    1,676
    Likes Received:
    147
    Reputations:
    18
    Вылетает кукушка и лупить пользователя по лицу пока он не закроет wow если он не успевает закрыть wow кукушка активирует опцию фаталити - и после чего самоуничтожаеться перегружая компьютер - а лучше сделать версию ЗВОНОК 2 - как толькот открыл вов гаснет в клубе свет включаеться телек баб имя юзера говорит что он умрет через Х дней и что бы - не умереть - нужно заплатить админу косарь )
     
    4 people like this.
  3. Prosta4ok

    Prosta4ok New Member

    Joined:
    25 Oct 2012
    Messages:
    61
    Likes Received:
    0
    Reputations:
    0
    :D :D :D :D
     
  4. Vet

    Vet New Member

    Joined:
    3 Feb 2006
    Messages:
    7
    Likes Received:
    0
    Reputations:
    0
    Получать список процессов и искать в нем wow.exe.
    Или попробовать hook на создание окна.
     
  5. Tip.the.besT

    Tip.the.besT Member

    Joined:
    24 Jun 2009
    Messages:
    270
    Likes Received:
    10
    Reputations:
    4
    Аналогичный вопрос - http://www.cyberforum.ru/delphi-beginners/thread698008.html#post3701769
     
  6. Zalm

    Zalm New Member

    Joined:
    7 Sep 2012
    Messages:
    16
    Likes Received:
    1
    Reputations:
    0
    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 .... 
     
  7. C00LPack

    C00LPack Member

    Joined:
    7 Oct 2010
    Messages:
    427
    Likes Received:
    66
    Reputations:
    19
    или так:

    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;
    
    
     
  8. .Light.

    .Light. New Member

    Joined:
    12 Jul 2010
    Messages:
    197
    Likes Received:
    4
    Reputations:
    0
    Ругается на while!Получается я создал unit с этим кодом!Потом привязал его к форме.И не робит((
     
    #8 .Light., 29 Nov 2012
    Last edited: 29 Nov 2012
  9. .Light.

    .Light. New Member

    Joined:
    12 Jul 2010
    Messages:
    197
    Likes Received:
    4
    Reputations:
    0
    Ребят стукните в аську!327032 помогите плз!
     
  10. C00LPack

    C00LPack Member

    Joined:
    7 Oct 2010
    Messages:
    427
    Likes Received:
    66
    Reputations:
    19
    а нахрена тебе в отдельный юнит пихать это? делаешь вот так:
    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.
    
    а если уж и это скопипастить не сможешь, то никто тебе помочь не сможет.
     
  11. .Light.

    .Light. New Member

    Joined:
    12 Jul 2010
    Messages:
    197
    Likes Received:
    4
    Reputations:
    0

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

    C00LPack Member

    Joined:
    7 Oct 2010
    Messages:
    427
    Likes Received:
    66
    Reputations:
    19
    что-то не так делаешь, все норм на 7 работает, TLHelp32 подключить не забыл?
     
  13. .Light.

    .Light. New Member

    Joined:
    12 Jul 2010
    Messages:
    197
    Likes Received:
    4
    Reputations:
    0
    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%.Такая проблема.Получается когда я запустил игру,потом запустил программу вылетает тысяча сообщений.Если сначало прогу потом игру ничего не пишет.Как с этим бороться?Надо допустим чтоб она работала в автономном режиме,допустим зустил процесс вылезло сообщение,потом через пол часа опять запустил процесс опять вылезло сообщение
     
  14. .Light.

    .Light. New Member

    Joined:
    12 Jul 2010
    Messages:
    197
    Likes Received:
    4
    Reputations:
    0
    на win8 не работает(((хелп плз
     
  15. Dragunov

    Dragunov Banned

    Joined:
    3 Jul 2005
    Messages:
    6
    Likes Received:
    0
    Reputations:
    0
    Как вариант (через жопу, но работать будет; камнями не кидайте - ТСу простой вариант нужен, а не стабильный и быстрый):
    1) Из делфи создаем и запускаем батник на гетпроцессес
    2) Получаем список, проверяем на соответствие нужному процессу, делаем мессаджбокс.
    3) Все это в цикле
     
  16. #colorblind

    #colorblind Elder - Старейшина

    Joined:
    31 Jan 2014
    Messages:
    603
    Likes Received:
    222
    Reputations:
    36
    На самом деле приведенный выше код должен работать, только выполняется он похоже с ограниченными правами, поэтому не получает или получает не полностью список процессов.

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