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

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

:: Меню ::

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

:: FAQ ::

:: Заметки ::

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

:: Win API ::

:: Проекты ::

:: Скачать ::

:: Секреты ::

:: Ссылки ::

:: Сервис ::

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

:: MVP ::

:: RSS ::

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


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;

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;

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;

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