Solved

Please can anyone Fix this code... (Downloading a file from the Net)

Posted on 2004-08-09
20
294 Views
Last Modified: 2010-04-05
Hi There!
I need help.. pls help me out to solve this problem... I want a "TProgressbar to indicates the download, TLabel gets the time left to finish the download file and the current downloading speed in KB/s?"...


[code]

function DownloadMyFile(SourceFile, DestFile: string): Boolean;
begin
Form1.ProgressBar1.Position:=0;
Form1.ProgressBar1.Max:=
  try
    Result :=  UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0, nil) = 0;
Form1.ProgressBar1.Position:=
Form1.kbps.Caption:=
Form1.TimeLeft.Caption:=

  except
    Result := False;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 if DownloadFile(edit1.text ,edit2.text) then
begin
MessageDlg('Download Successful!',mtInformation, [mbOK], 0);
 ShellExecute(Application.Handle, PChar('open'), PChar(Edit2.Text), PChar(''), nil, SW_NORMAL);
end
  else
MessageDlg('Error downloading the file!', mtError, [mbOK], 0)
end;

end.
[/code]


Please complete this unfinished code.. Thanks in advance!
0
Comment
Question by:goaman
  • 6
  • 5
  • 5
  • +1
20 Comments
 
LVL 5

Expert Comment

by:Darth_helge
ID: 11759886
take a look at this:

http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20887936.htm

They're using the IdHttp component.....
0
 
LVL 12

Expert Comment

by:Ivanov_G
ID: 11760101
this is exactly what you need - IBindStatusCallBack

you can look how to do it from here:
http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20349921.html
0
 
LVL 5

Expert Comment

by:Darth_helge
ID: 11760116
isn't it easier to use the Indy Component IdHttp? less code writing?
0
 

Author Comment

by:goaman
ID: 11761025
Hi  Darth_helge,
The link is Not Found on the server...
The requested URL /Programming/Programming_Languages/Delphi/Q_20887936.htm was not found on this server.


Hi Ivanov_G,
This article seems a little mess, no progressbar, no speed showing or anything.. only form1 caption shows the downloading bytes.. pls Help me... Could you pls fix the code that I've posted up there... the way I wanted... or is there any better example which shows progressbar, time left and kb/s while downloading?

If anyone need I can increase the points... just let me know...pls, I really need this...

Thanx in advance!
0
 
LVL 5

Expert Comment

by:Darth_helge
ID: 11761041
I forgot the last letter....

I think that by doing this way it's a lot more easier.

http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20887936.html
0
 

Author Comment

by:goaman
ID: 11761099
Darth_helge,
I saw that code b4... and yes it's easy way but I wanna know how to do without IdHTTP component + This example doesn't have everything I need.. :(
0
 
LVL 12

Expert Comment

by:Ivanov_G
ID: 11761117
the question I gave you doesn't use TidHTTP...
0
 

Author Comment

by:goaman
ID: 11761198
Ivanov_G  yes, it doesn't use IdHTTP component...  but the example is not advanced... could you please edit that example and place there progressbar to show the downloading and the problem is I don't know how to show Downloading Speed and Tlabel which shows the time how long will it take to download the file.. could you give me a hand in this?
0
 
LVL 5

Expert Comment

by:Darth_helge
ID: 11761216
<<I saw that code b4... and yes it's easy way but I wanna know how to do without IdHTTP component + This example doesn't have everything I need.. :(
   ok, I can't see why you don't wanna use that component, but in that case, Ivanov_G has a great answer for you.

Maybe you can fill me in Ivanov? Why is the interface you are suggesting better than TIdHTTP?
0
 
LVL 12

Expert Comment

by:Ivanov_G
ID: 11761597
Darth_helge, did I said it is better ?! If so, pleaso quote my word where I claim this...
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 5

Expert Comment

by:Darth_helge
ID: 11761717
Ivanov, I was not intending to be rude. By all means, I respect your answer, and I am sure that you are a much better programmer than me.
I was simply curious about your solution, and what is good about it.

As I could see from mine and your solutions, I saw that mine was less complex and did the same thing (I think...).
But maybe e.g your solution i faster or more secure or more flexible...   ..I don't know. That was the thing I asked you about.

Sorry if I made you upset

0
 
LVL 12

Expert Comment

by:Ivanov_G
ID: 11761900
I just gave a suggestion, the author if the one who choose the solution. I also think you solution is more simple and easier to implement.
0
 
LVL 26

Expert Comment

by:EddieShipman
ID: 11774997
Try this modification of using IBindStatusCallBack to see how it works. Also, you are going
to need to get the file size BEFORE downloading so you can set the Progressbar's Max property.


unit Unit1;

interface

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

type
  TBindStatusCallback = class(TObject, IBindStatusCallback)
  protected
     FRefCount: Integer;
     // IUnknown
     function QueryInterface(const IID: TGUID; out Obj): Integer; stdcall;
     function _AddRef: Integer; stdcall;
     function _Release: Integer; stdcall;
  public
     // IBindStatusCallback
    function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall;
    function GetPriority(out nPriority): HResult; stdcall;
    function OnLowResource(reserved: DWORD): HResult; stdcall;
    function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG;
                        szStatusText: LPCWSTR): HResult; stdcall;
    function OnStopBinding(hresult: HResult; szError: LPCWSTR):
             HResult; stdcall;
    function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo):
             HResult; stdcall;
    function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc;
                             stgmed: PStgMedium): HResult; stdcall;
    function OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult; stdcall;
  end;

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

