Исходники.RU - Информационный сервер для программистов: исходники со всего света.

FAQ по использованию компонента TWebBrowser

Перевод материала с сайта members.home.com/hfournier/webbrowser.htm

Вопрос: Что такое Веббраузер?

Ответ: Веббраузер это Microsoft's Internet Explorer в виде ActiveX контрола. Его можно импортировать в Delphi IDE и размещать на форме на равне с другими компонентами. Поэтому, чтобы превратить Ваше приложение в браузер, достаточно воспользоваться всей мощью IE.

Вопрос: Где можно найти документацию на WebBrowser?

Ответ: Можно заглянуть на сайт Microsoft в раздел WebBrowser overview, а так же на страницу WebBrowser object.

Вопрос: Как использовать компонент WebBrowser в своём Delphi приложение?

Ответ: Для этого необходимо, чтобы у Вас был установлен Internet Explorer. В меню в Delphi IDE, выберите "Component - Import ActiveX Control". Далее выберите "Microsoft Internet Controls" и добавьте его как новый исполняемы пакет. Delphi сгенерирует файл ShDocVw_TLB.pas и добавит компонент WebBrowser в закладку компонентов ActiveX.

Вопрос: Я вижу 2 компонента в закладке компонетов ActiveX, WebBrowser и WebBrowser_V1. Какой из них нужно использовать?

Ответ: Если у Вас 2 компонента, то в системе установлен IE 4.x или выше. Соответственно WebBrowser это IE 4.x а WebBrowser_V1 это IE 3.x. Если Вы видете только один компонент, то будет использоваться WebBrowser для IE 3.x.

Вопрос: Как определить, какая версия IE установлена на компьютере?

Ответ: Можно почитать на Microsoft site.

Вопрос: Как производить Печать?

Ответ: Есть два способа вывода на печать. Первый пример работает в IE 4.x и выше, в то время как второй пример расчитан на IE 3.x:

var
  vaIn, vaOut: OleVariant;

...

WebBrowser.ControlInterface.ExecWB(OLECMDID_PRINT, 
                      OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);

либо

procedure TForm1.PrintIE;
var
  CmdTarget : IOleCommandTarget;
  vaIn, vaOut: OleVariant;
begin
  if WebBrowser1.Document <> nil then
    try
      WebBrowser1.Document.QueryInterface(IOleCommandTarget, CmdTarget);
      if CmdTarget <> nil then
        try
          CmdTarget.Exec( PGuid(nil), OLECMDID_PRINT, 
                         OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
        finally
          CmdTarget._Release;
        end;
    except
      // Ничего
    end;
end;

Обратите внимание: Если версия Delphi ниже чем 3.02, то необходимо заменить

PGuid(nil)

на

PGuid(nil)^

. А лучше всего проапгрейдить до 3.02 (если Вы пользуетесь версиями 3.0 или 3.01).

Вопрос: Как вызвать команды Find, Option или View Source?

Ответ: Вот пример вызова диалога Find:

const
  HTMLID_FIND       = 1;
  HTMLID_VIEWSOURCE = 2;
  HTMLID_OPTIONS    = 3;

...

procedure TForm1.FindIE;
const
  CGID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}';
var
  CmdTarget : IOleCommandTarget;
  vaIn, vaOut: OleVariant;
  PtrGUID: PGUID;
begin
  New(PtrGUID);
  PtrGUID^ := CGID_WebBrowser;
  if WebBrowser1.Document <> nil then
    try
      WebBrowser1.Document.QueryInterface(IOleCommandTarget, CmdTarget);
      if CmdTarget <> nil then
        try
          CmdTarget.Exec( PtrGUID, HTMLID_FIND, 0, vaIn, vaOut);
        finally
          CmdTarget._Release;
        end;
    except
      // Ничего
    end;
  Dispose(PtrGUID);
end;

Вопрос: Как запретить всплывающее меню при нажатии правой книпки мыши?

Ответ: Вам необходимо включить интерфейс IDocHostUIHandler. Для этого Вам понадобятся два файла: ieConst.pas и IEDocHostUIHandler.pas. В методе ShowContextMenu интерфейса IDocHostUIHandler, необходимо изменить возвращаемое значение с E_NOTIMPL на S_OK. После этого меню перестанет реагировать на правое нажатие кнопки мыши. Добавьте два модуля, упомянутые выше в секцию Uses и добавьте следующий код:

...

var
  Form1: TForm1;
  FDocHostUIHandler: TDocHostUIHandler;
...

implementation
...

