我正在尝试以 Delphi 形式托管其他应用程序，但我发现获取窗口句柄的例程不一致。
例如，如果我启动 notepad.exe，下面的例程找不到任何与进程 ID 匹配的窗口句柄。然而，其他应用程序（例如我自己的 Delphi 构建的应用程序）被发现了。这个例程基于我发现的许多例子，但我无法弄清楚我遗漏了什么。
function enum_windows_callback(Handle: HWND; LParam: longint): bool; stdcall;
begin
Result := true;
var obj: TfHostApplication := TfHostApplication(Pointer(lParam)^);
var process_id: Cardinal := 0;
GetWindowThreadProcessId(Handle, &process_id);
if (obj.process_id = process_id) and (handle <> 0) then //and is_main_window(handle) then
obj.AppWindowHandles.Add(handle);
end;
procedure TfHostApplication.HostApplication(fn: string);
var
Rec: TShellExecuteInfo;
Title: string;
const
AVerb = 'open';
AParams = '';
ADir = '';
begin
FillChar(Rec, SizeOf(Rec), #0);
Rec.cbSize := SizeOf(Rec);
Rec.fMask := SEE_MASK_NOCLOSEPROCESS;
Rec.lpVerb := PChar( AVerb );
Rec.lpFile := PChar( fn );
Rec.lpParameters := PChar( AParams );
Rec.lpDirectory := PChar( Adir );
Rec.nShow := SW_HIDE;
// Run the application
if ShellExecuteEx(@Rec) then
begin
// Wait for it to become ideal i.e. finished loading
WaitForInputIdle(Rec.hProcess, 5000);
// Get the list of window handles for this process
AppWindowHandles.Clear;
ProcessHandle := Rec.hProcess;
process_id := GetProcessId(Rec.hProcess);
EnumWindows(@enum_windows_callback, integer(@Self));
if AppWindowHandles.Count > 1 then
begin
// if there is more than 1 window then display a list for the user to choose
lbWindows.Items.Clear;
var def := 0;
for var hwd in AppWindowHandles do
begin
var Len := GetWindowTextLength(hwd) + 1;
SetLength(Title, Len);
GetWindowText(hwd, PChar(Title), Len);
Title := Trim(Title);
lbWindows.Items.Add(Title);
end;
PanelSel.Visible := true;
PanelSel.align := alClient;
end
else if AppWindowHandles.Count > 0 then
begin
// if there is only 1 window then just use this.
SelectedWindowHandle := AppWindowHandles[0];
ShowAppInWindow;
end
else
DoCloseView;
end;
end;
procedure TfHostApplication.lbWindowsClick(Sender: TObject);
begin
inherited;
PanelSel.Visible := false;
if lbWindows.ItemIndex < AppWindowHandles.Count then
begin
SelectedWindowHandle := AppWindowHandles[lbWindows.ItemIndex];
SelectedWindowName := lbWindows.Items[lbWindows.ItemIndex];
ShowAppInWindow;
end;
end;
procedure TfHostApplication.ShowAppInWindow;
begin
Windows.SetParent(SelectedWindowHandle, Handle );
var Style := GetWindowLongPtr(SelectedWindowHandle, GWL_STYLE);
Style := Style and (not (WS_BORDER + WS_DLGFRAME + WS_THICKFRAME));
SetWindowLongPtr(SelectedWindowHandle, GWL_STYLE, Style);
Resize;
ShowWindow(SelectedWindowHandle, SW_SHOW);
end;
使用 CreateProcess 而不是 SheelExecute 似乎可以解决找到句柄的问题。
function TfHostApplication.StartApplication(fn: string): Cardinal;
var
StartupInfo: TStartupInfo;
Command: string;
begin
Result := 0;
FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
StartupInfo.cb := SizeOf(TStartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := SW_HIDE;
Command := '"' + fn + '"';
if CreateProcess(nil, PChar(Command), nil, nil, False, 0, nil, nil, StartupInfo, ProcessInfo) then
begin
ProcessHandle := ProcessInfo.hProcess;
Result := ProcessInfo.dwProcessId;
end;
end;
procedure TfHostApplication.HostApplication(fn: string);
var
Title: string;
begin
process_id := StartApplication(fn);
if process_id > 0 then
begin
// Wait for it to become ideal i.e. finished loading
WaitForInputIdle(ProcessInfo.hProcess, 5000);
WaitForSingleObject(ProcessInfo.hProcess, 5000);
// Get the list of window handles for this process
AppWindowHandles.Clear;
SelectedWindowHandle := Windows.FindWindow(PWideChar(TPath.GetFileNameWithoutExtension(FAppFileName)), nil );
if SelectedWindowHandle <> 0 then
ShowAppInWindow
else
begin
EnumWindows(@enum_windows_callback, NativeInt(Self));
if AppWindowHandles.Count > 1 then
begin
// if there is more than 1 window then display a list for the user to choose
lbWindows.Items.Clear;
var def := 0;
for var hwd in AppWindowHandles do
begin
var Len := GetWindowTextLength(hwd) + 1;
SetLength(Title, Len);
GetWindowText(hwd, PChar(Title), Len);
Title := Trim(Title);
lbWindows.Items.Add(Title);
end;
// Check to see if the selected window is already in the parameters
var sIdx := lbWindows.Items.IndexOf(FSelectedWindowName);
if (sIdx > -1) and (sIdx < AppWindowHandles.Count) then
begin
SelectedWindowHandle := AppWindowHandles[sIdx];
ShowAppInWindow;
end
else
begin
PanelSel.Visible := true;
PanelSel.align := alClient;
end;
end
else if AppWindowHandles.Count > 0 then
begin
// if there is only 1 window then just use this.
SelectedWindowHandle := AppWindowHandles[0];
ShowAppInWindow;
end
else
DoCloseView;
end;
end;
end;
procedure TfHostApplication.lbWindowsClick(Sender: TObject);
begin
inherited;
PanelSel.Visible := false;
if (lbWindows.ItemIndex > -1) and (lbWindows.ItemIndex < AppWindowHandles.Count) then
begin
SelectedWindowHandle := AppWindowHandles[lbWindows.ItemIndex];
SelectedWindowName := lbWindows.Items[lbWindows.ItemIndex];
ShowAppInWindow;
end;
end;
procedure TfHostApplication.ShowAppInWindow;
begin
// Set the window parent
Windows.SetParent(SelectedWindowHandle, Handle );
var Style := GetWindowLongPtr(SelectedWindowHandle, GWL_STYLE);
Style := Style and (not (WS_BORDER + WS_DLGFRAME + WS_THICKFRAME));
SetWindowLongPtr(SelectedWindowHandle, GWL_STYLE, Style);
Resize;
ShowWindow(SelectedWindowHandle, SW_SHOW);
BringWindowToTop(SelectedWindowHandle);
end;
例如，如果我启动 notepad.exe，下面的例程找不到任何与进程 ID 匹配的窗口句柄
原因是在 64 位版本的 Windows 上默认启动 64 位版本的记事本。由于您的程序是 32 位的，因此您无法从任何 64 位应用程序/进程访问进程信息。
您需要使用 64 位版本的应用程序才能从 64 位应用程序中检索进程信息。
注意：您可以手动启动位于
\Windows\SysWOW64