Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: WinAPI и системное программирование > Как получить Handle чужого консольного окна?


Автор: ЧеловекБорща 1.10.2010, 20:48
Доброе время суток! 

Суть заключается в том, чтобы найти окно запускаемой программы и изменить его заголовок на свой. 
Программы запускаю в TThread используя CreateProcess.
Для получения списка окон использую EnumThreadWindows.


Код

var
  PI:TProcessInformation;

implementation

function ChangeCaptionProc(hwnd: THandle; lParam: LPARAM): Boolean; stdcall;
var
  s:PAppInfo;
begin
  Result:=True;
  s:=pointer(lParam);
  if GetWindowLong(hwnd, GWL_STYLE) and WS_CAPTION = WS_CAPTION then
  begin
    SetWindowText(hwnd,PAnsiChar(s));
  end;
end;

{................}

if not (AppInfo.AppUserCaption = '') then
begin
  EnumThreadWindows(PI.dwThreadId,@ChangeCaptionProc,Integer(AppInfo.AppUserCaption)); //передаём новый заголовок как параметр в функцию.
end;


Проблема в том что это работает только с "оконными" программами. Почему не работает с консолями? Может нужен ещё какой-нибуть флаг в GetWindowLong?   smile 

Автор: bems 1.10.2010, 20:53
До семерки консольными окнами владеет csrss.exe

Автор: ЧеловекБорща 1.10.2010, 21:09
Я ищу окно запускаемой мною программы а не окна других процессов.

Автор: bems 1.10.2010, 21:14
Консольное окно особое.
Например что происходит, когда консольная программа запускает другую (тоже консольную), а сама закрывается? Дочерний процесс будет спокойно работать со старой консолью. Это было бы невозможно, если бы консольное окно принадлежало потоку, работающему в рамках родительского процесса.
По этой причине все консольные окна должны уметь жить дольше, чем поток. А значит их нельзя получить при перечислении окон потока

Автор: ЧеловекБорща 1.10.2010, 21:21
эмм а как тогда быть? Как найти консольное окно и определить его принядлежность к процессу? 

Автор: bems 1.10.2010, 21:24
ЧеловекБорща, Сделай еще перед запуском AllocConsole и GetConsoleWindow. А потом запускай процесс, и он унаследует твою консоль

Автор: ЧеловекБорща 1.10.2010, 22:14
Спасибо за подсказку, но непонимаю как реализовать.. 
Можно привести пример пожалуйста?  smile 

Есть кусок кода:
Код

      with PI do
      begin
        SetProcessAffinityMask(hProcess, AppInfo.AppCPUAffinity);  //задаём маску проца из структуры
        WaitForSingleObject(hProcess, INFINITE);  //висим на "душой" программы
        CloseHandle(hProcess);
        CloseHandle(hThread);
      end;
        CreateProcess(
        PChar(AppInfo.AppExe),
        PChar(AppInfo.AppParamStr), nil, nil,
        False, GetPriority(AppInfo.AppPriority), nil,
        PChar(ExtractFileDir(AppInfo.AppExe)), SI, PI);       //создаём процесс

        WaitForInputIdle(PI.hProcess, 10000);      //     ждём создания всех окошек


        if not (AppInfo.AppUserCaption = '') then
        begin
          EnumThreadWindows(PI.dwThreadId,@ChangeCaptionProc,Integer(AppInfo.AppUserCaption)); //передаём параметр функции
        end;

        if AppInfo.AppStartMinimized then      //Минимизируем окошко.. если стоит галочка
        begin
        EnumThreadWindows(PI.dwThreadId,@MiniWindowProc, 0); //манипулируем с окном...
        end;

Автор: bems 2.10.2010, 07:12
Код

