Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 1 749

Раздел: Delphi » Работа с сетями и протоколами
/ вопрос решён /

Здравствуйте, уважаемые эксперты!
Можно ли через Delphi сохранить указанную web-страницу и как? Спасибо.

Евгений Eklmn Вопрос решён, но можно продолжить его обсуждение в мини-форуме

Вопрос задал: Евгений Eklmn (статус: Посетитель)
Вопрос отправлен: 4 июля 2008, 15:57
Состояние вопроса: решён, ответов: 2.

Ответ #1. Отвечает эксперт: Feniks

Здравствуйте, Трофимов Евгений!
Держите несколько примеров в Приложении:
1. Как сохранить веб страничку в bitmap?
2. Как сохранить веб страничку в jpg?
3. Как сохранить все картинки TWebbrowser?
4. Как сохранить исходник HTML из TWebBrowser.Document на диск?
5. Как получить полный исходник HTML?

Желаю удачи.

Приложение:
  1.  
  2. procedure TForm1.Button1Click(Sender: TObject);
  3. var
  4. ViewObject: IViewObject;
  5. sourceDrawRect: TRect;
  6. begin
  7. if EmbeddedWB1.Document < > nil then
  8. try
  9. EmbeddedWB1.Document.QueryInterface(IViewObject, ViewObject);
  10. if ViewObject < > nil then
  11. try
  12. sourceDrawRect := Rect(0, 0, Image1.Width, Image1.Height);
  13. ViewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Self.Handle,
  14. image1.Canvas.Handle, @sourceDrawRect, nil, nil, 0);
  15. finally
  16. ViewObject._Release;
  17. end;
  18. except
  19. end;
  20. end;
  21.  
  22.  
  23. procedure generateJPEGfromBrowser(browser: iWebBrowser2; jpegFQFilename: String;
  24. srcHeight: Integer; srcWidth: Integer; tarHeight: Integer; tarWidth: Integer);
  25. var
  26. sourceDrawRect : TRect;
  27. targetDrawRect: TRect;
  28. sourceBitmap: TBitmap;
  29. targetBitmap: TBitmap;
  30. jpeg: TJPEGImage;
  31. viewObject: IViewObject;
  32. begin
  33. sourceBitmap := TBitmap.Create ;
  34. targetBitmap := TBitmap.Create ;
  35. jpeg := TJPEGImage.Create ;
  36. try
  37. try
  38. sourceDrawRect := Rect(0,0, srcWidth , srcHeight );
  39. sourceBitmap.Width := srcWidth ;
  40. sourceBitmap.Height := srcHeight ; viewObject := browser as IViewObject; if viewObject = nil then
  41. Exit; OleCheck(viewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, self.Handle,
  42.  
  43. targetDrawRect := Rect(0,0, tarWidth, tarHeight);
  44. targetBitmap.Height := tarHeight;
  45. targetBitmap.Width := tarWidth;
  46.  
  47. jpeg.Assign(targetBitmap) ;
  48. makeFileWriteable(jpegFQFilename);
  49. jpeg.SaveToFile (jpegFQFilename);
  50. finally
  51. jpeg.free;
  52. sourceBitmap.free ;
  53. targetBitmap.free;
  54. end;
  55. except
  56.  
  57. end;
  58. end;
  59.  
  60.  
  61. uses
  62. UrlMon;
  63.  
  64. function DownloadFile(SourceFile, DestFile: string): Boolean;
  65. begin
  66. try
  67. Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0,
  68. nil) = 0;
  69. except
  70. Result := False;
  71. end;
  72. end;
  73.  
  74. procedure TForm1.Button1Click(Sender: TObject);
  75. var
  76. k, p: Integer;
  77. Source, dest, ext: string;
  78. begin
  79. for k := 0 to WebBrowser1.OleObject.Document.Images.Length - 1 do
  80. begin
  81. Source := WebBrowser1.OleObject.Document.Images.Item(k).Src;
  82. p := LastDelimiter('.', Source);
  83. ext := UpperCase(Copy(Source, p + 1, Length(Source)));
  84. if (ext = 'GIF') or (ext = 'JPG') then
  85. begin
  86. p := LastDelimiter('/', Source);
  87. dest := ExtractFilePath(ParamStr(0)) + Copy(Source, p + 1,
  88. Length(Source));
  89. DownloadFile(Source, dest);
  90. end;
  91. end;
  92. end;
  93.  
  94.  
  95.  
  96.  
  97.  
  98.  
  99.  
  100. procedure TForm1.SaveHTMLSourceToFile(const FileName: string;
  101. WB: TWebBrowser);
  102. var
  103. PersistStream: IPersistStreamInit;
  104. FileStream: TFileStream;
  105. Stream: IStream;
  106. SaveResult: HRESULT;
  107. begin
  108. PersistStream := WB.Document as IPersistStreamInit;
  109. FileStream := TFileStream.Create(FileName, fmCreate);
  110. try
  111. Stream := TStreamAdapter.Create(FileStream, soReference) as IStream;
  112. SaveResult := PersistStream.Save(Stream, True);
  113. if FAILED(SaveResult) then
  114. MessageBox(Handle, 'Fail to save HTML source', 'Error', 0);
  115. finally
  116.  
  117.  
  118. FileStream.Free;
  119. end;
  120. end;
  121.  
  122. procedure TForm1.Button1Click(Sender: TObject);
  123. begin
  124. if SaveDialog1.Execute then
  125. SaveHTMLSourceToFile(SaveDialog1.FileName, WebBrowser1);
  126. end;
  127.  
  128. try
  129. WebBrowser1.ExecWB(4, 0);
  130. except
  131. on E: Exception do msError:=true;
  132. end;
  133.  
  134.  
  135.  
  136.  
  137.  
  138. var
  139. HTMLDocument: IHTMLDocument2;
  140. PersistFile: IPersistFile;
  141. begin
  142. ...
  143. HTMLDocument := WebBrowser1.Document as IHTMLDocument2;
  144. PersistFile := HTMLDocument as IPersistFile;
  145. PersistFile.Save(StringToOleStr('test.htm'), True);
  146. while HTMLDocument.readyState < > 'complete' do
  147. Application.ProcessMessages;
  148. ...
  149. end;
  150.  
  151.  