procedure TForm1.FormCreate(Sender: TObject);
begin
  FDocHostUIHandler := TDocHostUIHandler.Create;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FDocHostUIHandler.Free;
end;

procedure TForm1.WebBrowser1NavigateComplete2(Sender: TObject;
  pDisp: IDispatch; var URL: OleVariant);
var
  hr: HResult;
  CustDoc: ICustomDoc;
begin
  hr := WebBrowser1.Document.QueryInterface(ICustomDoc, CustDoc);
  if hr = S_OK then
    CustDoc.SetUIHandler(FDocHostUIHandler);
end;

Вопрос: Как загрузить строковые данные в WebBrowser не прибегая к открытию файла?

Ответ: Загрузите строку массив Variant, а затем запишите в документ (Document):

...

var
  v: Variant;
  HTMLDocument: IHTMLDocument2;  
begin
  HTMLDocument := WebBrowser1.Document as IHTMLDocument2;
  v := VarArrayCreate([0, 0], varVariant);
  v[0] := HTMLString; // Это Ваша HTML строка
  HTMLDocument.Write(PSafeArray(TVarData(v).VArray));
  HTMLDocument.Close;

  ...
end;

...

Автор: Ron Loewy

Вопрос: Как загрузить потоковые(stream) данные в WebBrowser не прибегая к открытию файла?

Ответ: Вот пример кода:

function TForm1.LoadFromStream(const AStream: TStream): HRESULT;
begin
  AStream.seek(0, 0);
  Result := (WebBrowser1.Document as 
          IPersistStreamInit).Load(TStreamAdapter.Create(AStream));
end;

Автор: Per Larsen

Вопрос: Как использовать протокол "about:"?

Ответ: Протокол "about:" позволяет Вам просмотреть HTML строку:

procedure TForm1.LoadHTMLString(sHTML: String);
var
  Flags, TargetFrameName, PostData, Headers: OleVariant;
begin
  WebBrowser1.Navigate('about:' + sHTML, Flags, TargetFrameName, PostData, Headers)
end;

Вопрос: Как можно использовать протокол "res:"?

Ответ: Протокол "res:" позволяет просмотреть HTML файл, сохранённый как ресурс. Более подробная информация доступна на Microsoft site:

procedure TForm1.LoadHTMLResource;
var
  Flags, TargetFrameName, PostData, Headers: OleVariant;
begin
  WebBrowser1.Navigate('res://' + Application.ExeName + '/myhtml',
                           Flags, TargetFrameName, PostData, Headers)
end;

Создайте файл ресурса (*.rc) со следующими строками и откомпилируйте его при помощи brcc32.exe:

MYHTML 23 ".\html\myhtml.htm"

MOREHTML 23 ".\html\morehtml.htm"

Отредактируйте файл проекта, чтобы он выглядел примерно так:

{$R *.RES}
{$R HTML.RES} //где html.rc будет скомпилирован в html.res

Вопрос: Как получить полный исходник HTML?

Ответ: В IE5, можно получить исходник используя свойство outerHTML тэгов HTML. В IE4 или IE3, Вам понадобится записать документ в файл, а затем загрузить файл в TMemo, TStrings, и т.д.

var
  HTMLDocument: IHTMLDocument2;
  PersistFile: IPersistFile;
begin
  ...
  HTMLDocument := WebBrowser1.Document as IHTMLDocument2;
  PersistFile := HTMLDocument as IPersistFile;
  PersistFile.Save(StringToOleStr('test.htm'), True);

  while HTMLDocument.readyState <> 'complete' do
    Application.ProcessMessages;
	...
end;

Автор: Ron Loewy

Обратите внимание: Вам понадобится импортировать библиотеку MSHTML и добавить MSHTML_TLB как ActiveX, в секцию Uses.

Вопрос: Как получить POST данные?

Ответ: Если данные передаются в формате 'animal=cat&color=brown' и т.д., то попробуйте использовать следующий код:

procedure TDBModule.Navigate(stURL, stPostData: String; var wbWebBrowser: TWebBrowser);
var
  vWebAddr, vPostData, vFlags, vFrame, vHeaders: OleVariant;
  iLoop: Integer;
