Программирование на Delphi

FAQ VCL
Компоненты\WebBrowser

:: Меню ::

:: На главную ::

:: FAQ ::

:: Заметки ::

:: Практика ::

:: Win API ::

:: Проекты ::

:: Скачать ::

:: Секреты ::

:: Ссылки ::

:: Сервис ::

:: Написать ::

:: MVP ::

:: RSS ::

Как обновить содержимое TWebBrowser?


uses
  MSHTML;

function WB_DocumentLoaded(WB: TWebBrowser ): Boolean;
var
  iDoc: IHtmlDocument2;
begin
  Result := False;

  if Assigned(WB) then
  begin
    if WB.Document <> nil then
    begin
      WB.ControlInterface.Document.QueryInterface(IHtmlDocument2, iDoc);
      Result := Assigned(iDoc);
    end;
  end;
end;

procedure WB_Refresh(WB: TWebBrowser);
const
  REFRESH_COMPLETELY = 3;
var
  KeyState: TKeyBoardState;
  RefreshLevel: OleVariant;
begin
  if WB_DocumentLoaded(WB) then
  begin
    GetKeyboardState(KeyState);

    try
      if not ((KeyState[vk_Control] and 128) <> 0) then
        WB.Refresh
      else
        RefreshLevel := REFRESH_COMPLETELY;
      WB.DefaultInterface.Refresh2(RefreshLevel);
    except
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  WB_Refresh(WebBrowser1);
end;

Как проверить, находится ли TWebBrowser (и IE) в режиме автономной работы или нет?


function IsGlobalOffline: Boolean;
var
  dwState: DWORD;
  dwSize: DWORD;
begin
 dwState := 0;
 dwSize := SizeOf(dwState);
 Result := False;
 if (InternetQueryOption(nil, INTERNET_OPTION_CONNECTED_STATE, @dwState, dwSize)) then
   if ((dwState and INTERNET_STATE_DISCONNECTED_BY_USER) <> 0) then
     Result := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  case isGlobalOffline of
    True: ShowMessage('Режим автономной работы включен');
    False: ShowMessage('Режим автономной работы выключен');
  end;
end;

// Подобного результата можно добиться отредактировав реестр по адресу
// HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\GlobalUserOffline

Как в TWebBrowser показать окно предварительного просмотра перед печатью?


uses
  MSHTML;

function WB_DocumentLoaded(WB: TWebBrowser): Boolean;
var
  iDoc: IHtmlDocument2;
begin
  Result := False;

  if Assigned(WB) then
  begin
    if WB.Document <> nil then
    begin
      WB.ControlInterface.Document.QueryInterface(IHtmlDocument2, iDoc);
      Result := Assigned(iDoc);
    end;
  end;
end;

procedure WB_ShowPrintPreview(WB: TWebBrowser);
var
  vaIn, vaOut: OleVariant;
begin
  if WB_DocumentLoaded(WB) then
  try
    WB.ControlInterface.ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
  except
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  WB_ShowPrintPreview(WebBrowser1);
end;

Как в TWebBrowser показать диалог "Параметры страницы"?


uses
  MSHTML;

function WB_DocumentLoaded(WB: TWebBrowser ): Boolean;
var
  iDoc: IHtmlDocument2;
begin
  Result := False;

  if Assigned(WB) then
  begin
    if WB.Document <> nil then
    begin
      WB.ControlInterface.Document.QueryInterface(IHtmlDocument2, iDoc);
      Result := Assigned(iDoc);
    end;
  end;
end;

procedure WB_ShowPageSetup(WB: TWebBrowser);
var
  vaIn, vaOut: OleVariant;
begin
  if WB_DocumentLoaded(WB) then
  try
    WB.ControlInterface.ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_PROMPTUSER, vaIn, vaOut);
  except
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  WB_ShowPageSetup(WebBrowser1);
end;

Как в TWebBrowser показать диалог поиска?


uses
  ActiveX, MSHTML;

procedure InvokeCMD(WB: TWebbrowser; InvokeIE: Boolean; Value1, Value2: Integer; var vaIn, vaOut: OleVariant);
const
  CGID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}';
var
  CmdTarget: IOleCommandTarget;
  PtrGUID: PGUID;
begin
  New(PtrGUID);

  if InvokeIE then
    PtrGUID^ := CGID_WebBrowser
  else
    PtrGuid := PGUID(nil);

  if WB.Document <> nil then
  try
    WB.Document.QueryInterface(IOleCommandTarget, CmdTarget);
    if CmdTarget <> nil then
    try
      CmdTarget.Exec(PtrGuid, Value1, Value2, vaIn, vaOut);
    finally
      CmdTarget._Release;
    end;
  except
  end;
  Dispose(PtrGUID);
end;

procedure WB_ShowFindDialog(WB: TWebBrowser);
const
  HTMLID_FIND = 1;
var
  vaIn, vaOut: OleVariant;
begin
  InvokeCMD(WB, True, HTMLID_FIND, 0, vaIn, vaOut);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  WB_ShowFindDialog(WebBrowser1);
end;

Как в TWebBrowser показать исходный код страницы?


uses
  ActiveX, MSHTML;

procedure InvokeCMD(WB: TWebBrowser; InvokeIE: Boolean; Value1, Value2: Integer; var vaIn, vaOut: OleVariant);
const
  CGID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}';
var
  CmdTarget: IOleCommandTarget;
  PtrGUID: PGUID;
