На главную
ПРАВИЛА FAQ Помощь Участники Календарь Избранное DigiMania RSS
msm.ru
! Соблюдайте общие правила форума
Пожалуйста, выделяйте текст программы тегом [сode=pas] ... [/сode]. Для этого используйте кнопку [code=pas] в форме ответа или комбобокс, если нужно вставить код на языке, отличном от Дельфи/Паскаля.
Указывайте точные версии Delphi и используемых сетевых библиотек.

Не приветствуется поднятие старых тем. Если ваш вопрос перекликается со старой темой, то для вопроса лучше создать новую тему, а старую указать в первом сообщении с описанием взаимосвязи.

Внимание:
попытки открытия обсуждений реализации вредоносного ПО, включая различные интерпретации спам-ботов, наказывается предупреждением на 30 дней.
Повторная попытка - 60 дней. Последующие попытки бан.
Мат в разделе - бан на три месяца...

Полезные ссылки:
user posted image MSDN Library user posted image FAQ раздела user posted image Поиск по разделу user posted image Как правильно задавать вопросы


Выразить свое отношение к модераторам раздела можно здесь: user posted image Krid, user posted image Rouse_

Модераторы: Krid, Rouse_
  
> Сохранить картинку из TWebBrowser
    значит проблема такая
    загружаю в twebbrowser jpeg-картинку, надо ее просто сохранить или хотя бы поместить в stream, не загружая второй раз
    загружать другими способами не надо

    в поиске то что мне надо не нашел...
      Попробуй поработать через яву-скрипт.

      Что то например.....

      <script language="JavaScript">
      var img=new Image();
      img.src=".......";
      </script>


      Code
        я навер туплю но мне тупо на комп через дельфи
          Взято с DelphiWorld и немного изменено:
          ExpandedWrap disabled
            uses
              UrlMon;
             
            function DownloadFile(SourceFile, DestFile: string): Boolean;
            begin
              try
                Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0,
                  nil) = 0;
              except
                Result := False;
              end;
            end;
             
            procedure SaveAllImagesToDir(const DirPath: string;
              WB: TWebBrowser);
            var
              k, p: Integer;
              Source, dest, ext: string;
            egin
              for k := 0 to WB.OleObject.Document.Images.Length - 1 do
              begin
                Source := WB.OleObject.Document.Images.Item(k).Src;
                p := LastDelimiter('.', Source);
                ext := UpperCase(Copy(Source, p + 1, Length(Source)));
                if (ext = 'GIF') or (ext = 'JPG') or (ext = 'JPEG') then
                begin
                  p  := LastDelimiter('/', Source);
                  dest := DirPath + Copy(Source, p + 1, Length(Source));
                  DownloadFile(Source, dest);
                end;
              end;
            end;
             
            procedure TForm1.Button1Click(Sender: TObject);
            begin
              SaveAllImagesToDir('C:\Images\', WebBrowser1);
            end;

          Данный код сохранит все GIF и JPEG картинки из страницы, открытой в WebBrowser1, в папку C:\Images, сохраняя исходные имена файлов. Обращаю внимание на завершающий слэш в конце пути 'C:\Images\' и на то, что папка должна существовать.
            Цитата
            DownloadFile(Source, dest);

            эт повторная загрузка...
            мне б без нее
              Повторной загрузки быть не должно. Он картинку у себя в кэше сохраняет. По крайней мере у меня так.

              Вроде бы как-то можно ещё через IStream сохранять, сейчас посмотрю.
                Цитата Бим @
                Взято с DelphiWorld и немного изменено:
                ExpandedWrap disabled
                  uses
                    UrlMon;
                   
                  function DownloadFile(SourceFile, DestFile: string): Boolean;
                  begin
                    try
                      Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0,
                        nil) = 0;
                    except
                      Result := False;
                    end;
                  end;
                   
                  procedure SaveAllImagesToDir(const DirPath: string;
                    WB: TWebBrowser);
                  var
                    k, p: Integer;
                    Source, dest, ext: string;
                  egin
                    for k := 0 to WB.OleObject.Document.Images.Length - 1 do
                    begin
                      Source := WB.OleObject.Document.Images.Item(k).Src;
                      p := LastDelimiter('.', Source);
                      ext := UpperCase(Copy(Source, p + 1, Length(Source)));
                      if (ext = 'GIF') or (ext = 'JPG') or (ext = 'JPEG') then
                      begin
                        p  := LastDelimiter('/', Source);
                        dest := DirPath + Copy(Source, p + 1, Length(Source));
                        DownloadFile(Source, dest);
                      end;
                    end;
                  end;
                   
                  procedure TForm1.Button1Click(Sender: TObject);
                  begin
                    SaveAllImagesToDir('C:\Images\', WebBrowser1);
                  end;

                Данный код сохранит все GIF и JPEG картинки из страницы, открытой в WebBrowser1, в папку C:\Images, сохраняя исходные имена файлов. Обращаю внимание на завершающий слэш в конце пути 'C:\Images\' и на то, что папка должна существовать.

                Все работает, но выдает ошибку если в TWebBrowser вообще ничего не загружено. Подскажите как предотвратить это ошибку или вывести сообщение что картинок не найдено.
                  Добавьте проверку на существование Document. У меня сработало так:
                  ExpandedWrap disabled
                    if VarIsClear(WB.OleObject.Document) then
                    begin
                      { Объект документа не существует, делать нечего }
                      Exit;
                    end;
                  1 пользователей читают эту тему (1 гостей и 0 скрытых пользователей)
                  0 пользователей:


                  Рейтинг@Mail.ru
                  [ Script Execution time: 0,0844 ]   [ 15 queries used ]   [ Generated: 17.07.19, 09:28 GMT ]