Дождаться создания главного окна

reqyz · #1 27.11.2012, 19:25

есть у меня процесс, который я создал креэйтпроцесс-ом, есть вся информация о нём и параметры, нужно как то дождаться, пока он создаст первое окно. Я не хочу в цикле проверять есть ли у него окна, возможно есь стандартная функция может в рундлл? хуки конечно выход может, хоть и ивращённый, но я с ними не много работал, знаю что можно для одного процесса создать локальный хук без библиотеки, но у меня так не вышло. Может кто помочь - направить?

NumLock · #2 28.11.2012, 09:21

попробуй WaitForInputIdle

reqyz · #3 28.11.2012, 11:19

Функция WaitForInputIdle ждет до тех пор, пока заданный процесс не дождется ввода данных пользователем, без задержки ввода, или до тех пор, пока не истечет интервал блокировки по времени.

не то

Ладно, как поставить хук на конкретный мною известный поток, в библиотеке

Код:

library dll;

uses
  SysUtils,
  windows,
  Classes;
var
  Hook:HHOOK;
  Handle:THandle;
  HCBT2:longword;

  function CreateWND(code: integer; wParam: word; lParam: longword): longword; stdcall;
  begin
    if Code<0 then
    begin
      Result := CallNextHookEx(Hook, code, WParam, LParam);
      exit;
    end;
    if(code=HCBT2)then
    begin
      Handle:=wParam;
      UnhookWindowsHookEx(Hook);
    end;
  end;
function SetWnd(HCBT,dwThreadId:longword):THandle;
begin
  Handle:=0;
  HCBT2:=HCBT;
  Hook:=SetWindowsHookEx(WH_CBT,@CreateWND,HInstance,dwThreadId);
  repeat
  until(Handle>0);
end;

exports
  SetWnd;

end.

Hook возвращает 0 и хук не ставится.
вызываю так

Код:

var
  SetWND:function(HCBT,dwThreadId:longword):THandle;
    dll:=LoadLibrary('dll.dll');
    @SetWND:=GetProcAddress(dll,'SetWnd');

NumLock · #4 28.11.2012, 11:30

какая конечная цель?

reqyz · #5 28.11.2012, 11:36

Цитата:

Сообщение от NumLock

какая конечная цель?

конечная цель - контроль окон конкретного процесса, при создании их, удалении и т д

Aristarh Dark · #6 28.11.2012, 11:59

Если задача в том чтобы действительно дождаться, т.е. остановить ту нить из которой был создан процесс - то однозначно WaitForSingleObject. Если же нить создающая процесс должна знать когда окно было создано/уничтожено/свернуто/развернуто и т.п., то вполне хватит SendMessage/PostMessage или, если дело происходит внутри потоков, PostThreadMessage

reqyz · #7 28.11.2012, 18:57

Цитата:

Сообщение от Aristarh Dark

Если задача в том чтобы действительно дождаться, т.е. остановить ту нить из которой был создан процесс - то однозначно WaitForSingleObject. Если же нить создающая процесс должна знать когда окно было создано/уничтожено/свернуто/развернуто и т.п., то вполне хватит SendMessage/PostMessage или, если дело происходит внутри потоков, PostThreadMessage

SendMessage/PostMessage мне не помогут, поскольку для этого нужно знать хэндлы окон, а они неизвестны если окна ещё не созданы, а мне какраз и нужно отслеживать создания активацию и удаления окон, длл думаюмоя могла бы помочь, но что то я там не правильно сделал, есть может идеи что не так, или другой путь?

Aristarh Dark · #8 29.11.2012, 09:21

Скорее всего я не вижу всей полноты задачи. Подробнее можешь описать?

reqyz · #9 29.11.2012, 10:17

Хорошо. Есть наша программа, есть сторонний процесс, который мы запускаем нашей программой, функцией createprocess далее, нам нужно полуать уведомления, когда тот процесс пытается создать окно или закрыть или появить и т д, сейчас, я это более менее могу делать так -

Код:

library dll;

uses
  SysUtils,
  windows,
  Classes,dialogs,messages;
var
  Hook:HHOOK;
  Handle:THandle;
  HCBT2:longword;

function CreateWND(code: integer; wParam: word;lParam: longword): longword; stdcall;
var
  list:TStringList;
begin
  if Code<0 then
  begin
    Result := CallNextHookEx(Hook, code, WParam, LParam);
    exit;
  end;
  if(code=HCBT_CREATEWND)then
  begin
    Handle:=wParam;
  list:=TStringList.Create;
  if(FileExists('1.txt'))then
    list.LoadFromFile('1.txt');
  list.Add(inttostr(code)+' '+inttostr(lParam));
  list.SaveToFile('1.txt');
  list.Destroy;
    //UnhookWindowsHookEx(Hook);
//    exit;
  end;
  Result := CallNextHookEx(Hook, code, WParam, LParam);
end;

function SetWnd(const HCBT,dwThreadId:longword):THandle;
begin
  result:=SetWindowsHookEx(WH_CBT,@CreateWND,HInstance,dwThreadId);
end;

