Показать сообщение отдельно
  #9  
Старый 07.05.2015, 03:59
Аватар для Помидоркин
Помидоркин Помидоркин вне форума
Начинающий
 
Регистрация: 07.10.2012
Адрес: Дедовск
Сообщения: 110
Версия Delphi: Rio 10.3
Репутация: 10
По умолчанию

Вот, собственно, что получилось в итоге:
Код:
type
    TDLoad = class(TThread)
    private
     URL: String;
     S, E: Cardinal;
     Buf: TMemoryStream;
     procedure WriteStrim;
    protected
     procedure Execute; override;
    public
    end;

{ TDLoad }

procedure TDLoad.Execute;
var h: TIdHTTP;
begin
 h:=TIdHTTP.Create(nil);
 {настраиваю запрос}
 h.OnWork:= Form1.IdHTTPWork; 
 h.Request.ContentRangeStart:= S;
 h.Request.ContentRangeEnd:= E;
 Buf:= TMemoryStream.Create;
 try
  h.Get(URL,Buf);
 Except
  on E : Exception do
 //тут надо-бы предусмотреть обработку ошибки
 end;
 h.Free;
 Buf.Position:=0;
 Synchronize(WriteStrim);
 Buf.Free;
 CntLock.Enter; Dec(TrCnt);   CntLock.Leave; // TrCnt: Byte - счетчик потоков,  CntLock: TCriticalSection;
end;

procedure TDLoad.WriteStrim;
begin
 FileStrim.Position:=S;
 FileStrim.CopyFrom(Buf,Buf.Size);
end;
Код:
procedure TForm1.FormCreate(Sender: TObject);
begin
 CntLock:=TCriticalSection.Create;
 Link:= 'http://dedowsk-beauty.ru/0/Gloria_Gaynor__I_Will_Survive.mp3';
end;

procedure TForm1.Button2Click(Sender: TObject);
var i: Byte;
     dl: TDLoad;
     h: TIdHTTP;
     CntntLen: Int64;
begin
 h:=TIdHTTP.Create(nil);
  {настраиваю запрос}
 try
  h.Head(Link);
 Except
  on E : Exception do begin
  ShowMessage('Нету'+#13#10+IntToStr(h.ResponseCode));
  Exit; end;
 end;
 CntntLen:=h.Response.ContentLength;    h.Free;
 FileStrim:= TFileStream.Create('D:\cashe\Gloria_Gaynor__I_Will_Survive.mp3',fmCreate);
 FileStrim.Size:=CntntLen;
 PrBar.Max:= SecLen; // тут пришлось приделывать "костыли"
 PrBar.Position:=0;
 TrCnt:=0;
 for i:= 0 to CntntLen div SecLen  do //const SecLen: Integer = 2097152; (2MB)
 begin
  dl:= TDLoad.Create(True);
  dl.FreeOnTerminate:=True;
  dl.URL:= Link;
  dl.S:= i*SecLen;
  dl.E:= (i+1)*SecLen-1;
  dl.Resume;
  CntLock.Enter; Inc(TrCnt); CntLock.Leave;
 end;
 while TrCnt>0 do begin
  Label1.Caption:=IntToStr(TrCnt);
  Sleep(1000);
 end;
 Label1.Caption:=IntToStr(TrCnt);
 PrBar.Position:=0;
 FileStrim.Free;
end;
Код:
procedure TForm1.IdHTTPWork(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
 PrBar.Position:= AWorkCount;
end;
Загвоздка в ProgressBar-е, Position надо задавать складывая AWorkCount всех потоков или запоминать предыдущее состояние AWorkCount и отнимать его от текущего. По-этому сделал так, как сделал, прогресс скачет немного вперед-назад, но общее представление о ходе процесса получить можно.
Может быть у кого будут какие идеи по-поводу прогресса?
Ответить с цитированием