begin
  {Are we posting data to this Url?}
  if Length(stPostData)> 0 then
  begin
    {Require this header information if there is stPostData.}
    vHeaders:= 'Content-Type: application/x-www-form-urlencoded'+ #10#13#0;
    {Set the variant type for the vPostData.}
    vPostData:= VarArrayCreate([0, Length(stPostData)], varByte);
    for iLoop := 0 to Length(stPostData)- 1 do    // Iterate
    begin
      vPostData[iLoop]:= Ord(stPostData[iLoop+ 1]);
    end;    // for
    {Final terminating Character.}
    vPostData[Length(stPostData)]:= 0;
    {Set the type of Variant, cast}
    TVarData(vPostData).vType:= varArray;
  end;
  {And the other stuff.}
  vWebAddr:= stURL;
  {Make the call Rex.}
  wbWebBrowser.Navigate2(vWebAddr, vFlags, vFrame, vPostData, vHeaders);
end;  {End of Navigate procedure.}

Автор: Craig Foley

Ответ: А это другой способ:

procedure TForm1.SubmitPostForm;
var
  strPostData: string;
  Data: Pointer;
  URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
begin
  {
  <!-- submit this html form: -->
  <form method="post" action="http://127.0.0.1/cgi-bin/register.pl">
  <input type="text" name="FIRSTNAME" value="Hans">
  <input type="text" name="LASTNAME" value="Gulo">
  <input type="text" name="NOTE" value="thats it">
  <input type="submit">
  </form>
  }
  strPostData := 'FIRSTNAME=Hans&LASTNAME=Gulo&NOTE=thats+it';
  PostData :=  VarArrayCreate([0, Length(strPostData) - 1], varByte);
  Data := VarArrayLock(PostData);
  try
    Move(strPostData[1], Data^, Length(strPostData));
  finally
    VarArrayUnlock(PostData);
  end;
  URL := 'http://127.0.0.1/cgi-bin/register.pl';
  Flags := EmptyParam;
  TargetFrameName := EmptyParam;
  Headers := EmptyParam; // TWebBrowser автоматически заполнять
                         // эти заголовки соответствующими значениями
  WebBrowser1.Navigate2(URL, Flags, TargetFrameName, PostData, Headers);
end;

Автор: Hans Gulo.

Вопрос: Как сделать WebBrowser плоским вместо 3D?

Ответ: Следующий пример устанавливает borderStyle:

procedure TForm1.WBDocumentComplete(Sender: TObject; 
                      const pDisp: IDispatch; var URL: OleVariant);
var
  Doc : IHTMLDocument2;
  Element : IHTMLElement;
begin
  Doc := IHTMLDocument2(TWebBrowser(Sender).Document);
  if Doc = nil then
    Exit;
  Element := Doc.body;
  if Element = nil then
    Exit;
  case Make_Flat of
    TRUE : Element.style.borderStyle := 'none';
    FALSE : Element.style.borderStyle := '';
  end;
end;

Автор: Donovan J. Edye

Вопрос: Как сохранить веб страничку в bitmap?

Ответ: Вот пример:

procedure TForm1.Button1Click(Sender: TObject);
var
  ViewObject: IViewObject;
  sourceDrawRect: TRect;
begin
  if EmbeddedWB1.Document <> nil then
  try
    EmbeddedWB1.Document.QueryInterface(IViewObject, ViewObject);
    if ViewObject <> nil then
      try
        sourceDrawRect := Rect(0, 0, Image1.Width, Image1.Height);
        ViewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Self.Handle,
          image1.Canvas.Handle, @sourceDrawRect, nil, nil, 0);
      finally
        ViewObject._Release;
      end;
  except
  end;
end;

Автор: John

Ответ: А следующий пример позволяет сохранить её как JPEG:

procedure generateJPEGfromBrowser(browser: iWebBrowser2; jpegFQFilename: String;
  srcHeight: Integer; srcWidth: Integer; tarHeight: Integer; tarWidth: Integer);
var
  sourceDrawRect : TRect;
  targetDrawRect: TRect;
  sourceBitmap: TBitmap;
  targetBitmap: TBitmap;
  jpeg: TJPEGImage;
  viewObject: IViewObject;
begin
  sourceBitmap := TBitmap.Create ;
  targetBitmap := TBitmap.Create ;
  jpeg := TJPEGImage.Create ;
  try
    try
      sourceDrawRect := Rect(0,0, srcWidth , srcHeight );
      sourceBitmap.Width :=  srcWidth ;
      sourceBitmap.Height :=  srcHeight ;

      viewObject := browser as IViewObject;

      if viewObject = nil then
        Exit;

      OleCheck(viewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, self.Handle,
        sourceBitmap.Canvas.Handle, @sourceDrawRect, nil, nil, 0));

      // Изменяем размер исходного битмапа для конечного битмапа
      targetDrawRect := Rect(0,0, tarWidth, tarHeight);
      targetBitmap.Height := tarHeight;
      targetBitmap.Width := tarWidth;
      targetBitmap.Canvas.StretchDraw(targetDrawRect, sourceBitmap);

      // Создаём JPEG из Bitmap и сохраняем его
      jpeg.Assign(targetBitmap) ;
      makeFileWriteable(jpegFQFilename);
      jpeg.SaveToFile (jpegFQFilename);
    finally
      jpeg.free;
      sourceBitmap.free ;
      targetBitmap.free;
    end;
  except
  // Обработка ошибок
  end;
