Adding Progress Bar To This Code...

Hello,

How can I add a 'ProgressBar' to this downloader code,
http://www.scalabium.com/faq/dct0116.htm

Thx, Karamja
KaramjaAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

GloomyFriarCommented:
Are you sure that hte code work properly?
As I see It'll write at beginning of file something like this:

Tue Nov 04 20:38:48 2003 HTTP/1.1 200 OK
Tue Nov 04 20:38:48 2003 Date: Tue, 04 Nov 2003 18:43:05 GMT
Tue Nov 04 20:38:48 2003 Server: Apache
Tue Nov 04 20:38:48 2003 Last-Modified: Tue, 29 Jul 2003 11:37:46 GMT
Tue Nov 04 20:38:48 2003 ETag: "102db32-d343-3f265c8a"
Tue Nov 04 20:38:48 2003 Accept-Ranges: bytes
Tue Nov 04 20:38:48 2003 Content-Length: 54083
Tue Nov 04 20:38:48 2003 Connection: close
Tue Nov 04 20:38:48 2003 Content-Type: application/zip

By the way 'Content-Length' is what you are looking for - total length of the file.
KaramjaAuthor Commented:
The code does work, How would I use 'Content-Length'?
Eddie ShipmanAll-around developerCommented:
I found this post by Paul Gertzen to be more capable of adding a Progressbar...But I used a TGuage instead...

function TForm1.GetHTTP(URL: String; Stream: TMemoryStream;
                        TimeOut: Integer): Boolean;
var CS : TClientSocket;
    S : TWinSocketStream;
    ReceiveHeaders : TStringList;
    SendBufferStr : String;
    SendBuffer, ReceiveBuffer, HeaderBuffer : array[0..8192] Of Char;
    i, p : Integer;
    Domain, Page, PostStr : String;
    BytesRead, ContentLength, BytesSent, TotalBytesRead : Integer;