Ответ отправил: Feniks (статус: Бакалавр)
Время отправки: 4 июля 2008, 18:01
Оценка за ответ: 5

Ответ #2. Отвечает эксперт: min@y™

Внесу свои 5 копеек. Вот мой класс для закачки web-страниц на винт без участия TWebBrowser. Там используются таке функции модуля WinInet как:


  • InternetOpenUrl()
  • InternetReadFile()
  • InternetQueryDataAvailable()

Прикрепляю модуль как файл.
К ответу прикреплён файл. Загрузить » (срок хранения: 60 дней с момента отправки ответа)

Ответ отправил: min@y™ (статус: Доктор наук)
Время отправки: 5 июля 2008, 09:38
Оценка за ответ: 5


Мини-форум вопроса

Всего сообщений: 1; последнее сообщение — 5 июля 2008, 13:39; участников в обсуждении: 1.
Вадим К

Вадим К (статус: Академик), 5 июля 2008, 13:39 [#1]:

А помоему, за такие вопросы нужно банить задающих. Неужели так сложно просмотреть список уже заданных вопросов и найти там готовые. например вопрос 1721. Близкие 1603, 1608, 1636. Это только беглый просмотр.
А также зайти в радел статей и найти там несколько готовых статей на эту тему
Synapse
Читаем цитаты с bash.org.ru своей программой
Скачиваем файлы из интернета
Галочка "подтверждения прочтения" - вселенское зло.

31 января 2011, 19:31: Статус вопроса изменён на решённый (изменил модератор Ерёмин А.А.): Автоматическая обработка (2 и более ответов с оценкой 5)

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 22 февраля 2025, 12:03
Выполнено за 0.02 сек.