Платные хостинги     Раскрутка сайта     Книги по программированию

Использование компонента TWebBrowser, Примеры кода

- Взято из FAQ:http://blackman.km.ru/myfaq/cont4.phtmlПеревод материала с сайта 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; // TWebBrowse                         // эти заголовки соответствующими значениями  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;

- Не мешало бы зайти сюда IE & Delphi

- Вот еще примеры:Код //-------------------------------------------------------------------------------------------В компонент TWebBrowser получаю Web страничку. Вопрос: Как загрузить ее исходный текст (*.htm) в TMemo. Спасибо. TForm1.Button2Click(Sender: TObject);var ih: IHTMLDocument2;    i: Integer;    v: OleVariant;begin Memo1.Lines.Clear; ih := IUnknown(WebBrowser1.Document) as IHTMLDocument2; for i := 0 to ih.all.length - 1 do     begin       v := ih.all.item(i, "");       if v.tagName = "HTML" then          begin            Memo1.Lines.Add(" " + v.outerHTML);            Break;          end;     end;end;//-------------------------------------------------------------------------------------------Нужно сахранять все картинки из HTML файла загруженного в WebBrowser или вembeddedwb.Var  Doc : IHTMLDocument2;  All : IHTMLElementCollection;  Item : OleVariant;  Len,i : Integer;  S : String;begin  Doc :=nil;  Doc := WebBrowser1.Document as IHTMLDocument2;  while doc.readyState<>'complete' do application.ProcessMessages;  All := Doc.All;  Len := All.Length;  for i := 0 to Len - 1 do    begin     Item := All.Item(i, varEmpty);     if Item.Tagname='B' then// здесь пишешь интересующие тебя теги        begin          S:=Item.InnerText; // if S содержит ссылку на картинку то                             // выделяем из S путь к картинке и далее по потребностям....        end;end;//-------------------------------------------------------------------------------------------Мне необходимо проанализировать содержимое html-документа, загруженного в TwebBrowser. В частности получить весь список ссылок на странице. var ih: IHTMLDocument2;    i: Integer;    v: OleVariant;    S:String;begin    ih := IUnknown(WEBBROWSER1.DOCUMENT) as IHTMLDocument2;    for i := 0 to ih.images.length - 1 do      begin       v := ih.images.item(i, '');       S:=v.Src; // Строка      end;end;//-------------------------------------------------------------------------------------------Знает ли кто-нибудь из вас каким образом можно в компоненте WebBrowser изменять кодировки. Очень нужно !!!! Если кто знает пишите на мыло ! Заранее благодарен !var doc: iHTMLDocument2;begin doc:=IUnknown(WebBrowser.Document) as iHTMLDocument2; if Assigned(doc) then    begin      {Устанавливаем кодировку основного документа}      doc.Set_charset('koi8-r'); //'windows-1251'      WebBrowser.Refresh2;    end;end;//-------------------------------------------------------------------------------------------Подскажите пожалуйста как получить интерфейс IHTMLTxtRange от WebBrowser.Заранее благодарен с уважением.var a:IHTMLTxtRange; s:String;begin a:=IHTMLDocument2(webbrowser1.Document).selection.createRange as IHTMLTxtRange;  s:=(IHTMLDocument2(webbrowser1.Document).selection.createRange as IHTMLTxtRange).text; //-------------------------------------------------------------------------------------------highlightSyntax('delphixNGJlZ','delphi');

Интернет казино     Онлайн игры     Увеличение члена     Купить DVD