var
  Form1: TForm1;
  bsc: TBindStatusCallback;


implementation

{$R *.dfm}


function GetEstimatedCompletion(ATtlFileSize, ACompletedBytes: Integer; ABgTime: TDateTime): String;
var
  LeftTime: TDateTime;
begin
  Result     := '';
  LeftTime   := (Now - ABgTime) / ACompletedBytes* (ATtlFileSize- ACompletedBytes);
  Result     := FormatDateTime('hh:nn:ss', LeftTime);
end;

function TBindStatusCallback.QueryInterface(const IID: TGUID;
  out Obj): Integer;
begin
  if GetInterface(IID, Obj) then Result := S_OK
                            else Result := E_NOINTERFACE; end;

function TBindStatusCallback._AddRef: Integer;
begin
 Inc(FRefCount);
 Result := FRefCount;
end;

function TBindStatusCallback._Release: Integer;
begin
 Dec(FRefCount);
 Result := FRefCount;
end;

function TBindStatusCallback.GetBindInfo(out grfBINDF: DWORD;
  var bindinfo: TBindInfo): HResult;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.GetPriority(out nPriority): HResult;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnDataAvailable(grfBSCF, dwSize: DWORD;
  formatetc: PFormatEtc; stgmed: PStgMedium): HResult;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnLowResource(reserved: DWORD): HResult;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnObjectAvailable(const iid: TGUID;
  punk: IUnknown): HResult;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnStartBinding(dwReserved: DWORD;
  pib: IBinding): HResult;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnStopBinding(hresult: HResult;
  szError: LPCWSTR): HResult;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnProgress(ulProgress, ulProgressMax,
  ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
begin
  // Do something, for example, show progress:
  Form1.Caption:='Downloaded: '+IntToStr(ulProgress) +' bytes';
  Form1.ProgressBar1.Position :=  ulProgress;
  // To PREVENT Divide By Zero Errors!!
  if ulProgress > 0 then
  begin
    Form1.StatusBar1.Panels[0].Text := 'Estimated Completion time: ' +
           GetEstimatedCompletion(giFileSize, ulProgress, gdtBegtime);
  end;
  Result := S_OK;
  // Place some abort flag here. For demo purpose here, cancel when
  // CancelButton.Tag is set to 1:
  if Form1.CancelButton.Tag = 1 then
  begin
     Result := E_ABORT;
     Form1.Caption:='Download aborted!'
     // Reset the CancelButton's tag
     Form1.CancelButton.Tag := 0;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  // you need to get the file size and set the Progressbar's Max property
  // here.
  case
  URLDownloadToFile(nil,
                    'http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_21087833.html',
                    'c:\ee-question.html', 0 , bsc);
end;

procedure TForm1.CancelButtonClick(Sender: TObject);
begin
  case TButton(Sender).Tag of
    0: TButton(Sender).Tag := 1;
    1: TButton(Sender.Tag := 0; // should never go here because it is reset in OnProgress.
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  bsc:=TBindStatusCallback.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  bsc.Free;
end;

end.
0
 

Author Comment

by:goaman
ID: 11775708
hi EddieShipman,
I'm getting List index out of bounds(0)..
0
 
LVL 26

Expert Comment

by:EddieShipman
ID: 11777104
You must have more than one panel in your statusbar. I think that is where it is coming from.
0
 
LVL 26

Expert Comment

by:EddieShipman
ID: 11777118
You can also change this line:
 Form1.StatusBar1.Panels[0].Text := 'Estimated Completion time: ' +
           GetEstimatedCompletion(giFileSize, ulProgress, gdtBegtime);

to this if SimpleText is True:

 Form1.StatusBar1.SimpleText := 'Estimated Completion time: ' +
           GetEstimatedCompletion(giFileSize, ulProgress, gdtBegtime);
0
 

Author Comment

by:goaman
ID: 11777344
It's working only when I set it to form1.caption:= 'Estimated Completion time: ' +
           GetEstimatedCompletion(giFileSize, ulProgress, gdtBegtime);

because form1 freezing while downloading except the form1.caption and progressbar




I think there is something wron with this function:

function GetEstimatedCompletion(ATtlFileSize, ACompletedBytes: Integer; ABgTime: TDateTime): String;
var
  LeftTime: TDateTime;
begin
  Result     := '';
  LeftTime   := (Now - ABgTime) / ACompletedBytes* (ATtlFileSize- ACompletedBytes);
  Result     := FormatDateTime('hh:nn:ss', LeftTime);
end;


because it's showing the system's current time..
0
 
LVL 26

Accepted Solution

by:
EddieShipman earned 500 total points
ID: 11777862
No, there is nothing wrong with that function.
It worked fine for me when I had a statusbar with two panels.

OK here's one that is working and not freezing:

unit Unit1;

interface

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

type
  TBindStatusCallback = class(TObject, IBindStatusCallback)
  protected
     FRefCount: Integer;
     // IUnknown
     function QueryInterface(const IID: TGUID; out Obj): Integer; stdcall;
     function _AddRef: Integer; stdcall;
     function _Release: Integer; stdcall;
  public
     // IBindStatusCallback
    function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall;
    function GetPriority(out nPriority): HResult; stdcall;
    function OnLowResource(reserved: DWORD): HResult; stdcall;
    function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG;
                        szStatusText: LPCWSTR): HResult; stdcall;
    function OnStopBinding(hresult: HResult; szError: LPCWSTR):
             HResult; stdcall;
    function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo):
             HResult; stdcall;
    function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc;
                             stgmed: PStgMedium): HResult; stdcall;
    function OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult; stdcall;
  end;

  TForm1 = class(TForm)
    GoButton: TButton;
    StatusBar1: TStatusBar;
    ProgressBar1: TProgressBar;
    CancelButton: TButton;
    procedure GoButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure CancelButtonClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  bsc: TBindStatusCallback;
  giFileSize: Integer;
  gdtBegtime: TDateTime;