var ConWnd: HWND;
begin
  ConWnd := GetConsoleWindow;
  AllocConsole;
  CreateProcess(...
  манипулируемCокном(ConWnd)


Добавлено через 14 минут и 46 секунд
Или, если не желательно чтобы все процессы разделяли общею консоль, то:
CreateProcess
AttachConsole
GetConsoleWindow
FreeConsole

Автор: ЧеловекБорща 2.10.2010, 18:12
Что-то я недопонимаю.. 
Код

Function GetConsoleWindow: HWND; stdcall; external 'Kernel32.dll';
function AttachConsole(dwProcessId: Cardinal): Boolean; external kernel32 name 'AttachConsole';

implementation

{$R *.dfm}


function EnumThreadWndProc(hwnd: THandle; lParam: LPARAM): Boolean; stdcall;
var
  len: Integer;
  classname: array [0..$ff] of Char;
begin
  Result:=True;
  // если окно видимое, то
  if IsWindowVisible(hwnd) then
  begin
    if MainForm.MiniChk.Checked then
    begin
    ShowWindow(hwnd, SW_SHOWMINIMIZED);
    end;

    if MainForm.EditCaptionChk.Checked then
    begin
      SetWindowText(hwnd, PAnsiChar(MainForm.myCaptionEdit.Text));
    end;
  end;
end;

procedure TMainForm.RunCalcBtnClick(Sender: TObject);
var
  startupinfoa: _STARTUPINFOA;
  processinformation: _PROCESS_INFORMATION;
  ConWnd:HWND;
begin
  ZeroMemory(@startupinfoa, SizeOf(_STARTUPINFOA));
  startupinfoa.cb:=SizeOf(_STARTUPINFOA);
  startupinfoa.wShowWindow:=SW_SHOWNORMAL;
  CreateProcess(nil, PChar('console.exe'), nil, nil, False, 0, nil, nil, startupinfoa, processinformation);
  AttachConsole(processinformation.hProcess);
  ConWnd := GetConsoleWindow;
  // найдем все окна нашего процесса
  //EnumThreadWindows(processinformation.dwThreadId, @EnumThreadWndProc, 0);
  SetWindowText(ConWnd, PAnsiChar(MainForm.myCaptionEdit.Text));
end;


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

Автор: bems 2.10.2010, 19:59
Код

procedure TForm1.Button1Click(Sender: TObject);
const
  SleepTime = 200;
var
  si: TStartupInfo;
  pi: TProcessInformation;
  ConWnd:HWND;
  Code, Err: DWORD;
  s: String;
begin
  FillChar(si, SizeOf(si), 0);
  si.cb:=SizeOf(si);
  s := 'c:\windows\system32\cmd.exe';
  if CreateProcess(nil, @s[1], nil, nil, False, 0, nil, nil, si, pi)
     then try
            repeat
              Sleep(SleepTime);
              SetLastError(0);
              AttachConsole(pi.dwProcessId);
              Err := GetLastError;
            until (Err <> ERROR_GEN_FAILURE) or
                  not GetExitCodeProcess(pi.hProcess, Code) or
                  (Code <> STILL_ACTIVE);

            if Err = 0
               then begin
                    ConWnd := GetConsoleWindow;
                    FreeConsole                
                    SetWindowText(ConWnd, PChar(myCaptionEdit.Text));
                    end
               else RaiseLastOSError(Err);

          finally
            CloseHandle(pi.hProcess);
            CloseHandle(pi.hThread);
          end
     else RaiseLastOsError;
end;

Вот, как-то так. Время в Sleep выбирай под свою задачу (можно и убрать, но тогда будешь вхолостую жечь такты в ожидании, пока процесс создаст консоль, и мозможно поменяешь заголовок еще до того как cmd установит свой)

Автор: ЧеловекБорща 2.10.2010, 22:19
странно неработает.. 
Код

procedure TMainForm.RunCalcBtnClick(Sender: TObject);
const
  SleepTime = 200;
var
  si: TStartupInfo;
  pi: TProcessInformation;
  ConWnd:HWND;
  Code, Err: DWORD;
  s: String;
begin
  FillChar(si, SizeOf(si), 0);
  si.cb:=SizeOf(si);
  s := 'calc.exe';
  if CreateProcess(nil, @s[1], nil, nil, False, 0, nil, nil, si, pi)
     then try
            repeat
              Sleep(SleepTime);
              SetLastError(0);
              AttachConsole(pi.dwProcessId);
              Err := GetLastError;
            until (Err <> ERROR_GEN_FAILURE) or
                  not GetExitCodeProcess(pi.hProcess, Code) or
                  (Code <> STILL_ACTIVE);

            if Err = 0
               then begin
                    ConWnd := GetConsoleWindow;
                    FreeConsole;
                    SetWindowText(ConWnd, PChar(myCaptionEdit.Text));
                    end
               else ShowMessage('ERROR 1'); //<<<<<< - кричить вот здесь, заголовок не изменяет...

          finally
            CloseHandle(pi.hProcess);
            CloseHandle(pi.hThread);
          end
     else ShowMessage('Process Not Created');
end;


Комментарием отмечено. Почему-то неработает.. 

Автор: bems 2.10.2010, 23:36
У меня работало. Err чему равно?

Добавлено через 3 минуты и 42 секунды
откуда у calc.exe консоль?

Автор: ЧеловекБорща 3.10.2010, 12:47
Err равно 31. 

Calc.exe  это не калькулятор, это консолька которую я положил в папку программы. 
Код

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

begin
  { TODO -oUser -cConsole Main : Insert code here }
  Readln;
end.

Автор: bems 3.10.2010, 13:01
Сделай в теле цикла Code := 0 и скажи чему он равняется после выхода из цикла

Автор: bems 3.10.2010, 13:31
впрочем лучше присвой $FFFFFFFF

Автор: ЧеловекБорща 3.10.2010, 15:35
ничего не изменилось.. или я что-то не так сделал? 

Автор: bems 3.10.2010, 15:36
Цитата(bems @  3.10.2010,  13:01 Найти цитируемый пост)
скажи чему он равняется после выхода из цикла 

Автор: ЧеловекБорща 3.10.2010, 16:35
Непонимамаю как это сделать.  smile 

Код

const
  SleepTime = 200;
var
  si: TStartupInfo;
  pi: TProcessInformation;
  ConWnd:HWND;
  Code, Err: DWORD;
  s: String;
begin
  FillChar(si, SizeOf(si), 0);
  si.cb:=SizeOf(si);
  s := 'calc.exe';
  if CreateProcess(nil, @s[1], nil, nil, False, 0, nil, nil, si, pi)
     then try
            repeat
              Sleep(SleepTime);
              SetLastError(0);
              AttachConsole(pi.dwProcessId);
              Err := GetLastError;
              code:=0;
            until (Err <> ERROR_GEN_FAILURE) or
                  not GetExitCodeProcess(pi.hProcess, Code) or
                  (Code <> STILL_ACTIVE);

            if Err = 0
               then begin
                    ConWnd := GetConsoleWindow;
                    FreeConsole;
                    SetWindowText(ConWnd, PChar(myCaptionEdit.Text));
                    end
               else RaiseLastOSError;

          finally
            CloseHandle(pi.hProcess);
            CloseHandle(pi.hThread);
          end
     else RaiseLastOsError;
end;


Можно описать что нужно сделать чтобы посмотреть "чему оно равно после выходи из цикла"? 

Автор: bems 3.10.2010, 16:50
Вместо нуля поставь $FFFFFFFF.
В строке 31 вместо  RaiseLastOSError напиши begin AllocConsole; writeln(Code) end;
Посмотри что выведется в консоль

Автор: ЧеловекБорща 3.10.2010, 17:05
Спасибо за терпение=) 

