Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Работа с сетью в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 26.02.2012, 22:25   #1
RiseD
 
Регистрация: 11.11.2011
Сообщений: 7
По умолчанию [delphi] скачивание картинок

Есть некий сайт с картинками. http://public.overpro.ru/screens/2012.02.26/

там скриншоты всех игроков overpro за определенную дату.

собственно задача: скачать обсолютно все скриншоты
присвоить им имена 1,2,3 и тд. так же нужно записать в тхт файл примерно следущее [ пусть до ссылки / имя файла(в который переименовали 1,2 и тп) ]

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

спасибо.
RiseD вне форума Ответить с цитированием
Старый 26.02.2012, 23:32   #2
Delphi_ProGer
Форумчанин
 
Регистрация: 30.10.2010
Сообщений: 524
По умолчанию

Здесь вам нужно всё отпарсить, получить ссылки, скачать фото.
Сейчас помогу со скачкой:

Код:
procedure TVK_Thread.LoadPhoto(link: string; image: TImage);
var
strStream: String;
memStream: TMemoryStream;
jpegimg: TJPEGImage;
begin
try
strStream := Idhttp.Get(link);
except
//ShowMessage('Image was not found');
Exit;
end;
memStream := TMemoryStream.Create;
jpegimg := TJPEGImage.Create;
try
memStream.Write(strStream[1], Length(strStream));
memStream.Position := 0;
jpegimg.LoadFromStream(memStream);
image.Picture.Assign(jpegimg);
finally
memStream.Free;
jpegimg.Free;
end;
end;
idhttp - обьект класса TIdhttp (Indy).
Код:
idhttp:=Tidhttp.create(nil);
- это создать, а освободить память:
Код:
idhttp.free;
Delphi_ProGer вне форума Ответить с цитированием
Старый 27.02.2012, 00:03   #3
Человек_Борща
Старожил
 
Аватар для Человек_Борща
 
Регистрация: 30.12.2009
Сообщений: 11,426
По умолчанию

Delphi_ProGer, пичалька. Можно же в сам Stream сохранять. Зачем сы в строку а затем в бинарь перегоняете?

Тс, банально получаете все http:// ссылки(там это просто при помощи Copy,pos,PosEx,Delete или же RegEx),далее если в конце нет .jpg а есть / то это каталог.. и таким образом у нас рекурсия. И так тыкаемся по всем каталогам и качаем все что заканчивается на .jpg

начиная с 1, считаем вхождения в каталог, и при каждом новом вхождении делаем так s:=s+/IntToStr(ivhod), пока не наткнемсяна файл, качаем его и сохраняем в получившемся пути.

В общем не сложно.
Человек_Борща вне форума Ответить с цитированием
Старый 27.02.2012, 00:36   #4
RiseD
 
Регистрация: 11.11.2011
Сообщений: 7
По умолчанию

Цитата:
Сообщение от Человек_Борща Посмотреть сообщение
Delphi_ProGer, пичалька. Можно же в сам Stream сохранять. Зачем сы в строку а затем в бинарь перегоняете?

Тс, банально получаете все http:// ссылки(там это просто при помощи Copy,pos,PosEx,Delete или же RegEx),далее если в конце нет .jpg а есть / то это каталог.. и таким образом у нас рекурсия. И так тыкаемся по всем каталогам и качаем все что заканчивается на .jpg

начиная с 1, считаем вхождения в каталог, и при каждом новом вхождении делаем так s:=s+/IntToStr(ivhod), пока не наткнемсяна файл, качаем его и сохраняем в получившемся пути.