implementation

{$R *.dfm}


function GetEstimatedCompletion(ATtlFileSize, ACompletedBytes: Integer; ABgTime: TDateTime): String;
var
  LeftTime: TDateTime;
begin
  Result     := '';
  LeftTime   := (Now - ABgTime) / ACompletedBytes* (ATtlFileSize- ACompletedBytes);
  Result     := FormatDateTime('hh:nn:ss', LeftTime);
end;

function TBindStatusCallback.QueryInterface(const IID: TGUID;
  out Obj): Integer;
begin
  if GetInterface(IID, Obj) then Result := S_OK
                            else Result := E_NOINTERFACE; end;

function TBindStatusCallback._AddRef: Integer;
begin
 Inc(FRefCount);
 Result := FRefCount;
end;

function TBindStatusCallback._Release: Integer;
begin
 Dec(FRefCount);
 Result := FRefCount;
end;

function TBindStatusCallback.GetBindInfo(out grfBINDF: DWORD;
  var bindinfo: TBindInfo): HResult;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.GetPriority(out nPriority): HResult;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnDataAvailable(grfBSCF, dwSize: DWORD;
  formatetc: PFormatEtc; stgmed: PStgMedium): HResult;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnLowResource(reserved: DWORD): HResult;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnObjectAvailable(const iid: TGUID;
  punk: IUnknown): HResult;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnStartBinding(dwReserved: DWORD;
  pib: IBinding): HResult;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnStopBinding(hresult: HResult;
  szError: LPCWSTR): HResult;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnProgress(ulProgress, ulProgressMax,
  ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
begin
  // Do something, for example, show progress:
  Form1.Caption:='Downloaded: '+IntToStr(ulProgress) +' bytes';
  Form1.ProgressBar1.Position :=  ulProgress;
  Application.ProcessMessages;
  // To PREVENT Divide By Zero Errors!!
  if ulProgress > 0 then
  begin
    Form1.StatusBar1.Panels[1].Text := 'Estimated Completion time: ' +
           GetEstimatedCompletion(giFileSize, ulProgress, gdtBegtime);
  end;
  Result := S_OK;
  // Place some abort flag here. For demo purpose here, cancel when
  // CancelButton.Tag is set to 1:
  if Form1.CancelButton.Tag = 1 then
  begin
     Result := E_ABORT;
     Form1.Caption:='Download aborted!';
     // Reset the CancelButton's tag
     Form1.CancelButton.Tag := 0;
  end;
end;

procedure TForm1.GoButtonClick(Sender: TObject);
begin
  // you need to get the file size and set the Progressbar's Max property
  // here.
  URLDownloadToFile(nil,
                    'http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_21087833.html',
                    'c:\ee-question.html', 0 , bsc);
end;

procedure TForm1.CancelButtonClick(Sender: TObject);
begin
  case TButton(Sender).Tag of
    0: TButton(Sender).Tag := 1;
    1: TButton(Sender).Tag := 0; // should never go here because it is reset in OnProgress.
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  ProgressBarStyle: LongInt;
begin
  bsc:=TBindStatusCallback.Create;
  ProgressBarStyle:=GetWindowLong(ProgressBar1.Handle,GWL_EXSTYLE);
  ProgressBarStyle:=ProgressBarStyle-WS_EX_STATICEDGE;
  SetWindowLong(ProgressBar1.Handle,GWL_EXSTYLE, ProgressBarStyle);
  ProgressBar1.Parent := StatusBar1;
  // for example put ProgressBar in Panel[1] and set position and size:
  ProgressBar1.Left:=2;
  ProgressBar1.Top:=2;
  ProgressBar1.Height:=StatusBar1.Height-2;
  ProgressBar1.Width:=StatusBar1.Panels.Items[0].Width-2;
  // set min/max values:
  ProgressBar1.Min:=0;
  ProgressBar1.Max:=102400;
  ProgressBar1.Step:=1;
  ProgressBar1.Position:=0;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  bsc.Free;
end;

end.

DFM:
object Form1: TForm1
  Left = 280
  Top = 81
  Width = 870
  Height = 640
  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
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object GoButton: TButton
    Left = 28
    Top = 20
    Width = 75
    Height = 25
    Caption = 'GO'
    TabOrder = 0
    OnClick = GoButtonClick
  end
  object StatusBar1: TStatusBar
    Left = 0
    Top = 594
    Width = 862
    Height = 19
    Panels = <
      item
        Width = 300
      end
      item
        Width = 50
      end>
    SimplePanel = False
  end
  object ProgressBar1: TProgressBar
    Left = 0
    Top = 581
    Width = 862
    Height = 13
    Align = alBottom
    Min = 0
    Max = 100
    TabOrder = 2
  end
  object CancelButton: TButton
    Left = 28
    Top = 56
    Width = 75
    Height = 25
    Caption = 'Cancel'
    TabOrder = 3
    OnClick = CancelButtonClick
  end
end
0
 
LVL 26

Expert Comment

by:EddieShipman
ID: 11777945
Ok, I see what is wrong, now. We are not setting the gdtBegTime and giFileSize.
You need to do that when the GoButton is clicked.

procedure TForm1.GoButtonClick(Sender: TObject);
begin
  // you need to get the file size and set the Progressbar's Max property
  // here.
  gdtBegtime := Now;
  giFileSize := 76738; // Get the file size and set here, this is value only for demo purposes.
  ProgressBar1.Max:=giFileSize;
  URLDownloadToFile(nil,
                    'http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_21087833.html',
                    'c:\ee-question.html', 0 , bsc);
end;
0
 
LVL 26

Expert Comment

by:EddieShipman
ID: 11778074
I have modified this to get the filesize using idHTTP.Head, however, this site sometimes does not return
complete headers, I don't know why. It doesn't send Content-Length all the time like the RFC specifies that
it should, but of course, EE isn't very good at following standards, especially Web UI standards. You will
have to test with your URLs.

If you don't want to use TidHTTP to get the file size, you will have to use other WinInet means.


procedure TForm1.GoButtonClick(Sender: TObject);
var
  sURL: String;
  sFileSize: String;
begin
  sURL := 'http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_21087833.html';
  // you need to get the file size and set the Progressbar's Max property
  // here.
  idHTTP1.Head(sURL);
  idHTTP1.Head(sURL);
  sFileSize := idHTTP1.Response.RawHeaders.Values['Content-Length'];
  if sFileSize <> '' then
    giFileSize := StrToInt(sFileSize)
  else
    giFileSize := 0;
  gdtBegtime := Now;
  ProgressBar1.Max:=giFileSize;
  URLDownloadToFile(nil, PChar(sURL), 'c:\ee-question.html', 0 , bsc);
end;
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
This video discusses moving either the default database or any database to a new volume.
This tutorial demonstrates a quick way of adding group price to multiple Magento products.

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now