K210.ORG

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.