var
  URLStream:IStream;
  Stream:TOLEStream;
begin
  OleCheck(URLOpenBlockingStream(nil,'http://www.delphikingdom.com',URLStream,0,nil));
  Stream:=TOLEStream.Create(URLStream);
  try
    Memo.Lines.LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

unit Update;
interface
uses
  Messages,SysUtils,Classes,WinInet,Windows,
  Controls,Forms,Math,StdCtrls,ComCtrls;

type
  TConnectType=(ctDirect,ctProxy,ctDefault);
  TCopyResult=(crSuccess,crWasError,crCancel);

function CopyFromInet(const URL,FileName:string;CT:TConnectType=ctDefault;const Proxy:string=''):TCopyResult;

implementation

const
  WM_AFTERCREATE=WM_USER+101;
type
  TReadStatus=(rsConnect,rsRequest,rsRead,rsClose);
  TUpdateForm=class;
  THttpReaderThread=class(TThread)
  private
    FUpdateForm:TUpdateForm;
    FStatus:TReadStatus;
    FReaded:Integer;
    hSession:Pointer;
    procedure SyncStatusChange;
    procedure StatusChange(Value:TReadStatus);
    procedure Progress;
  protected
    procedure DoTerminate; override;
    procedure Execute; override;
  public
    constructor Create(UpdateForm:TUpdateForm);
    destructor Destroy; override;
  end;

  TUpdateForm=class(TCustomForm)
    StatusText:TStaticText;
    ProgressBar:TProgressBar;
    AbortButton:TButton;
    CopyProgressLabel:TLabel;
  private
    FURL:string;
    FFileName:string;
    FFileSize:Integer;
    FResult:TCopyResult;
    FProxy:string;
    FConnectType:TConnectType;
  public
    constructor Create(AOwner:TComponent); override;
    function ShowModal:Integer; override;
  end;

function CopyFromInet(const URL,FileName:string;CT:TConnectType=ctDefault;const Proxy:string=''):TCopyResult;
begin
  with TUpdateForm.Create(Application) do try
    FURL:=URL;
    FFileName:=FileName;
    FConnectType:=CT;
    FProxy:=Proxy;
    ShowModal;
    Result:=FResult;
  finally
    Free;
  end;
end;

constructor THttpReaderThread.Create(UpdateForm:TUpdateForm);
var
  lpBuf:PChar;
const
  CTypes:array[TConnectType] of Integer=(INTERNET_OPEN_TYPE_DIRECT,INTERNET_OPEN_TYPE_PROXY,INTERNET_OPEN_TYPE_PRECONFIG);
begin
  FReaded:=0;
  FUpdateForm:=UpdateForm;
  if FUpdateForm.FConnectType=ctProxy then
    lpBuf:=PChar(FUpdateForm.FProxy)
  else
    lpBuf:=nil;
  hSession:=InternetOpen('Test update system',CTypes[FUpdateForm.FConnectType],lpBuf,nil,0);
  StatusChange(rsConnect);
  inherited Create(False);
  FreeOnTerminate:=False;
end;

destructor THttpReaderThread.Destroy;
begin
  Terminate;
  InternetCloseHandle(Pointer(InterlockedExchange(Integer(hSession),0)));
  inherited;
end;

procedure THttpReaderThread.SyncStatusChange;
const
  CMsgs:array[TReadStatus] of string=('Connecting','Send request','Reading','Closed');
begin
  FUpdateForm.StatusText.Caption:=CMsgs[FStatus];
end;

procedure THttpReaderThread.StatusChange(Value:TReadStatus);
begin
  FStatus:=Value;
  Synchronize(SyncStatusChange);
end;

procedure THttpReaderThread.Progress;
begin
  with FUpdateForm do begin
    ProgressBar.Position:=100*FReaded div FFileSize;
    CopyProgressLabel.Caption:=Format('Readed %d/%d', [FReaded,FFileSize]);
  end;
end;

procedure THttpReaderThread.Execute;
var
  hRequest:Pointer;
  fFIle:DWORD;
  lpBuf:array[0..30] of Char;
  dwBufLen:DWORD;
  lpData:array[0..4096-1] of Byte;
  dwBtRead:DWORD;
  Time,OldTime:DWORD;
begin
  hRequest:=InternetOpenUrl(hSession,PChar(FUpdateForm.FURL),nil,0,0,0);
  try
    if Terminated then Exit;
    StatusChange(rsRequest);
    dwBufLen:=SizeOf(lpBuf);
    if not HttpQueryInfo(hRequest,HTTP_QUERY_CONTENT_LENGTH,@lpBuf,dwBufLen,PDWORD(nil)^) then Exit;
    FUpdateForm.FFileSize:=StrToIntDef(lpBuf,-1);
    fFile:=FileCreate(FUpdateForm.FFileName);
    if fFile=INVALID_HANDLE_VALUE then Exit;
    try
      StatusChange(rsRead);
      Synchronize(Progress);
      OldTime:=GetTickCount;
      while not Terminated and InternetReadFile(hRequest,@lpData,SizeOf(lpData),dwBtRead)and(dwBtRead<>0) do begin
        FileWrite(fFIle,lpData,dwBtRead);
        Inc(FReaded,dwBtRead);
        Time:=GetTickCount;
        if Time-OldTime>500 then begin
          Synchronize(Progress);
          OldTime:=Time;
        end;
      end;
      Synchronize(Progress);
    finally
      FileClose(fFile);
    end;
    if Terminated then
      FUpdateForm.FResult:=crCancel
    else
      FUpdateForm.FResult:=crSuccess;
    StatusChange(rsClose);
  finally
    InternetCloseHandle(hRequest);
  end;
end;

procedure THttpReaderThread.DoTerminate;
begin
  FUpdateForm.ModalResult:=mrOk;
end;

constructor TUpdateForm.Create(AOwner:TComponent);
begin
  inherited CreateNew(AOwner);
  ClientHeight:=104;
  ClientWidth:=446;
  Position:=poOwnerFormCenter;
  BorderStyle:=bsDialog;
  CopyProgressLabel:=TLabel.Create(Self);
  with CopyProgressLabel do begin
    Parent:=Self;
    SetBounds(8,76,3,16);
  end;
  StatusText:=TStaticText.Create(Self);
  with StatusText do begin
    Parent:=Self;
    SetBounds(7,8,433,24);
    AutoSize:=False;
    Alignment:=taCenter;
    BorderStyle:=sbsSunken;
  end;
  ProgressBar:=TProgressBar.Create(Self);
  with ProgressBar do begin
    Parent:=Self;
    SetBounds(7,40,433,26);
  end;
  AbortButton:=TButton.Create(Self);
  with AbortButton do begin
    Parent:=Self;
    SetBounds(337,72,103,29);
    Cancel:=True;
    Caption:='Abort';
    ModalResult:=mrCancel;
  end;
end;

function TUpdateForm.ShowModal:Integer;
begin
  Caption:=Format('Coping from "%s"', [FURL]);
  FResult:=crWasError;
  with THttpReaderThread.Create(Self) do try
    Result:=inherited ShowModal;
  finally
    Free;
  end;
end;

end.