begin
  try
    // clear the stream
    Stream.Clear;
    CS := TClientSocket.Create(nil);
    ReceiveHeaders := TStringList.Create;
    try
      // remove http:// (if it is supplied) and split domain and page
      if Uppercase(Copy(URL,1,7)) = 'HTTP://' Then
       Delete(URL, 1, 7);
      p := Pos('/', URL);
      if p <> 0 Then
      begin
         Domain := Copy(URL,1,p-1);
         Page := Copy(URL,p, Length(URL));
      end
      else
      begin
         Domain := URL;
         Page := '/';
      end;
      CS.Host := Domain;
      CS.ClientType := ctBlocking;
      CS.Port := 80;
       SendBufferStr := 'GET '+Page+' HTTP/1.0'#13#10+
                        'Host: '+Domain+#13#10#13#10;
      FillChar(SendBuffer, SizeOf(SendBuffer), 0);
      FillChar(ReceiveBuffer, SizeOf(ReceiveBuffer), 0);
      FillChar(HeaderBuffer, SizeOf(HeaderBuffer), 0);
      StrPCopy(SendBuffer, SendBufferStr);
      CS.Open;
      S := TWinSocketStream.Create(CS.Socket, TimeOut);
      try
       // Send the request
       BytesSent := 0;
       while CS.Socket.Connected and (BytesSent < Length(SendBufferStr)) do
        BytesSent := BytesSent + S.Write(SendBuffer[BytesSent],
                                         Length(SendBufferStr)-BytesSent);
       // read headers, they will fit in first received packet (note: we may
       // get some of the data
       // too so we must look for double cr/lf which splits header from data
       BytesRead := S.Read(ReceiveBuffer, SizeOf(ReceiveBuffer));
       // Search for double cr/lf in received data
       for i := 0 to BytesRead do
       begin
         if (i < BytesRead - 3) and
            (ReceiveBuffer[i] = #13) and
            (ReceiveBuffer[i+1] = #10) and
            (ReceiveBuffer[i+2] = #13) and
            (ReceiveBuffer[i+3] = #10) then
         begin
           // move data into headerbuffer for easy conversion into stringlist
           Move(ReceiveBuffer[0], HeaderBuffer[0], i);
           ReceiveHeaders.Text := String(ReceiveBuffer);
           // write remaining data to stream (excl double cr/lf)
           Stream.Write(ReceiveBuffer[i+4], BytesRead-(i+4));
           Break;
         end;
       end;
       // setup totalbytesread (we may have read some into stream already)
       TotalBytesRead := Stream.Size;
       // now check for contentlength header
       BytesRead := 0;
       ContentLength := 0;
       for i := 0 to ReceiveHeaders.Count - 1 do
       begin
         if Copy(Uppercase(ReceiveHeaders[i]), 1, 16) = 'CONTENT-LENGTH: ' then
         begin
           ContentLength := StrToInt(Copy(Uppercase(ReceiveHeaders[i]), 17,
                                           Length(ReceiveHeaders[i])));
           Break;
         end;
       end;
       Gauge1.MaxValue := ContentLength;
       // if contentlength header does not exist then we will read until
       // receivelength = 0
       if ContentLength = 0 then
        repeat
          BytesRead := S.Read(ReceiveBuffer, SizeOf(ReceiveBuffer));
          Gauge1.Progress := BytesRead;
          Stream.Write(ReceiveBuffer, BytesRead);
        until (not CS.Socket.Connected) or (BytesRead = 0)
       else
        while CS.Socket.Connected and (TotalBytesRead < ContentLength) do
         begin
           BytesRead := S.Read(ReceiveBuffer, SizeOf(ReceiveBuffer));
           Gauge1.Progress := BytesRead;
           TotalBytesRead := TotalBytesRead + BytesRead;
           Stream.Write(ReceiveBuffer, BytesRead);
         end;
         Gauge1.Progress := TotalBytesRead;
       Result := True;
       CS.Close;
      finally
       s.Destroy;
      end;
    finally
      CS.Destroy;
      ReceiveHeaders.Destroy;
    end;
  except
   Result := False;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Stream : TMemoryStream;
begin
  Stream := TMemoryStream.Create;
  try
    // if you don't need to post variables then just pass nil instead of post
    // you can pass variables on the url at any time
    if not GetHTTP('http://www-tcsn.experts-exchange.com/images/logo.gif', Stream, 10000) then
      ShowMessage('Download unsuccessful')
    else
      Stream.SaveToFile('c:\eelogo.gif');
  finally
    Stream.Destroy;
  end;
end;


Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Python 3 Fundamentals

This course will teach participants about installing and configuring Python, syntax, importing, statements, types, strings, booleans, files, lists, tuples, comprehensions, functions, and classes.

GloomyFriarCommented:
>The code does work
Here it is how it work:

HTTP/1.1 200 OK
Date: Wed, 05 Nov 2003 10:12:37 GMT
Server: Apache/1.3.28 (Unix) mod_auth_passthrough/1.6 mod_log_bytes/1.2 mod_bwlimited/1.0 PHP/4.3.2 FrontPage/5.0.2.2634 mod_ssl/2.8.15 OpenSSL/0.9.6b
Last-Modified: Mon, 17 Mar 2003 12:57:53 GMT
ETag: "2b40c5-2ca9-3e75c651"
Accept-Ranges: bytes
Content-Length: 11433
Content-Type: text/html
Connection: Close

<html>

<head>
<meta http-equiv="Content-Type"
content="text/html; charset=iso-8859-1">


'Real' page text begins from <html>. The lines before it - it's the header.
But the code puts the header in destination file. It's wrong!
GloomyFriarCommented:
So you need to extract the header firstly.
Then extract the number after 'Content-Length' - it's the full file size.
Assign the number to Max of gauge or progressbar - whatever you want (Min := 1, Position := 0).
After reading the next portion of file data add its size to Position. if intReturnCode > 0 then Position := Position + _size;

By the way, it may be so that 'Content-Length' does not appear. In such a case you cannot to show 'real'  progress.
             
Eddie ShipmanAll-around developerCommented:
[quote]But the code puts the header in destination file. It's wrong![/quote]

It was not part of the requirement stated to strip out the header. It would
take only a few small changes to accomplish this with the code I posted.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.