Главная » Delphi » Интернет и сети » Как скачать файл из интернету и показать прогресс. [Wininet]

Как скачать файл из интернету и показать прогресс. [Wininet]

20:51
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Wininet, StdCtrls, ComCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    ProgressBar1: TProgressBar;
    StatusBar1: TStatusBar;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    function DownloadURL(AUrl, TargetDir: string):
      Boolean;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
function fName(AUrl: string): string;
var
  i: integer;
begin
  result := '';
  for i := length(AUrl) downto 0 do
  begin
    if AUrl[i] = '/' then exit;
    result := AUrl[i] + result;
 
  end;
end;
 
function TForm1.DownloadURL(AUrl, TargetDir: string):
  Boolean;
const
  BUFFERSIZE = 4096;
var
  F: file;
  hSession: HINTERNET;
  hService: HINTERNET;
  lpBuffer: array[0..BufferSize + 1] of Byte;
  BufferLength: DWORD;
  dwSizeOfRq, Reserved, dwByteToRead: DWORD;
  TargetFileName: string;
  fsize: DWORD;
begin
  Result := False;
  hSession := InternetOpen('MyApp', // Agent
    INTERNET_OPEN_TYPE_PRECONFIG, // dwAccessType
    nil, // lpszProxyName (optional)
    nil, // lpszProxyBypass (optional)
    0); // dwFlags
  StatusBar1.SimpleText := 'InternetOpen';
  if hSession = nil then
  begin
    ShowMessage('Internet session initialization failed!');
    StatusBar1.SimpleText := 'Internet session initialization failed!';
    Exit;
  end;
  hService := InternetOpenUrl(hSession,
    PChar(AUrl),
    nil,
    0,
    INTERNET_FLAG_DONT_CACHE or
    INTERNET_FLAG_PRAGMA_NOCACHE or
    INTERNET_FLAG_RELOAD,
    0);
  StatusBar1.SimpleText := 'InternetOpenUrl';
  if hSession = nil then
  begin
    ShowMessage('Internet session initialization failed!');
    StatusBar1.SimpleText := 'Internet session initialization failed!';
    InternetCloseHandle(hService);
    Exit;
  end;
 
  HttpQueryInfo(hService, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER,
    @dwByteToRead,
    dwSizeOfRq, Reserved);
  StatusBar1.SimpleText := 'HttpQueryInfo HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER';
 
  TargetFileName := 'c:\Temp\' + fName(AUrl);
  AssignFile(F, TargetFileName);
  Rewrite(F, 1);
  if IOResult <> 0 then
  begin
    ShowMessage('Cannot create local file');
    StatusBar1.SimpleText := 'Cannot create local file';
 
    InternetCloseHandle(hService);
    Exit;
  end;
  BufferLength := BUFFERSIZE;
  dwByteToRead := 0;
  dwSizeOfRq := 4; // BufferLength
  Reserved := 0;
  if not HttpQueryInfo(hService,
    HTTP_QUERY_CONTENT_LENGTH or HTTP_QUERY_FLAG_NUMBER,
    @dwByteToRead,
    dwSizeOfRq,
    Reserved) then dwByteToRead := 0;
  ProgressBar1.max := dwByteToRead;
  FSize := 0;
 
  BufferLength := BUFFERSIZE;
 
  while (BufferLength > 0) do
  begin
    if not InternetReadFile(hService, @lpBuffer, BUFFERSIZE, BufferLength)
      then Break;
    if (BufferLength > 0) and (BufferLength <= BUFFERSIZE) then
      BlockWrite(F, lpBuffer, BufferLength);
    application.ProcessMessages;
    fsize := fsize + BufferLength;
    StatusBar1.SimpleText := inttostr(fsize) + ' in ' + inttostr(dwByteToRead) + ' bytes complete..';
    form1.ProgressBar1.Position := fsize;
    if BufferLength > 0 then Result := True;
  end; {while}
 
  CloseFile(F);
  Result := True;
  StatusBar1.SimpleText := 'Done..';
  ProgressBar1.Visible := false;
  InternetCloseHandle(hService);
end;
 
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  ProgressBar1.Position := 0;
  ProgressBar1.Visible := true;
  DownloadURL(edit1.Text, 'c:\Temp');
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text:='http://www.ya.ru/logo.gif';
end;
 
end.