
10.10.2010, 17:01
|
 |
I Like it!
|
|
Регистрация: 12.12.2009
Адрес: Россия, г. Новосибирск
Сообщения: 663
Версия Delphi: D6/D7
Репутация: 26643
|
|
Немного тут подправил...
Код:
uses
MSHTML, WinInet;
type
IHTMLElementRender = interface(IUnknown)
['{3050F669-98B5-11CF-BB82-00AA00BDCE0B}']
function DrawToDC
( _hDC: HDC
): HResult; stdcall;
end;
procedure SaveImageFromIHtmlDocument2(AIHtmlDocument2: IHtmlDocument2; const ADir: string);
var Images: IHTMLElementCollection;
i, P: Integer;
ImgElement: IHTMLImgElement;
Buff: Pointer;
BuffSize: DWORD;
URL: String;
NewName: string;
ElementRender: IHTMLElementRender;
Bitmap: TBitmap;
begin
if not Assigned(AIHtmlDocument2) then exit;
Images := AIHtmlDocument2.images;
if not Assigned(Images) then exit;
for i := 0 to Images.length - 1 do
if Succeeded(Images.item(i, 0).QueryInterface(IHTMLImgElement, ImgElement)) then
try
URL := ImgElement.src;
NewName := URL;
P := LastDelimiter('/', NewName);
if P > 0 then Delete(NewName, 1, P);
NewName := ChangeFileExt(ADir + NewName, '.bmp');
Buff := nil;
BuffSize := 0;
if not RetrieveUrlCacheEntryFile(PChar(URL), TInternetCacheEntryInfo(Buff^), BuffSize, 0) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then
begin
GetMem(Buff, BuffSize);
try
if RetrieveUrlCacheEntryFile(PChar(URL), TInternetCacheEntryInfo(Buff^), BuffSize, 0) then
try
if Succeeded(ImgElement.QueryInterface(IHTMLElementRender, ElementRender)) then
try
Bitmap := TBitmap.Create;
try
with ImgElement as IHTMLElement, Bitmap, Canvas do
begin
Width := offsetWidth;
Height := offsetHeight;
Brush.Color := clWhite;
FillRect(ClipRect);
ElementRender.DrawToDC(Handle);
SaveToFile(NewName);
end;
finally
Bitmap.Free;
end;
finally
ElementRender := nil;
end;
finally;
end;
finally
ImgElement := nil;
end;
end;
finally
end;
end;
Вызов:
Код:
SaveImageFromIHtmlDocument2(WebBrowser1.Document as IHTMLDocument2, 'c:\');
Проверил на YA.RU и на DelphiSources.RU - все нормуль сохраняет.
|