[T-dayne]

Всем привет

Есть страничка, загруженная в Twebbrowser, нужно сохранить картинку которую он УЖЕ загрузил. Извлечение ссылки и загрузка ее с сервера не подходит, т.к. это уже другая сессия. Нужно как бы нажать "сохранить изображние" на картинке, только программно(!)
2й день бьюсь. спасибо.

[T-dayne]

Склоняюсь к тому, что нельзя это реалиовать на twebbrowser, какие еще есть компоненты где бы можно это сделать?

[dr. F.I.N.]

Попробуй это:

Код:

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: Integer;
    ImgElement: IHTMLImgElement;
    URL: string;
    Buff: Pointer;
    BuffSize: DWORD;
    CacheName: string;
    NewName: string;
    P: Integer;
    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
    CacheName := '';
    URL := ImgElement.src;
    NewName := URL;
    P := LastDelimiter('/', NewName);
    if P > 0 then Delete(NewName, 1, P);
    NewName := ADir + NewName;
    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);
              end;
            finally
              Bitmap.Free;
            end;
          finally
            ElementRender := nil;
          end;
        finally;
        end;
      finally
        ImgElement := nil;
      end;
    end;
  finally
  end;
end;

Код компилится. Дальше лень было дорабатывать. Суть проста:
1. Получаем список элементов (картинок) загруженных в браузер.
2. Получаем УРЛ для этого элемента
3. Вытягиваем элемент из КЭШа по его урл.
4. Рисуем на битмап.
Ну а дальше надо битмап сохранить (тут это не доделано....я не увидел).
Вобщем, ленивый я сегодня

[T-dayne]

ого, спасибо огромное. Осталось это проверить.
Непойму что это за код:

Код:

type 
  IHTMLElementRender = interface(IUnknown) 
    ['{3050F669-98B5-11CF-BB82-00AA00BDCE0B}'] 
    function DrawToDC
      ( _hDC:                      HDC 
      ): HResult; stdcall; 
  end;

Можешь показать пример использования? Реп +

[dr. F.I.N.]

Ответ на твой первый вопрос.

Пример надо сейчас сочинить, Ну и опробовать

Ждите, сударь!

[dr. F.I.N.]

Немного тут подправил...

Код:

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 - все нормуль сохраняет.

[dr. F.I.N.]

Недостаток того что выше: любая картинца сохраниться как BMP. А если анимированный ГИФ и т.п.?

Вот что нашел:

Код:

function GetCacheFileName(const Url: string; var FileName: string): Boolean;
var
  Info: PInternetCacheEntryInfo;
  InfoBufSize: Cardinal;
begin
  Result := False;
  InfoBufSize := 0;
  GetUrlCacheEntryInfo(PChar(Url),
    TInternetCacheEntryInfo(nil^), InfoBufSize);
  if GetLastError = ERROR_INSUFFICIENT_BUFFER then begin
    GetMem(Info, InfoBufSize);
    try
      Result := GetUrlCacheEntryInfo(PChar(Url),
        TInternetCacheEntryInfo(Info^), InfoBufSize);
      if Result then begin
        FileName := Info^.lpszLocalFileName;
      end;
    finally
      FreeMem(Info);
    end;
  end;
end;

Этот код возвращает имя файла в кеше по УРЛ. Таким образом, можно код и поста выше доработать так:
1. Получаем список всех картинок на странице
2. В цикле пробегаем все и смотрим их УРЛ.
3. По УРЛ получаем имя в КЭШе и копируем из КЭШа куда нам надо

Спасибо интернету.