unit DownloadTh;

interface

uses
 Windows, Classes, SysUtils, idHTTP, IdComponent, IniFiles, ExtCtrls;

const
  HEADER_RANGE     = 'Range: bytes=';
  HEADER_USERAGENT = 'Downloader/1.0 (Windows NT; Vadim; Redfern;)';

{ Сюда идет запись файла }   
var
  FStream : TFileStream;

{ События }
type
  TOnAddSegmentEvent = procedure(StartPos, MaxPos : Int64) of object;
  TOnSetPositionEvent = procedure(Index: Integer; Position: Int64) of object;

{ Основной класс(поток) }
type
  TDownload = class(TThread)
  protected
   FHTTP       : TidHTTP;
   FRangeStart : string;
   FRangeEnd   : string;
   FURL        : string;
   FFileName   : string;
   FTotalCount : Int64;
   FContentLen : Int64;
  private
 { Properties }
   property URL           : string                 read  FURL
                                                   write FURL;
   property FileName      : string                 read  FFileName
                                                   write FFileName;
   property RangeStart    : string                 read  FRangeStart
                                                   write FRangeStart;
   property RangeEnd      : string                 read  FRangeEnd
                                                   write FRangeEnd;
   property TotalCount    : Int64                  read  FTotalCount;
   property ContentLength : Int64                  read  FContentLen;
 { Procedures }
   procedure Execute; override;
   procedure OnWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
   procedure OnWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
   procedure Disconnect;
  end;

{ Внешний класс(объект) для загрузки файла }
type
  TMultiHTTPDownloader = class(TComponent)
  protected
    FDownload           : array of TDownload;
    FPartCount          : Integer;
    FFileName           : string;
    FStateFile          : string;
    FURL                : string;
    FOnAddSegmentEvent  : TOnAddSegmentEvent;
    FOnSetPositionEvent : TOnSetPositionEvent;
    FTimer              : TTimer;
    FTotalCount         : Int64;
    FContentLen         : Int64;
  private
    procedure TriggerAddSegment(Min, Max: Int64);
    procedure TriggerSetPosition(Index: Integer; Position: Int64);
    procedure OnTimer(Sender: TObject);
  public
    constructor Create(AOwner: TComponent);
    procedure Start;
    procedure Abort;
    procedure Pause;
    procedure Resume;
    property  TotalCount  : Int64                     read  FTotalCount;
    property  ContentLen  : Int64                     read  FContentLen;
  published
    property PartCount    : Integer                   read  FPartCount
                                                      write FPartCount;
    property FileName     : string                    read  FFileName
                                                      write FFileName;
    property StateFile    : string                    read  FStateFile
                                                      write FStateFile;
    property URL          : string                    read  FURL
                                                      write FURL;
    property OnAddSegment : TOnAddSegmentEvent        read  FOnAddSegmentEvent
                                                      write FOnAddSegmentEvent;
    property OnSetPosition: TOnSetPositionEvent       read  FOnSetPositionEvent
                                                      write FOnSetPositionEvent;
  end;

procedure Register;

implementation

/////////////////////////////TDownload/////////////////////////////

{ Выполнение загрузки }
procedure TDownload.Execute;
begin
 // Создаем объект "FHTTP"
   FHTTP := TidHTTP.Create(nil);
 // Присваеваем заголовки
   FHTTP.Request.CustomHeaders.Add(HEADER_RANGE + FRangeStart + '-' + FRangeEnd); // Custom
   FHTTP.Request.UserAgent := HEADER_USERAGENT;
 // Присвоение процедур
   FHTTP.OnWork := OnWork;
   FHTTP.OnWorkBegin := OnWorkBegin;
 // Запуск
   FHTTP.Get(FURL, FStream);
 // Очистка памяти по завершению
   FHTTP.Free;
end;

{ Щитаем колличество скачанных байт }
procedure TDownload.OnWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
begin
  FTotalCount := AWorkCount;
end;

{ Щитаем общее колличество байт }
procedure TDownload.OnWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
begin
  FContentLen := AWorkCountMax;
end;

{ Отключем }
procedure TDownload.Disconnect;
begin
   FHTTP.Disconnect;
end;

//-----------------------------------------------------------------------------|
/////////////////////////////TMultiHTTPDownloader//////////////////////////////|
//-----------------------------------------------------------------------------|

// Создаем нужное вместе с объектом "TMultiHTTPDownloader"
constructor TMultiHTTPDownloader.Create(AOwner: TComponent);
begin
  Inherited Create(AOwner);
  FTimer := TTimer.Create(nil);
  FTimer.OnTimer := OnTimer;
  FTimer.Enabled := False;
  FTimer.Interval := 1000;
end;


