Качаем с докачкой

// ПРЕДИСЛОВИЕ:

{
Копаясь как-то в исходниках модулей третьей Delphi, я наткнулся на файл,
который назывался WinInet.pas. Имея врожденное любопытство, я заглянул
в него и нашел там очень много интересных вещей. О некоторых из них я
попытаюсь рассказать в данной статье, в частности, как, используя этот
модуль, организовать докачку файлов при обрыве связи. В модуле WinInet.pas
содержатся описания прототипов функций и некоторых типов входящих в т.н.
Microsoft Windows Internet Extensions, описания которых я не нашел в
справочной системе (хотя может плохо искал) :-(. Поэтому пришлось идти
почти вслепую.
}

// ТЕОРИЯ:

{
Для начала рассмотрим все функции, константы и типы, которые мы будем
использовать:
}

// 1) HINTERNET, вот как он описан:

 type
   HINTERNET = Pointer;
   PHINTERNET = ^HINTERNET;

// При детальном рассмотрении, это обычный указатель.
// 2) функции InternetOpen и InternetCloseHandle:

  function InternetOpen(lpszAgent: PChar; dwAccessType: DWORD;
    lpszProxy, lpszProxyBypass: PChar; dwFlags: DWORD): HINTERNET; stdcall;

{
    где:
    lpszAgent      <-|Имя программы, с помощью которой мы соединяемся,
                     |может принимать любые значения
    dwAccessType   <-|Каким макаром соединяться с и-нетом
                     |принимаемые значения:
                     | PRE_CONFIG_INTERNET_ACCESS -как в системном реестре 
                     | LOCAL_INTERNET_ACCESS      -напрямую 
                     | GATEWAY_INTERNET_ACCESS    -через GateWay
                     | CERN_PROXY_INTERNET_ACCESS -через проксю 
    lpszProxy      <-|Имя прокси сервера (ставим в nil)
    lpszProxyBypass<-|Не уверен, но смахивает на имена хостов, для которых не 
                     |использовать проксю (ставим в nil)                
    dwFlags        <-|Принимаеемые значения:
                     | INTERNET_FLAG_ASYNC  -этот запрос асинхронный (если есть
                     |                       поддержка), но мы поставим 0

}

// возвращает пресловутый HINTERNET, который будет требоваться при вызове
// всех остальных функций. С вызова этой функции начинается вся наша работа
// с интернетом, а с вызова второй заканчивается.

  function InternetCloseHandle(hInet: HINTERNET): BOOL; stdcall;
 
// где: nInet ранее созданый указатель.
// 3) функция InternetOpenUrl:

  function InternetOpenUrl(hInet: HINTERNET; lpszUrl: PChar;
               lpszHeaders: PChar; dwHeadersLength: DWORD; dwFlags: DWORD;
               dwContext: DWORD): HINTERNET; stdcall;

{
 где:
   hInet          <-|Ранее созданый указатель
   lpszUrl        <-|Сам УРЛ
   lpszHeaders    <-|Дополнительные строки в НТТР запрос
   dwHeadersLength<-|Длинна предыдущего
   dwFlags        <-|Принимаемые значения:
                    | INTERNET_FLAG_RAW_DATA -принимать как RAW данные
                    | INTERNET_FLAG_EXISTING_CONNECT -не создавать для
                    |                                 объекта нового соединения
                    |                                 (поставим в 0)
   dwContext      <-|пока не знаю, ставим в 0
}

// Функция возвращает HINTERNET, указывающий на конкретный файл (далее он в
// параметрах функций будет называться hFile).

// 4) функция InternetReadFile:

  function InternetReadFile(hFile: HINTERNET; lpBuffer: Pointer; 
    dwNumberOfBytesToRead: DWORD; var lpdwNumberOfBytesRead: DWORD): BOOL; stdcall;

{
 где:
    hFile                <-|Указатель, созданый предыдущей функцией
    lpBuffer             <-|Указатель на буфер куда читать
    dwNumberOfBytesToRead<-|Сколько максимум читать (можно сказать размер
                           | буфера, хотя не факт)
    lpdwNumberOfBytesRead<-|Сколько реально прочитано байт
}

// Этой функой мы будем читать файл из и-нета.
// 5) функция InternetSetFilePointer:

  function InternetSetFilePointer(hFile: HINTERNET;
             lDistanceToMove: Longint; pReserved: Pointer;
             dwMoveMethod, dwContext: DWORD): DWORD; stdcall;
{
 где:
   hFile          <-|Указатель созданый функцией InternetOpenUrl
   lDistanceToMove<-|На сколько байт смещать указатель
   pReserved      <-|??
   dwMoveMethod   <-|Как смещать (=0)
   dwContext      <-|??
}

// Собственно, эта функция и поможет нам организовать докачку. Она смещает
// указатель в файле, после чего передача файла начнется с этого места.

// В принципе этих данных уже достаточно для наших целей, но есть еще одна
// полезная функция, которая пригодится нам:

 function InternetQueryDataAvailable(hFile: HINTERNET; var lpdwNumberOfBytesAvailable: DWORD;
                                     dwFlags, dwContext: DWORD): BOOL; stdcall;
{
  где:
   hFile                     <-|Указатель, созданный функцией InternetOpenUrl
   lpdwNumberOfBytesAvailable<-|Сколько осталось байт
   dwFlags                   <-|??
   dwContext                 <-|??
}

// Как вы уже догадались, с помощью этой функции можно узнать сколько
// осталось байт скачать (или размер файла, если вызвать ее сразу после
// InternetOpenUrl).

//Ну, собственно, и все по теории.

// ПРАКТИКА:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  wininet,
  StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit; //<-строка для УРЛа
    Label1: TLabel;
    Button1: TButton; //<-кнопка Start
    Button2: TButton; //<-кнопка Stop
    ProgressBar1: TProgressBar; //<-декорация
    procedure Button1Click(Sender: TObject); //<-|процедура начала скачки
    procedure Button2Click(Sender: TObject); //<-|принудительный обрыв
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  stop: boolean; //<-|вспомогательная переменная отв. за
  //  |остановку скачки
implementation
{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  hInet, //<-переменная сод. указатель на сессию
  hURL: HINTERNET; //<-указатель на URL
  fSize, //<-размер файла
  ReadLen, //<-количество реально прочитанных байт
  RestartPos: DWORD; //<-|позиция с которой начинается
  //  |докачка
  fBuf: array[1..1024] of byte; //<-буфер куда качаем
  f: file; //<-файл куда качаем
  Header: string; //<-|дополнительная переменная в HTTP
  //  |заголовок
begin
  RestartPos := 0; //<- |инициализация
  fSize := 0; //<- |переменных
  Button1.Enabled := false;
  Button2.Enabled := true;
  //Если на винте есть файл то считаем, что нужно докачивать
  if FileExists('c:\123.tmp') then
  begin
    AssignFile(f, 'c:\123.tmp');
    Reset(f, 1);
    RestartPos := FileSize(F);
    Seek(F, FileSize(F));
  end
  else
  begin
    //иначе с начала
    AssignFile(f, 'c:\123.tmp');
    ReWrite(f, 1);
  end;
  //открываем сессию
  hInet := InternetOpen('Mozilla',
    PRE_CONFIG_INTERNET_ACCESS,
    nil,
    nil,
    0);
  //Пишем дополнительную строку для заголовка
  Header := 'Accept: */*';
  //открываем URL
  hURL := InternetOpenURL(hInet,
    PChar(Edit1.Text),
    pchar(Header),
    StrLen(pchar(Header)),
    0,
    0);
  //устанавливаем позицию в файле для докачки
  if RestartPos > 0 then
    InternetSetFilePointer(hURL,
      RestartPos,
      nil,
      0,
      0);
  //смотрим ск-ко надо скачать
  InternetQueryDataAvailable(hURL, fSize, 0, 0);
  if RestartPos > 0 then
  begin
    ProgressBar1.Min := 0;
    ProgressBar1.Max := fSize + RestartPos;
    ProgressBar1.Position := RestartPos;
  end
  else
  begin
    ProgressBar1.Min := 0;
    ProgressBar1.Max := fSize + RestartPos;
  end;
  //качаем до тех пор пока реально прочитаное число байт не
  //будет равно нулю или не стор
  while (ReadLen <> 0) and (stop = false) do
  begin
    //читаем в буфер
    InternetReadFile(hURL, @fBuf, SizeOf(fBuf), ReadLen);
    //смотрим ск-ко осталось докачать
    InternetQueryDataAvailable(hURL, fSize, 0, 0);
    ProgressBar1.Position := ProgressBar1.Max - fSize;
    BlockWrite(f, fBuf, ReadLen); //<-пишем в файл
    Application.ProcessMessages;
  end;
  stop := false;
  Button1.Enabled := true;
  Button2.Enabled := false;
  InternetCloseHandle(hURL); //<-|закрываем
  InternetCloseHandle(hInet); //<-|сесcии
  CloseFile(f); //<-|и файл
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  stop := false; //<-прервать скачку
  Button2.Enabled := false; //<-кнопка останова скачки
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  stop := true; //<-сообщаем о необходимости прерывания скачки
end;

end.