Win7 IE11 IShellWindows 仅在某些机器上返回“未知错误”

Question

我使用以下代码检查是否已经存在具有给定 URL 位置的 Internet Explorer 11 选项卡。

我从这里的代码开始：http://francois-piette.blogspot.de/2013/01/internet-explorer-automation-part-1.html

function GetIERunningInstanceByUrl(FLogWriter: ILogWriter; const Url : String): IWebBrowser2;

  function GetClassName(aHWND : HWND) : String;
  var
      L : Integer;
  begin
      SetLength(Result, MAX_PATH * SizeOf(Char));
      L := WinApi.Windows.GetClassName(aHWND, PChar(Result), Length(Result));
      SetLength(Result, L);
  end;

var
  aShWindows : IShellWindows;
  aIdx         : Integer;
  aDisp: IDispatch;
  aClassName: string;
begin
  FLogWriter.LogMessage(ltDebug, 'GetIERunningInstanceByUrl / Url: ''' + Url + '''.');

  aShWindows := CoShellWindows.Create;
  if not Assigned(aShWindows) then begin
    FLogWriter.LogMessage(ltDebug, 'GetIERunningInstanceByUrl / After CoShellWindows.Create, not Assigned(aShWindows) = TRUE.');
  end;
  FLogWriter.LogMessage(ltDebug, 'GetIERunningInstanceByUrl / aShWindows.Count: ' + IntToStr(aShWindows.Count) + '.');

  for aIdx := 0 to aShWindows.Count - 1 do begin
    aDisp := aShWindows.Item(aIdx);
    if not Assigned(aDisp) then begin
      FLogWriter.LogMessage(ltDebug, 'GetIERunningInstanceByUrl / After aDisp := aShWindows.Item(aIdx=' + IntToStr(aIdx) + '), not Assigned(aDisp) = TRUE.');
    end
    else begin
      if not Supports(aDisp, IID_IWebBrowser2) then begin
        FLogWriter.LogMessage(ltDebug, 'GetIERunningInstanceByUrl / Supports(aDisp, IID_IWebBrowser2) = FALSE.');
      end
      else begin
        Result := aDisp as IWebBrowser2;
        if not Assigned(Result) then begin
          FLogWriter.LogMessage(ltDebug, 'GetIERunningInstanceByUrl / After Result := aDisp as IWebBrowser2, not Assigned(Result) = TRUE.');
        end
        else begin
          aClassName := GetClassName(Result.HWND);
          FLogWriter.LogMessage(ltDebug, 'GetIERunningInstanceByUrl / GetClassName(aShWindows.Item(aIdx=' + IntToStr(aIdx) + ').Result): ''' + aClassName + '''.');
        end;
      end;
    end;

    if Supports(aDisp, IID_IWebBrowser2) then begin
      if Assigned(Result) then begin
        if SameText(GetClassName(Result.HWND), 'IEFrame') then begin
          //if SameText(Url, Result.LocationURL) then begin
          if ContainsText(Result.LocationURL, Url) then begin
            FLogWriter.LogMessage(ltDebug, 'GetIERunningInstanceByUrl / Found, Result.HWND: ' + IntToStr(Result.HWND) + ', Result.LocationURL: ''' + Result.LocationURL + '''.');

            Exit;
          end
          else begin
            FLogWriter.LogMessage(ltDebug, 'GetIERunningInstanceByUrl / Not found, ContainsText(Result.LocationURL, Url) = FALSE, Result.LocationURL: ''' + Result.LocationURL + ''' .');
          end;
        end
        else begin
          aClassName := GetClassName(Result.HWND);
          FLogWriter.LogMessage(ltDebug, 'GetIERunningInstanceByUrl / Not found, SameText(GetClassName(Result.HWND), ''IEFrame'') = FALSE, aClassName: ''' + aClassName + ''' .');
        end;
      end;
    end;
  end;
  // Not found
  Result := nil;

  FLogWriter.LogMessage(ltDebug, 'GetIERunningInstanceByUrl / Not found, After Result = nil, Url: ''' + Url + '''.');
end;

该应用程序安装在所有具有 Windows 7 Professional Service Pack 1、64 位和 Internet Explorer 11（版本 11.0.9600.18762）的计算机上。

该代码在大多数机器上都可以正常运行，但在某些机器上，这种方法在多次正确运行后出现“未知错误”。

一旦出现错误，让应用程序再次运行的唯一方法是从 Windows 注销并再次登录。

不幸的是，我可能不会在那些（生产）机器上调试，所以我不得不使用穷人的调试，记录每一行......（这也是为什么我上面的代码变得有点难读的原因有些台词，抱歉。）

这样做，我发现它一定与 IShellWindows 接口有关。

10.08.2017 10:33:05 ThreadID: 0x00001A08 - GetIERunningInstanceByUrl / Url: 'https://example.com/'.
10.08.2017 10:33:05 ThreadID: 0x00001A08 - GetIERunningInstanceByUrl / aShWindows.Count: 3.
10.08.2017 10:33:05 ThreadID: 0x00001A08 - GetIERunningInstanceByUrl / GetClassName(aShWindows.Item(aIdx=0).Result): 'CabinetWClass'.
10.08.2017 10:33:05 ThreadID: 0x00001A08 - GetIERunningInstanceByUrl / Not found, SameText(GetClassName(Result.HWND), 'IEFrame') = FALSE, aClassName: 'CabinetWClass' .
10.08.2017 10:33:05 ThreadID: 0x00001A08 - Meldung - Exception: Unbekannter Fehler Retry: 1

（翻译：“Unbekannter Fehler”的意思是“未知错误”）

在上面的日志示例中，似乎只有 3 项列表中的第一项可以使用 IShellWindows 进行迭代。然后引发异常。

任何帮助将不胜感激......

Answer 1

我遇到了类似的问题 - 或者仍然有使用 IShellWindows 界面的程序。我的经验是它不依赖于机器，但可以在任何机器上发生，但我没有发现如何防止它。

对我有帮助的是停止所有资源管理器进程（而不是 Internet Explorer 进程！）。我在我的程序中执行此操作，但您也可以通过任务管理器执行此操作以进行测试。如果任务栏在单独的资源管理器进程中运行，您也必须停止它。

重新启动资源管理器后，界面再次工作。这比必须注销要好一些，因为您不需要重新启动所有应用程序，您可以在代码中执行此操作，但这当然仍然不是一个好的解决方案，因为任务栏将在此期间重建过程。

我用来关闭所有资源管理器进程并重新启动的代码如下：

function isexplorerwindow(exwnd: hwnd): boolean;
var
  p: array[0..max_path] of Char;
begin
  GetClassName(exwnd, p, SizeOf(p));
  result := ((strcomp(p, 'CabinetWClass') = 0) or (strcomp(p, 'ExploreWClass') = 0));
end;


procedure restartshell;
var
  wnd: hwnd;
  pid: dword;
  processhandle: thandle;
  SL: tstringlist;
  z: integer;
  StartUpInfo: TStartUpInfo;
  ProcessInfo: TProcessInformation;
begin
  if messagebox(0, pchar(_('Restarting the shell will close all explorer windows and the task bar.') + #13#10 +
    _('Do you really want to continue?')), __('Warning'), mb_yesno or mb_defbutton2 or mb_iconquestion) = idno then
    Exit;
  SL := tstringlist.Create;
  wnd := getwindow(getdesktopwindow, gw_child);
  while (wnd <> 0) do
  begin
    if isexplorerwindow(wnd) then
      SL.Add(inttostr(wnd));
    wnd := getwindow(wnd, gw_hwndnext);
  end;
  for z := 0 to SL.count - 1 do
    postMessage(strtoint(SL[z]), $10, 0, 0);
  SL.Free;
  application.ProcessMessages;
  sleep(1000);
  application.ProcessMessages;
  wnd := findwindow('Progman', nil);
  if wnd > 0 then
  begin
    GetWindowThreadProcessId(wnd, pid);
    if (pid > 0) then
    begin
      processhandle := OpenProcess(1, false, pid);
      if (processhandle > 0) then
      begin
        TerminateProcess(processhandle, 0);
        CloseHandle(processhandle);
      end;
    end;
  end;
  application.ProcessMessages;
  sleep(1000);
  application.ProcessMessages;
  FillChar(StartUpInfo, SizeOf(StartUpInfo), #0);
  StartUpInfo.cb := SizeOf(StartUpInfo);
  StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
  if not CreateProcess(nil, 'explorer.exe', nil, nil, false, CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil,
    StartUpInfo, ProcessInfo) then
    messagebeep(mb_iconstop);

Answer 2

你可以试试这个。它应该返回导航到给定 URL 的最顶层 IE 窗口：

function TryGetWebBrowser(const URL: WideString; out Browser: IWebBrowser2): Boolean;
var
  Handle: HWND;
  Unused: OleVariant;
  Location: OleVariant;
  WndIface: IDispatch;
  ShellWindows: IShellWindows;
begin
  Result := False;
  if Succeeded(CoCreateInstance(CLASS_ShellWindows, nil, CLSCTX_LOCAL_SERVER, IID_IShellWindows, ShellWindows)) then
  begin
    Unused := Unassigned;
    Location := URL;
    WndIface := ShellWindows.FindWindowSW(Location, Unused, SWC_BROWSER, Integer(Handle), SWFO_NEEDDISPATCH);
    Result := Assigned(WndIface) and Succeeded(WndIface.QueryInterface(IWebBrowser2, Browser));
  end;
end;