• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 199
  • Last Modified:

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

0
ST3VO
Asked:
ST3VO
  • 4
  • 4
1 Solution
 
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
 
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
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
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
 
diniludCommented:
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:
I'll give it a sho thanks :)
0
 
ST3VOAuthor Commented:
Yep...that's solved the problem!

Thanks a million :o)

-ST3VO
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

  • 4
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now