Модераторы: Poseidon, Snowy, bems, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Использование компонента TWebBrowser, Примеры кода 
:(
    Опции темы
Vit
Дата 14.6.2002, 16:13 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Vitaly Nevzorov
****


Профиль
Группа: Экс. модератор
Сообщений: 10964
Регистрация: 25.3.2002
Где: Chicago

Репутация: 48
Всего: 207



Взято из 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;




--------------------
With the best wishes, Vit
I have done so much with so little for so long that I am now qualified to do anything with nothing
Самый большой Delphi FAQ на русском языке здесь: www.drkb.ru
PM MAIL WWW ICQ   Вверх
Good Man
Дата 14.6.2002, 23:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 33
Регистрация: 13.6.2002

Репутация: нет
Всего: нет



Не мешало бы зайти сюда IE & Delphi
PM MAIL   Вверх
Good Man
  Дата 17.6.2002, 16:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 33
Регистрация: 13.6.2002

Репутация: нет
Всего: нет



Вот еще примеры:

Код

//------------------------------------------------------------------------------------------
-

В компонент 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;

//------------------------------------------------------------------------------------------
-

PM MAIL   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »


 




[ Время генерации скрипта: 0.0525 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.