// Обрабатываем нужные события в таймере
procedure TMultiHTTPDownloader.OnTimer(Sender: TObject);
var
  I : Integer;
begin
  FContentLen := 0;
  FTotalCount := 0;
  For I := 0 To FPartCount -1 Do
  begin
    Inc(FTotalCount, FDownload[i].TotalCount);
    Inc(FContentLen, FDownload[i].ContentLength);
    TriggerSetPosition(I, FDownload[i].TotalCount);
  end;

  If FTotalCount = FContentLen Then
  begin
    FTimer.Enabled := False;
  end;
end;

// Добавить сегмент в индикатор
procedure TMultiHTTPDownloader.TriggerAddSegment(Min, Max: Int64);
begin
  If Assigned(FOnAddSegmentEvent) Then
    FOnAddSegmentEvent(Min, Max);
end;

// Установка позиции сегментов
procedure TMultiHTTPDownloader.TriggerSetPosition(Index: Integer; Position: Int64);
begin
  If Assigned(FOnSetPositionEvent) Then
    FOnSetPositionEvent(Index, Position);
end;

// Заустить закачку
procedure TMultiHTTPDownloader.Start;
var
  Chunk, Offset,
  ContentLength        : Int64;
  HTTP                 : TidHTTP;
  I                    : Integer;
begin
  { Проверка на назначенный статичный файл }
  If FStateFile = '' Then
  begin
    Raise Exception.Create('Имя статичного файла не определено');
    Exit;
  end;

  { Проверка на введенный URL-аддрес }
  If FURL = '' Then
  begin
    Raise Exception.Create('поле URL не должено остоваться пустым');
    Exit;
  end;

  { Прове }

  HTTP := TidHTTP.Create(nil);
  HTTP.Head(FURL);
  ContentLength := HTTP.Response.ContentLength;
  HTTP.Free;

  FStream := TFileStream.Create(FFileName, fmCreate);

  Chunk := ContentLength div FPartCount;
  Offset := 0;
  FTimer := TTimer.Create(nil);
  FTimer.OnTimer := OnTimer;
  FTimer.Interval := 1000;
  FTimer.Enabled := True;

  For I := 0 To FPartCount -1 Do
  begin
    SetLength(FDownload, I +1);
    FDownload[i] := TDownload.Create(True);
    FDownload[i].RangeStart := IntToStr(Offset);
    FDownload[i].RangeEnd := IntToStr(Offset + Chunk);
    FDownload[i].FreeOnTerminate := True;
    FDownload[i].FileName := FFileName;
    FDownload[i].URL := FURL;
    TriggerAddSegment(Offset, Offset + Chunk);
    Offset := Offset + Chunk +1;
  end;

  For I := 0 To FPartCount -1 Do FDownload[i].Resume;  

end;

// Остановка
procedure TMultiHTTPDownloader.Abort;
var
  I : Integer;
begin
  For I := 0 To FPartCount -1 Do
  begin
   FDOwnload[i].Disconnect;
   FDownload[i].Free;
  end;
  SetLength(FDownload, 0);
  FTimer.Enabled := False;
end;

// Пауза
procedure TMultiHTTPDownloader.Pause;
var
  I     : Integer;
  iFile : TIniFile;
begin
  iFile := TIniFile.Create(FStateFile);

  For I := 0 To FPartCount -1 do
  begin
    iFile.WriteString('Section ' + IntToStr(i), 'Position', IntToStr(FDownload[i].TotalCount));
    iFile.WriteString('Section ' + IntToStr(i), 'Length', IntToStr(FDownload[i].ContentLength));
  end;

  For I := 0 To FPartCount -1 Do
  begin
   FDownload[i].Disconnect;
   FDownload[i].Free;
  end;
  iFile.Free;
  FTimer.Enabled := False;
end;

// Возобновление
procedure TMultiHTTPDownloader.Resume;
var
  I     : Integer;
  iFile : TIniFile;
  Temp  : TStringList;
begin
  iFile := TIniFile.Create(FStateFile);
  Temp  := TStringList.Create;

  iFile.ReadSections(Temp);

  For I := 0 To Temp.Count -1 do
  begin
     SetLength(FDownload, I +1);
     FDownload[i] := TDownload.Create(True);
     FDownload[i].RangeStart := iFile.ReadString('Section ' + IntToStr(i), 'Position', '');
     FDownload[i].RangeEnd := iFile.ReadString('Section ' + IntToStr(i), 'Length', '');
  end;

  For I := 0 To Temp.Count -1 do FDownload[i].Resume;

  FTimer.Enabled := True;

  Temp.Free;
  iFile.Free;
end;

procedure Register;
begin
  RegisterComponents('Standard', [TMultiHTTPDownloader]);
end;

end.