begin
  New(PtrGUID);

  if InvokeIE then
    PtrGUID^ := CGID_WebBrowser
  else
    PtrGuid := PGUID(nil);

  if WB.Document <> nil then
  try
    WB.Document.QueryInterface(IOleCommandTarget, CmdTarget);
    if CmdTarget <> nil then
    try
      CmdTarget.Exec(PtrGuid, Value1, Value2, vaIn, vaOut);
    finally
      CmdTarget._Release;
    end;
  except
  end;
  Dispose(PtrGUID);
end;

procedure WB_ShowSourceCode(WB: TWebbrowser);
const
  HTMLID_VIEWSOURCE = 2;
var
  vaIn, vaOut: OleVariant;
begin
  InvokeCMD(WB, True, HTMLID_VIEWSOURCE, 0, vaIn, vaOut);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  WB_ShowSourceCode(WebBrowser1);
end;

Как установить значение ZOOM'а текста для TWebBrowser?


uses
  ActiveX, MSHTML;

type
  TWBFontSize = 0..4;

function WB_DocumentLoaded(WB: TWebBrowser): Boolean;
var
  iDoc: IHtmlDocument2;
begin
  Result := False;
  if Assigned(WB) then
  begin
    if WB.Document <> nil then
    begin
      WB.ControlInterface.Document.QueryInterface(IHtmlDocument2, iDoc);
      Result := Assigned(iDoc);
    end;
  end;
end;

procedure WB_SetZoom(WB: TWebBrowser; Size: TWBFontSize);
var
  v: OleVariant;
begin
  if WB_DocumentLoaded(WB) then
  begin
    // if (WB.QueryStatusWB(OLECMDID_ZOOM) and OLECMDF_SUPPORTED) = 0 then
    //   Exit;
    v := Size;
    WB.ExecWB(OLECMDID_ZOOM, OLECMDEXECOPT_DODEFAULT {OLECMDEXECOPT_PROMPTUSER}, v);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  WB_SetZoom(WebBrowser1, 2);
  // 0: Самый мелкий
  // 1: Мелкий
  // 2: Средний
  // 3: Крупный
  // 4: Самый крупный
end;

Как получить значение ZOOM'а текста для TWebBrowser?


uses
  ActiveX, MSHTML, MSHTML;

type
  TWBFontSize = 0..4;

procedure InvokeCMD(WB: TWebbrowser; InvokeIE: Boolean; Value1, Value2: Integer; var vaIn, vaOut: OleVariant);
const
  CGID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}';
var
  CmdTarget: IOleCommandTarget;
  PtrGUID: PGUID;
begin
  New( PtrGUID );

  if InvokeIE then
    PtrGUID^ := CGID_WebBrowser
  else
    PtrGuid := PGUID(nil);

  if WB.Document <> nil then
  try
    WB.Document.QueryInterface(IOleCommandTarget, CmdTarget);
    if CmdTarget <> nil then
    try
      CmdTarget.Exec(PtrGuid, Value1, Value2, vaIn, vaOut);
    finally
      CmdTarget._Release;
    end;
  except
  end;
  Dispose(PtrGUID);
end;

function WB_DocumentLoaded(WB: TWebBrowser): Boolean;
var
  iDoc: IHtmlDocument2;
begin
  Result := False;
  if Assigned(WB) then
  begin
    if WB.Document <> nil then
    begin
      WB.ControlInterface.Document.QueryInterface(IHtmlDocument2, iDoc);
      Result := Assigned(iDoc);
    end;
  end;
end;

function WB_GetZoom(WB: TWebBrowser): TWBFontSize;
var
  vaIn, vaOut: Olevariant;
begin
  Result := 0;

  if WB_DocumentLoaded(WB) then
  begin
    // if (WB.QueryStatusWB(OLECMDID_ZOOM) and OLECMDF_SUPPORTED) = 0 then
    //   Exit;
    // vaIn := Null;
    InvokeCmd(WB, False, OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
    // или проще
    // WB.ExecWB(OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, Null, vaOut);
    Result := vaOut;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  case WB_GetZoom(WebBrowser1) of
    0: ShowMessage('Самый мелкий');
    1: ShowMessage('Мелкий');
    2: ShowMessage('Средний');
    3: ShowMessage('Крупный');
    4: ShowMessage('Самый крупный');
  end;
end;

Как получить cookie из TWebBrowser?


// Способ первый
uses
  MSHTML;

function WB_DocumentLoaded(WB: TWebBrowser): Boolean;
var
  iDoc: IHtmlDocument2;
begin
  Result := False;

  if Assigned(WB) then
  begin
    if WB.Document <> nil then
    begin
      WB.ControlInterface.Document.QueryInterface(IHtmlDocument2, iDoc);
      Result := Assigned(iDoc);
    end;
  end;
end;

function WB_GetCookie(WB: TWebBrowser): string;
var
  document: IHTMLDocument2;
begin
  Result := '';

  if WB_DocumentLoaded(WB) then
  begin
    document := WB.Document as IHTMLDocument2;
    if Assigned(document) then
      Result := document.cookie;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(WB_GetCookie(WebBrowser1));
end;

// Способ второй
WebBrowser1.OleObject.Document.cookie

Как перехватить открытие страницы в новом окне (target="_blank"), и открыть ее в другом экземпляре TWebBrowser?


procedure TForm1.FormCreate(Sender: TObject);
begin
  WebBrowser1.Navigate('http://decoding.dax.ru/link/main.html');
  WebBrowser2.Navigate('about:blank');
end;

procedure TForm1.WebBrowser1NewWindow2(ASender: TObject; var ppDisp: IDispatch;
  var Cancel: WordBool);
begin
  ppDisp := WebBrowser2.ControlInterface;
end;

При использовании материала - ссылка на сайт обязательна