в консоль отписало 259

Автор: bems 3.10.2010, 19:39
по логике вещей получается что такого не может быть.
давай-ка весь неработащий проект

Автор: ЧеловекБорща 3.10.2010, 20:38
Пожалуйста..

Автор: bems 3.10.2010, 21:03
Да что ж такое...
Я там не вижу попыток использовать моё решение.

Автор: ЧеловекБорща 3.10.2010, 21:45
Забыл сохранить изменения.. 

Но теперь пишет 0, но не изменяет заголовка.

Автор: bems 3.10.2010, 22:07
Постарайся перестать тупить.
Когда сказал вместо нуля поставь $FFFFFFFF, разумеется имелось в виду Code, а не Err
Это нужно было чтобы увидеть меняется ли вообще Code. 

У тебя неправильно объявлена AttachConsole, oна stdcall. Если исправить работает мой первоначальный вариант (все остальные изменения были нужны только для диагностики)

Автор: ЧеловекБорща 3.10.2010, 22:21
Вот теперь правельно! Благодарю за терпение и помощь  smile 

Код

  Function GetConsoleWindow: HWND; stdcall; external 'Kernel32.dll';
function AttachConsole(dwProcessId: Cardinal): Boolean; stdcall; external kernel32 name 'AttachConsole';

implementation

uses MainUnit;

{ TRunCalcThread }

function EnumThreadWndProc(hwnd: THandle; lParam: LPARAM): Boolean; stdcall;
var
  len: Integer;
  classname: array [0..$ff] of Char;
begin
  Result:=True;
  // если окно видимое, то
  if IsWindowVisible(hwnd) then
  begin
    if MainForm.MinmizeApplicationChk.Checked then
    begin
    ShowWindow(hwnd, SW_SHOWMINIMIZED);
    end;

    if MainForm.ChangeCaptionChk.Checked then
    begin
      SetWindowText(hwnd, PAnsiChar(MainForm.NewCaptionEdit.Text));
    end;
  end;
end;

procedure TRunCalcThread.Execute;
const
  SleepTime = 200;
var
  si: TStartupInfo;
  pi: TProcessInformation;
  ConWnd:HWND;
  Code, Err: DWORD;
  s: String;
begin
  FillChar(si, SizeOf(si), 0);
  si.cb:=SizeOf(si);
  s := 'console.exe';
  if CreateProcess(nil, @s[1], nil, nil, False, 0, nil, nil, si, pi)
     then try
            repeat
              Sleep(SleepTime);
              SetLastError(0);
              AttachConsole(pi.dwProcessId);
              Err := GetLastError;
              code:=$FFFFFFFF;
            until (Err <> ERROR_GEN_FAILURE) or
                  not GetExitCodeProcess(pi.hProcess, Code) or
                  (Code <> STILL_ACTIVE);

            if Err = 0
               then begin
                    ConWnd := GetConsoleWindow;
                    FreeConsole;
                    SetWindowText(ConWnd, PChar(MainForm.NewCaptionEdit.Text));
                    end
               else begin
               AllocConsole;
                writeln(Code);
                Readln;
                 end;

          finally
            CloseHandle(pi.hProcess);
            CloseHandle(pi.hThread);
          end
     else RaiseLastOsError;
end;


Вопрос можно считать решённым  smile 

Автор: bems 3.10.2010, 22:26
ни code:=$FFFFFFFF, ни ветка с AllocConsole не нужны

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)