end;

Автор: Donall Burns

Вопрос: Что такое DOM?

Ответ: Document Object Model это платформенно независимый интерфейс, позволяющий программам и скриптам динамически обновлять и изменять содержимое, структуру и стиль документов.

Вопрос: Где можно почитать документацию по DOM?

Ответ: Обзор материалов по DOM на W3C site , а так же FAQ. Не забудьте заглянуть на Document object на сайте Microsoft.

Вопрос: Как работать со всеми фреймами, отображёнными в данный момент в WebBrowser?

Ответ: Данный пример показывает как определить в каких фреймах разрешена команда 'copy':

procedure TForm1.Button1Click(Sender: TObject); 
var
  i: integer; 
begin 
  for i := 0 to (WebBrowser1.OleObject.Document.frames.Length - 1) do 
    if WebBrowser1.OleObject.Document.frames.item(i).document.queryCommandEnabled('Copy') then 
      ShowMessage('copy command is enabled for frame no.' + IntToStr(i));
end;

Автор: Peter Friese

Вопрос: Как работать со всеми ячейками <TABLE>?

Ответ: Пример показывает как добавить содержимое каждой ячейки в TMemo:

procedure TForm1.Button1Click(Sender: TObject); 
var
  i, j: integer; 
  ovTable: OleVariant;
begin 
  // Я использовал первую таблицу на странице в качестве примера
  ovTable := WebBrowser1.OleObject.Document.all.tags('TABLE').item(0);
 
  for i := 0 to (ovTable.Rows.Length - 1) do
  begin
    for j := 0 to (ovTable.Rows.Item(i).Cells.Length - 1) do
    begin
      Memo1.Lines.Add(ovTable.Rows.Item(i).Cells.Item(j).InnerText;
    end;
  end;

end;

Вопрос: Paste работает отлично, но Cut и Copy отказываются работать. В чём проблема?

Ответ: Вам нужно добавить следующие строки в начало unit:

initialization
  OleInitialize(nil);

finalization
  OleUninitialize;

Вопрос: Кобинации клавиш Ctrl-C, Ctrl-O, и т.д. не срабатывают. В чём проблема?

Ответ: Это не ошибка. Информацию по данному вопросу можно найти на сайте Microsoft KnowledgeBase статья Q168777. Приведённый ниже код, устраняет данную проблему:

...

var
  Form1: TForm1;
  FOleInPlaceActiveObject: IOleInPlaceActiveObject;
  SaveMessageHandler: TMessageEvent;

...

implementation

...

procedure TForm1.FormActivate(Sender: TObject);
begin
  SaveMessageHandler := Application.OnMessage;
  Application.OnMessage := MyMessageHandler;
end;

procedure TForm1.FormDeactivate(Sender: TObject);
begin
  Application.OnMessage := SaveMessageHandler;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Application.OnMessage := SaveMessageHandler;
  FOleInPlaceActiveObject := nil;
end;

procedure TForm1.MyMessageHandler(var Msg: TMsg; var Handled: Boolean);
var
  iOIPAO: IOleInPlaceActiveObject;
  Dispatch: IDispatch;
begin
  { exit if we don't get back a webbrowser object }
  if WebBrowser = nil then
  begin
    Handled := False;
    Exit;
  end;

  Handled:=(IsDialogMessage(WebBrowser.Handle, Msg) = True);

  if (Handled) and (not WebBrowser.Busy) then
  begin
    if FOleInPlaceActiveObject = nil then
    begin
      Dispatch := WebBrowser.Application;
      if Dispatch <> nil then
      begin
        Dispatch.QueryInterface(IOleInPlaceActiveObject, iOIPAO);
        if iOIPAO <> nil then
          FOleInPlaceActiveObject := iOIPAO;
      end;
    end;

    if FOleInPlaceActiveObject <> nil then
      if ((Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP)) and
         ((Msg.wParam = VK_BACK) or (Msg.wParam = VK_LEFT) or (Msg.wParam = VK_RIGHT)) then
        //nothing - do not pass on Backspace, Left or Right arrows
      else
        FOleInPlaceActiveObject.TranslateAccelerator(Msg);
  end;
end;