Downloading a list of images from a website

Hi there,

I've got a list of urls on a listbox:

for example: http://www.mysite.com/images/logo.gif
                     http://www.mysite.com/images/logos.jpg

etc....

The whole list of already on the listbox.

I need to download all the images from those links and save them with their original name.

Hope you can help

Thanks

ST3VO

ST3VOAsked:
Who is Participating?
 
diniludConnect With a Mentor Commented:
if not GetInetFile('///'+ListBox1.Items.Strings[i],
               FDestinationFolder+GetFileName(ListBox1.Items.Strings[i])) then
       ShowMessage('Error while downloading ' + ListBox1.Items.Strings[i]);


replace the above code with

if not GetInetFile(ListBox1.Items.Strings[i],
               FDestinationFolder+GetFileName(ListBox1.Items.Strings[i])) then
       ShowMessage('Error while downloading ' + ListBox1.Items.Strings[i]);
0
 
ST3VOAuthor Commented:
Hmmm...not exacly what I need....

I tried this function:

function DownloadFile(SourceFile, DestFile: string): Boolean;
begin
  try
    Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0, nil) = 0;
  except
    Result := False;
  end;
end;


and:

procedure TForm1.Button1Click(Sender: TObject);
var
  SourceFile, DestFile :string;
  i: integer;

begin
  For i:= 0 to ListBox1.Items.Count -1 do
  begin

    // Listbox1.Selected[i]:= True;
      SourceFile:=(ListBox1.Items[i]);
      DestFile:=(ListBox1.Items[i]);

//SourceFile = 'http://www.google.co.uk/intl/en_uk/images/logo.gif';
  //DestFile = 'logo.gif';
 // for i:=0 to ListBox1.Count -1;
  if DownloadFile(SourceFile, DestFile) then
  begin

  end
  else
    ShowMessage('Error while downloading ' + SourceFile)
end;
end;

Lots of rems...hehehe...I get error message all the time but it worked when I had a single Const for both the SourceFile and DestFile :(

0
Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

 
diniludCommented:
Unit1.dfm
=========

object Form1: TForm1
  Left = 135
  Top = 173
  Width = 381
  Height = 203
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object ListBox1: TListBox
    Left = 16
    Top = 8
    Width = 329
    Height = 97
    ItemHeight = 13
    Items.Strings = (
      'http://www.mysite.com/images/logo.gif'
      'http://www.mysite.com/images/logos.jpg')
    TabOrder = 0
  end
  object Button1: TButton
    Left = 64
    Top = 128
    Width = 75
    Height = 25
    Caption = 'Download'
    TabOrder = 1
    OnClick = Button1Click
  end
end


Unit.pas
========
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

Uses WinInet;

function GetInetFile (const fileURL, FileName: String): boolean;
const
  BufferSize = 1024;
var
  hSession, hURL: HInternet;
  Buffer: array[1..BufferSize] of Byte;
  BufferLen: DWORD;
  f: File;
  sAppName: string;
begin
 result := false;
 sAppName := ExtractFileName(Application.ExeName) ;
 hSession := InternetOpen(PChar(sAppName), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0) ;
 try
  hURL := InternetOpenURL(hSession, PChar(fileURL), nil, 0, 0, 0) ;
  try
   AssignFile(f, FileName) ;
   Rewrite(f,1) ;
   repeat
    InternetReadFile(hURL, @Buffer, SizeOf(Buffer), BufferLen) ;
    BlockWrite(f, Buffer, BufferLen)
   until BufferLen = 0;
   CloseFile(f) ;
   result := True;
  finally
   InternetCloseHandle(hURL)
  end
 finally
  InternetCloseHandle(hSession)
 end
end;


function GetFileName(Path: String): String;
var TmpName:String;
    StartPos:Integer;
begin
   try
      StartPos:=length(Path);
      While StartPos>0 do
      begin
        if path[StartPos]='/' then Break;
        dec(StartPos);
      end;
      Result:=copy(Path,StartPos+1,Length(path));
   except
     Result := #0;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var i:Integer;
begin
   Button1.Enabled:=False ;
   Screen.Cursor:=crHourGlass;
   for i:=0 to ListBox1.Items.Count-1 do
   begin
     if not GetInetFile('///'+ListBox1.Items.Strings[i],
               FDestinationFolder+GetFileName(ListBox1.Items.Strings[i])) then
       ShowMessage('Error while downloading ' + ListBox1.Items.Strings[i]);
   end;
   Button1.Enabled:=True;
   Screen.Cursor:=crDefault;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FDestinationFolder:= ExtractFileDir(ParamStr(0));
  if FDestinationFolder[Length(FDestinationFolder)]<>'\' then
     FDestinationFolder:=FDestinationFolder+'\';
  FDestinationFolder:=FDestinationFolder+'Files\';

  if not DirectoryExists(FDestinationFolder) then
    CreateDir(FDestinationFolder);
end;

end.
0
 
ST3VOAuthor Commented:
Hmmm I get I/O Error 1784  

It's not downloading the images from the links for some reason :(

An ideas why?

Thanks

ST3VO
0
 
diniludCommented:
Sorry this is due to this error.

procedure TForm1.Button1Click(Sender: TObject);
var i:Integer;
begin
   Button1.Enabled:=False ;
   Screen.Cursor:=crHourGlass;
   for i:=0 to ListBox1.Items.Count-1 do
   begin
     if not GetInetFile(ListBox1.Items.Strings[i],                                              
               FDestinationFolder+GetFileName(ListBox1.Items.Strings[i])) then
       ShowMessage('Error while downloading ' + ListBox1.Items.Strings[i]);
   end;
   Button1.Enabled:=True;
   Screen.Cursor:=crDefault;
end;
0
 
ST3VOAuthor Commented:
I'll give it a sho thanks :)
0
 
ST3VOAuthor Commented:
Yep...that's solved the problem!

Thanks a million :o)

-ST3VO
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.