Использование TidHttp для загрузки изображений в формате JPEG с URL (только те, которые существуют)? - PullRequest
Новая
       54

Использование TidHttp для загрузки изображений в формате JPEG с URL (только те, которые существуют)?

6 голосов
/ 01 декабря 2011

Я пытаюсь получить большое количество изображений из Интернета, используя компонент TidHttp.

Проблема в том, что отсутствует ряд изображений (пример: 7403, 7412 и т. Д.)

Как проверить только те, которые существуют, и сохранить их в файл? 

procedure TForm.Button1Click(Sender: TObject);
var
  MS : TMemoryStream;
  JPEGImage: TJPEGImage;
  Url, numString: String;
  I, Code: Integer;
begin
 for I := 7400 to 7500 do
 begin
 { 
   Url        :='http://www.mywebpage.com/images/DSC' + numString+  '.jpg';
   try
   idhttp1.Head(URL);
   code := idhttp1.ResponseCode;
   except on E: EIdHTTPProtocolException do
    code := idhttp1.ResponseCode;
   end;//try except
   if code = 200 then
   begin

   MS := TMemoryStream.Create;
   JPEGImage  := TJPEGImage.Create;
   try
     try
     idhttp1.Get(Url, MS); //Send the request and get the image
     code := idhttp1.ResponseCode;
     MS.Seek(0,soFromBeginning);
     JPEGImage.LoadFromStream(MS);//load the image in a Stream
     Image1.Picture.Assign(JPEGImage);//Load the image in a Timage component
     Image1.Picture.SaveToFile('C:\Museum_Data\DSC' + numString + '.jpg');
     Application.ProcessMessages;
     except
      on E: EIdHTTPProtocolException do
        code := idhttp1.ResponseCode; // or: code := E.ErrorCode;
     end; //try except
          finally
    MS.free;
    JPEGImage.Free;

  end; //try finally
  end; //if

end;
 end;

1 Ответ

11 голосов
/ 01 декабря 2011

Вам не нужно ничего делать для этого.Если вы попытаетесь получить доступ к несуществующему URL-адресу, HTTP-сервер сообщит об ошибке TIdHTTP, после чего преобразуется в исключение EIdHTTPProtocolException.Вам не нужно сначала звонить по номеру TIdHTTP.Head(), поскольку вы загружаете изображения в TMemoryStream перед их сохранением.Вы можете поймать исключение при вызове TIdHTTP.Get() самостоятельно, совсем не нужно проверять ResponseCode.

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

procedure TForm.Button1Click(Sender: TObject); 
var 
  MS: TMemoryStream; 
  JPEG: TJPEGImage; 
  Url: String; 
  I: Integer; 
begin 
  MS := TMemoryStream.Create;
  try
    JPEG := TJPEGImage.Create; 
    try 
      for I := 7400 to 7500 do 
      begin 
        Url := 'http://www.mywebpage.com/images/DSC' + IntToStr(I) +  '.jpg';
        MS.Clear;
        try
          IdHTTP1.Get(Url, MS);
        except
          on E: EIdHTTPProtocolException do 
            Continue;
        end;
        MS.Position := 0; 
        JPEG.LoadFromStream(MS);
        Image1.Picture.Assign(JPEG);
        JPEG.SaveToFile('C:\Museum_Data\DSC' + IntToStr(I) + '.jpg'); 
        Application.ProcessMessages; 
      end;
    finally
      JPEG.Free;
    end;
  finally 
    MS.Free;
  end;
end;

На самом деле TImage вДля сохранения данных в файл.Если вы можете опустить этап TImage.Picture.Assign(), то код будет немного проще, исключив TJPEGImage в целом (если вы не пытаетесь проверить правильность загружаемых файлов), например: 

procedure TForm.Button1Click(Sender: TObject); 
var 
  MS: TMemoryStream; 
  Url: String; 
  I: Integer; 
begin 
  MS := TMemoryStream.Create;
  try
    for I := 7400 to 7500 do 
    begin 
      Url := 'http://www.mywebpage.com/images/DSC' + IntToStr(I) +  '.jpg';
      MS.Clear;
      try
        IdHTTP1.Get(Url, MS);
      except
        on E: EIdHTTPProtocolException do 
          Continue;
      end;
      MS.Position := 0; 
      MS.SaveToFile('C:\Museum_Data\DSC' + IntToStr(I) + '.jpg'); 
      Application.ProcessMessages; 
    end;
  finally 
    MS.Free;
  end;
end;

Или:

procedure TForm.Button1Click(Sender: TObject); 
var 
  FS: TFileStream; 
  Url, FileName: String; 
  I: Integer; 
begin 
  for I := 7400 to 7500 do 
  begin 
    Url := 'http://www.mywebpage.com/images/DSC' + IntToStr(I) +  '.jpg';
    FileName := 'C:\Museum_Data\DSC' + IntToStr(I) + '.jpg'; 
    FS := TFileStream.Create(FileName, fmCreate);
    try
      try
        try
          IdHTTP1.Get(Url, FS);
        except
          on E: EIdHTTPProtocolException do 
            Continue;
        end;
        Application.ProcessMessages; 
      finally
        Fs.Free;
      end;
    except
      DeleteFile(FileName);
    end;
  end;
end;
...