В общем не сложно.
примерно понял что нужно, но совершенно не могу себе представить реализацию(

Дошел до того, что вывел в Memo исходный тест первой страницы.(indy). однако с парсингом проблемы

точнее как проблемы. там вся страница в ссылках.
непонятно вот это

Цитата:
и таким образом у нас рекурсия. И так тыкаемся по всем каталогам и качаем все что заканчивается на .jpg

начиная с 1, считаем вхождения в каталог, и при каждом новом вхождении делаем так s:=s+/IntToStr(ivhod), пока не наткнемсяна файл, качаем его и сохраняем в получившемся пути.
Код:
procedure TForm1.Button1Click(Sender: TObject);
label met;
var
 html,output:WideString;
 i:integer;
 tagHtml:TStringList;
begin
   try
    output:='';
    IdHTTP1.Request.AcceptCharSet:='utf-8';
    html:=IdHTTP1.Get('http://public.overpro.ru/screens/2012.02.26/');
    met:
     begin
      if pos('<A HREF=',html)<>0 then
       begin
        inc(count);
        ProgressBar1.Max:=count;
        output:='';
        Delete(html,1,pos('<A HREF=',html)+length('<A HREF=')-1);
        output:=copy(html,1,pos('>',html)-1);
        if pos('http',output)<>0 then
         begin
          for i:=0 to tagHtml.Count-1 do
           begin
            if pos(tagHtml.Strings[i],output)<>0 then
             Delete(output,pos(tagHtml.Strings[i],output),length(output));
           end;
          ListBox1.Items.Add(output);
          ProgressBar1.Position:=ProgressBar1.Position+1;
         end;
        goto met
       end
      else
       exit;
     end;
     tagHtml.Free;
   except
    on e:Exception do
     tagHtml.Free;
   end;
end;
возвращает пустое значение, хотя с другими сайтами работает

Последний раз редактировалось Stilet; 27.02.2012 в 09:47.
RiseD вне форума Ответить с цитированием
Старый 27.02.2012, 09:26   #5
Slym
Участник клуба
 
Регистрация: 07.12.2011
Сообщений: 1,025
По умолчанию

Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP,IdGlobal,ComObj,StrUtils;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
const
  Server='http://public.overpro.ru';
  StartupDir='/screens/2012.02.26/';

procedure ParseHTML(Stream:TStream;URLs:TStrings);
  function StrToXmlDocument(const Str:string):variant;
  const EMsg='Can''t load XML: (%d) %s, at line %d pos %d';
  var E:variant;
  begin
    result:=CreateOleObject('Msxml2.DOMDocument') as IDispatch;
    if not result.loadXML(Str) then
    begin
      E:=result.parseError;
      raise Exception.CreateFmt(EMsg,[integer(E.errorCode),string(E.reason),integer(E.line),integer(E.linepos)]);
    end;
  end;
var
  html:string;
  a,All_a:string;
  xml,a_nodes:variant;
  i:integer;
begin
  Stream.Seek(0,soBeginning);
  SetLength(html,Stream.Size);
  Stream.ReadBuffer(html[1],Stream.Size);
  All_a:='';
  while length(html)>0 do
  begin
    Fetch(html,'<A',true,false);
    a:=Fetch(html,'</A>',true,false);
    if length(a)=0 then continue;
    All_a:=All_a+#13#10+'<A'+a+'</A>';
  end;
  All_a:='<ALL>'+All_a+'</ALL>';
  xml:=StrToXmlDocument(All_a);
  a_nodes:=xml.selectNodes('ALL/A/@HREF');
  for i:=0 to a_nodes.length-1 do
    URLs.Add(a_nodes.item[i].Text);
end;

procedure ProcessURL(const Folder:string);
var
  Stream:TMemoryStream;
  HTTP:TIDHTTP;
  ContentType,s:string;
  URLS:TStringList;
  i:integer;
begin
  Stream:=TMemoryStream.Create;
  try
    HTTP:=TIDHTTP.Create;
    try
      HTTP.Get(Server+Folder,Stream);
      ContentType:=HTTP.Response.ContentType;
    finally
      HTTP.Free;
    end;
    if AnsiContainsText(ContentType,'text/html') then
    begin
      URLS:=TStringList.Create;
      try
        ParseHTML(Stream,URLS);
        for i:=1 to URLS.Count-1 do
        begin
          ProcessURL(URLS[i]);
        end;
      finally
        URLS.Free;
      end;
    end;
    if AnsiContainsText(ContentType,'image/jpeg') then
    begin
      s:=StringReplace(Folder,'/','\',[rfReplaceAll]);
      Stream.SaveToFile('jpg\'+ExtractFileName(s));
    end;
  finally
    Stream.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ProcessURL(StartupDir);
end;

end.
Не стесняемся, плюсуем!
Slym вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
скачивание картинок с demotivators.ru Pein95 Работа с сетью в Delphi 9 05.02.2012 14:16
Delphi - совмещение двух картинок Usov Общие вопросы Delphi 2 20.04.2011 20:34
Delphi Добавление картинок в DBGrid и DBGridEh, Как добавить изображения в таблицу zerdalert БД в Delphi 0 20.04.2011 01:30
Сравнение 2-х картинок [Delphi] Lemo Помощь студентам 1 13.01.2011 22:57