Форум программистов [Powered by Invision Power Board]

Код

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, vcl.Controls, Vcl.Forms, Vcl.Dialogs, Winapi.WinInet;

type
  TEventWorkStart = procedure (Sender : TObject; iFileSize : UInt64) of object;
  TEventWork = procedure (Sender : TObject; iBytesTransfered : Int64) of object;
  TEventWorkEnd = procedure (Sender : TObject; iBytesTransfered : Int64;
                             ErrorCode : Integer) of object;

  TWinApiDownload = class(TObject)
    private
      fEventWorkStart : TEventWorkStart;
      fEventWork : TEventWork;
      fEventWorkEnd : TEventWorkEnd;
    public
      FileNameOutput : string;
      URL : string;
      fUserAgent : string;
      fStop : Boolean;
      fProgressUpdateInterval : Cardinal;
      constructor Create;
      destructor Destroy; override;
      function Download(Stream : TStream) : Integer;
      procedure Stop;
      procedure Clear;
      property UserAgent : string read fUserAgent write fUserAgent;
      property OnWorkStart : TEventWorkStart read fEventWorkStart write fEventWorkStart;
      property OnWork : TEventWork read fEventWork write fEventWork;
      property OnWorkEnd : TEventWorkEnd read fEventWorkEnd write fEventWorkEnd;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure DownloadWorkStart(Sender : TObject; iFileSize : UInt64);
    procedure DownloadWork(Sender : TObject; iBytesTransfered : Int64);
    procedure DownloadWorkEnd(Sender : TObject; iBytesTransfered : Int64;
                              ErrorCode : Integer);
  public
    { Public declarations }
  end;

const
  DOWNLOAD_ERROR_UNKNOWN = -1;
  DOWNLOAD_ABORTED_BY_USER = -2;

var
  Form1: TForm1;

implementation

{$R *.dfm}

constructor TWinApiDownload.Create;
begin
  inherited;
  fUserAgent := 'Mozilla/5.001 (windows; U; NT4.0; en-US; rv:1.0) Gecko/25250101';
  fProgressUpdateInterval := 100;
end;

destructor TWinApiDownload.Destroy;
begin
  Stop;
  inherited;
end;

function TWinApiDownload.Download(Stream : TStream) : Integer;
var
  hInet    : HINTERNET;
  hUrl : HINTERNET;
  buf : array [0..1023 * 3] of Byte;
  lpdwNumberOfBytesAvailable : DWORD;
  dwBufferLen, dwIndex : DWORD;
  pSize, pErrorCode : array [0..255] of Char;
  b, _pos, iter : Cardinal;
  transfered : Int64;
begin
  Result := DOWNLOAD_ERROR_UNKNOWN;
  fStop := False;

  hInet := InternetOpen(PChar(UserAgent), INTERNET_OPEN_TYPE_PRECONFIG,
                        nil, nil, 0);
  if Assigned(hInet) then
  begin
    hUrl := InternetOpenUrl(hInet, PChar(URL), nil, 0,0,0);
    if Assigned(hUrl) then
    begin
      dwIndex := 0;
      dwBufferLen := 20;
      HttpQueryInfo(hUrl, HTTP_QUERY_STATUS_CODE, @pErrorCode, dwBufferLen, dwIndex);
      Result := StrToInt(pErrorCode);
      if Result <> 200 then
      begin
        InternetCloseHandle(hUrl);
        InternetCloseHandle(hInet);
        Exit;
      end;
      dwIndex := 0;
      dwBufferLen := 20;
      if HttpQueryInfo(hUrl, HTTP_QUERY_CONTENT_LENGTH, @pSize,
                             dwBufferLen, dwIndex) then
//      begin
        if Assigned(OnWorkStart) then
        OnWorkStart(Self, StrToInt(pSize));
//      end;
      _Pos := 1;
      iter := 0;
      transfered := 0;
      repeat
        if InternetQueryDataAvailable(hUrl,
                              lpdwNumberOfBytesAvailable, 0, 0) then
        begin
          if lpdwNumberOfBytesAvailable > 0 then
          begin
            if InternetReadFile(hUrl, @buf, SizeOf(buf), b) then
            begin
              transfered := transfered + b;
              Stream.WriteBuffer(buf, b);
              if Assigned(OnWork) then
              begin
                inc(iter);
                if iter >= fProgressUpdateInterval then
                begin
                  OnWork(Self, transfered);
                  iter := 0;
                end;
              end;
            end;
          end;
        end;
      until (lpdwNumberOfBytesAvailable = 0) or (b = 0) or (fStop);
      if fStop then
      Result := DOWNLOAD_ABORTED_BY_USER;
      if Assigned(fEventWorkEnd) then
      OnWorkEnd(Self, transfered, Result);
      InternetCloseHandle(hUrl);
    end;
    InternetCloseHandle(hInet);
  end;
end;

procedure TWinApiDownload.Stop;
begin
  fStop := True;
end;

procedure TForm1.FormCreate(Sender: TObject);
const
  MyURL = 'https://vod-secure.twitch.tv/35062d653e0f40c2b455_miramisu_33375945456_1154634538/chunked/';
var
  i, c : Integer;
  d : TWinApiDownload;
  stream : TStream; //эта переменная должна быть глобальной, но для примера не важно
begin
  stream := TFileStream.Create('D:\test.ts', fmCreate or fmOpenReadWrite);
  d := TWinApiDownload.Create;
  d.OnWorkStart := DownloadWorkStart;
  d.OnWork := DownloadWork;
  d.OnWorkEnd := DownloadWorkEnd;
  for I := 50 to 300 do
  begin
    d.URL := MyURL + IntToStr(i) + '.ts';
    c := d.Download(stream);
    if c <> 200 then
    Break;
  end;
  stream.Free;
  d.Free;
end;

procedure TForm1.DownloadWorkStart(Sender: TObject; iFileSize: UInt64);
begin
  //скачивание начато
end;

procedure TForm1.DownloadWork(Sender: TObject; iBytesTransfered: Int64);
begin
  {
  .....
  обновляем индикаторы скачивания
  iBytesTransfered - количество скачанных байт текущего файла
  .....
  }
  Application.ProcessMessages;
end;

procedure TForm1.DownloadWorkEnd(Sender: TObject;
                  iBytesTransfered: Int64; ErrorCode: Integer);
begin
  //скачивание завершено
end;

end.