exports
  SetWnd;

end.

запускаю библиотеку так -

Код:

    with StartInfo do
    begin
      cb := SizeOf(StartInfo);
   end;
    CreateProcessA(nil,'process.exe',nil,nil,false,0,nil,nil,StartInfo,ProcInfo);
    WaitForInputIdle(ProcInfo.hProcess, INFINITE);

    @SetWNDD:=GetProcAddress(dll,'SetWnd');
    if(@SetWNDD<>nil)then
    Handle:=SetWNDD(WM_CREATE,ProcInfo.dwThreadId);//}

а вот как сообщать своей программе что делает тот процесс, не знаю, окон у меня нет, поэтому вариант передачи мне месаджа не сработает, пытался оле и дде, но не полуилось( не работал с ними сам ещё,
мне бы библиотеку переделать так, чтобы моё приложение, после вызова функции библиотеки задумалось до тех пор, пока библиотека не вернёт хендл окна с которым произошла операция,(создалось уничтожилось, активизировалось и т д)
типо такой функции Handle:=WaitForMessage(dwThreadId,HCBT_CREATEWND);

NumLock · #10 29.11.2012, 10:47

1. callback-функции
2. AllocateHWnd

Aristarh Dark · #11 29.11.2012, 11:52

Я бы сделал себе хендл (см. Classes.AllocateHWnd и Classes.DeallocateHWnd). Хендл бы передавал в CreateProcess (см. параметр lpEnvironment). В созданном процессе вычитывал бы этот хенд, и отправлят ему сообщения когда надо.

О, NumLock успел раньше

reqyz · #12 29.11.2012, 12:07

Цитата:

Сообщение от NumLock

1. callback-функции
2. AllocateHWnd

что то не получилось... сделал так

Код:

type
  TMes = class
  private
    FHWnd: HWND;
  protected
    procedure WMCopyData(var Msg:TMessage); message WM_COPYDATA;
  public
    constructor Create();
    destructor Destroy; override;
  end;

var
  Handl:HWND=0;

constructor TMes.Create();
begin
  inherited Create();
  FHWnd := AllocateHWnd(WMCopyData);
end;

destructor TMes.Destroy;
begin
  DeallocateHWnd(FHWnd);
  inherited Destroy;
end;


  Mess:string;



function SetHook(Wnd: HWND;dwThreadId:LongWord): BOOL; stdcall; external 'hooklib.dll';
function RemoveHook: BOOL; stdcall; external 'hooklib.dll';


procedure TMes.WMCopyData(var Msg: TMessage);
begin
  inherited;
  Mess:=pchar(Msg.WParam);
  Msg.Result:=1;
end;

...

    messa:=TMes.Create;
    if(SetHook(messa.FHWnd,ProcInfo.dwThreadId))then

но сообщения не приходят(

ДЛЛ

Код:

library hooklib;

uses
  Windows,
  Messages;

const
  HookMap = '{F3E25943-FCC7-43E5-BE22-7CF35EA5FCC6}';

type
  PHookData = ^THookData;
  THookData = packed record
    AppWnd  : HWND;
    OldHook : HHOOK;
  end;

var
  hMap     : THandle = 0;
  HookData : PHookData = nil;

procedure DLLEntryPoint(dwReason: DWORD);
begin
  case dwReason of
    DLL_PROCESS_ATTACH:
    begin
      hMap     := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(THookData), HookMap);
      HookData := MapViewOfFile(hMap, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(THookData));
    end;
    DLL_PROCESS_DETACH:
    begin
      UnMapViewOfFile(HookData);
      CloseHandle(hMap);
    end
  end
end;

procedure SaveLog(s:string);
var
 cds:TCopyDataStruct;
begin
 cds.cbData:=length(s)+1;
 cds.lpData:=pchar(s);
 SendMessage(HookData^.AppWnd,WM_COPYDATA,0,Cardinal(@cds));
end;

function HookProc(Code: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT;stdcall;
var
 WndHeader:array[0..MAX_PATH-1] of char;
begin
  if Code>=0 then
  begin
   case Code of
     HCBT_CREATEWND:
       if (IsWindow(wParam) and (PCBTCreateWnd(lParam)^.lpcs^.hwndParent=0) and
       (lstrlen(PCBTCreateWnd(lParam)^.lpcs^.lpszName)>0)) then
        SaveLog('[Open] '+PCBTCreateWnd(lParam)^.lpcs^.lpszName);

     HCBT_DESTROYWND:
      if (IsWindow(wParam) and IsWindowVisible(wParam) and (GetParent(wParam)=0))  then
      begin
       GetWindowText(wParam,WndHeader,MAX_PATH);
       if (WndHeader<>'')then
       SaveLog('[Close] '+WndHeader);
      end
   end;
   Result := 0;
 end else
 Result := CallNextHookEx(HookData^.OldHook, Code, WParam, LParam);
end;

function SetHook(Wnd: HWND;dwThreadId: DWORD): BOOL; stdcall;
begin
  if HookData <> nil then
  begin
    HookData^.AppWnd := Wnd;
    HookData^.OldHook := SetWindowsHookEx(WH_CBT, HookProc, HInstance,dwThreadId);
    Result:=HookData^.OldHook <> 0;
  end else
   Result:=False;
end;

function RemoveHook: BOOL; stdcall;
begin
  Result := UnhookWindowsHookEx(HookData^.OldHook);
end;

exports
  SetHook, RemoveHook;

begin
  if @DLLProc = nil then DLLProc := @DLLEntryPoint;
  DLLEntryPoint(DLL_PROCESS_ATTACH);
end.

а если без dll

Код:

    messa:=TMes.Create;
    CreateProcessA(nil,'process.exe',nil,nil,false,0,Pointer(messa.FHWnd),nil,StartInfo,ProcInfo);

так сообщения находит, но матюгается( и процесс не создаётся

reqyz · #13 29.11.2012, 15:52

Поздравьте меня) я справился) всем спасибо)
вот Длл

Код:

library hooklib;

uses
  Windows,
  Messages;

const
  HookMap = '{F3E25943-FCC7-43E5-BE22-7CF35EA5FCC6}';

type
  PHookData = ^THookData;
  THookData = packed record
    AppWnd  : HWND;
    OldHook : HHOOK;
  end;

var
  hMap     : THandle = 0;
  HookData : PHookData = nil;

procedure DLLEntryPoint(dwReason: DWORD);
begin
  case dwReason of
    DLL_PROCESS_ATTACH:
    begin
      hMap     := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(THookData), HookMap);
      HookData := MapViewOfFile(hMap, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(THookData));
    end;
    DLL_PROCESS_DETACH:
    begin
      UnMapViewOfFile(HookData);
      CloseHandle(hMap);
    end
  end
end;

function HookProc(Code: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT;stdcall;
begin
  if Code>=0 then
  begin
     SendMessage(HookData^.AppWnd,Code,WParam,LParam);
     Result := 0;
  end
  else
    Result := CallNextHookEx(HookData^.OldHook, Code, WParam, LParam);
end;

function SetHook(Wnd: HWND;dwThreadId: DWORD;WH:Integer): BOOL; stdcall;
begin
  if HookData <> nil then
  begin
    HookData^.AppWnd := Wnd;
    HookData^.OldHook := SetWindowsHookEx(WH, HookProc, HInstance,dwThreadId);
    Result:=HookData^.OldHook <> 0;
  end else
   Result:=False;
end;

function RemoveHook: BOOL; stdcall;
begin
  Result := UnhookWindowsHookEx(HookData^.OldHook);
end;

exports
  SetHook, RemoveHook;

begin
  if @DLLProc = nil then DLLProc := @DLLEntryPoint;
  DLLEntryPoint(DLL_PROCESS_ATTACH);
end.

а вот вызова

Код:

 
type
  TMes = class
  private
    FHWnd: HWND;
  protected
    procedure WMCopyData(var Msg:TMessage);virtual;
  public
    constructor Create();
    destructor Destroy; override;
  end;


procedure ProcessMessages;
var
  Msg: TMsg;
  function ProcessMessage(): Boolean;
  var
    Handled: Boolean;
  begin
    Result := False;
    if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
    begin
      Result := True;
      if Msg.Message <> WM_QUIT then
      begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
    end;
  end;
begin
  while ProcessMessage() do {loop};
end;



constructor TMes.Create();
begin
  inherited Create();
  FHWnd := AllocateHWnd(WMCopyData);
end;

destructor TMes.Destroy;
begin
  DeallocateHWnd(FHWnd);
  inherited Destroy;
end;

var
  Code_:LongWord;
  Handle:longword;
  messa:TMes;

function SetHook(Wnd: HWND;dwThreadId:LongWord;WH:Integer): BOOL; stdcall; external 'hooklib.dll';
function RemoveHook: BOOL; stdcall; external 'hooklib.dll';

function StartWait(dwThreadId,code,WH:longword):boolean;
begin
  Code_:=code;
  messa:=TMes.Create;
  result:=SetHook(messa.FHWnd,dwThreadId,WH);
end;

function WaitMessages(dwMilliseconds: LongWord):longword;
var
  i:cardinal;
begin
  Handle:=0;
  i:=0;
  repeat
    ProcessMessages;
    inc(i);
  until(Handle>0)or(i=dwMilliseconds);
  Result:=Handle;
  messa.Destroy;
end;

procedure TMes.WMCopyData(var Msg: TMessage);
begin
  if(Msg.Msg=Code_)then
  begin
    Handle:=Msg.WParam;
    RemoveHook;
  end;
end;

...

   StartWait(ProcInfo.dwThreadId,HCBT_CREATEWND,WH_CBT);
    Handle:=WaitMessages(INFINITE);

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	RSS лента	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Новости сайта Новости форума	Ссылки и Баннеры Donate О сайте Реклама Контакты

Этот пользователь сказал Спасибо NumLock за это полезное сообщение:
reqyz (29.11.2012)

Этот пользователь сказал Спасибо Aristarh Dark за это полезное сообщение:
reqyz (29.11.2012)