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

Код


procedure TDownloadThread.Execute;
var
  hInet,  //соединение
  hURL: HINtERNET;    //ссылка на файл
  BufArr: array[1..1024] of byte; //буфер, в который будем скачивать
  BufLen: DWORD;
  sFile: file; //наш файл
  i: integer;
begin
  hInet := InternetOpen(PChar(Application.ExeName),INTERNET_OPEN_TYPE_PrECONFIG,nil,nil,0); //открываем соединение

  for i := 0 to Length(filelist)-1 do  //где filelist - чтото вроде набора файлов для скачивания
    begin
      hURL := InternetOpenURL(hInet,PAnsiChar(filelist[i].url),nil,0,0,0);
      if FileExists(fclientpath+'\'+filelist[i].folder) then
        DeleteFile(fclientpath+'\'+filelist[i].folder);
      AssignFile(sFile,fclientpath+'\'+filelist[i].folder);
      Rewrite(sFile,1);

      repeat
        InternetReadFile(hURL,@BufArr,Sizeof(BufArr),BufLen);
        downloaded := downloaded+ BufLen;
        BlockWrite(sFile,BufArr,BufLen);
        Synchronize(showprogress);
      until BufLen=0;
      CloseFile(sFile);
      hURL := 0;
    end;
  InternetCloseHandle(hInet); //закрываем соединение
end;

//и процедура вывода ShowProgress
procedure TDownloadThread.ShowProgress;
begin
  fGrid.Cell[3,frow].AsInteger := round(downloaded/totalsize*100); //fGrid - указатель на наш NextGrid; Downloaded - сколько загруженно
  //a TotalSize - размер всех всех файлов в списке, который вычисляется еще до Execute
  Application.ProcessMessages;
end;

Код


constructor TDownloadThread.Create(list: TXMLDocument; var Grid: TNextGrid; row: integer; clientpath: string);
begin
  inherited Create(true);
  FreeOnTerminate := true; //поток освобождается при завершении
  frow := row;             //id или наша строка таблицы
  fclientpath := clientpath; //папка для общей загрузки
  SetFileList(list);       //составляем список файлов для скачивания

  fEnablePause := false; //нельзя ставить поток на паузу
  fPaused := false; // переменная паузы в false

  if Length(filelist) <= 0 then  // если скачивать нечего - закрываемся
    begin
      Grid.Cell[3,frow].AsInteger := 100;
      Self.Terminate;
      exit;
    end;

  totalsize := GetTotalSize; //вычисляем полный размер файлов
  downloaded := 0; // загружено - пока 0
  fGrid := @Grid;   // присваиваем указатель на таблицу
  fGrid.Cell[5,frow].AsString := inttostr(round(totalsize/1024))+ ' KB';
end;

//и собственно функция* паузы
function TDownloadThread.Pause: boolean;
begin
  result := false;
  if (EnablePause) or (fPaused) then exit;
  fPaused := true;
  result := true;
end;

Код


while fPaused do
 Application.ProcessMessages;

Цитата

при загрузке нескольких файлов одновременно они загружаются не одновременно, а по очереди.

Цитата

fGrid.Cell[3,frow].AsInteger := round(downloaded/totalsize*100); //fGrid - указатель на наш NextGrid; Downloaded - сколько загруженно

Цитата

Application.ProcessMessages;

Цитата

  if Length(filelist) <= 0 then  // если скачивать нечего - закрываемся
    begin
      Grid.Cell[3,frow].AsInteger := 100;
      Self.Terminate;
      exit;
    end;

Цитата

fGrid := @Grid;

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, WinInet, syncobjs;

type
  TProg = record
    id: integer;
    progress: integer;
  end;

  TProgressThread = class(tThread)
  private
    hId: integer;
    folder, url: string;
  public
    constructor Create(id: integer; sfolder, surl: string);
    procedure DoWork;
  protected
    procedure Execute;override;
  end;

  TControlThread = class(TThread)
  protected
    procedure Execute;override;
  end;

  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    ProgressBar2: TProgressBar;
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  progress: array of TProg;
  cs: TCriticalSection;
implementation

{$R *.dfm}

constructor TProgressThread.Create(id: integer; sfolder, surl: string);
begin
  inherited Create(false);
  self.Priority :=  tpLower;
  hId := id;
  folder := sfolder;
  url := surl;
end;

procedure TProgressThread.Execute;
begin

      Synchronize(DoWork);
      sleep(50);
end;

procedure TProgressThread.DoWork;
var
  hInet,  //соединение
  hURL: HINtERNET;    //ссылка на файл
  BufArr: array[1..1024] of byte;
  BufLen: DWORD;
  sFile: file;
  i: integer;
begin
  hInet := InternetOpen(PChar(Application.ExeName),INTERNET_OPEN_TYPE_PrECONFIG,nil,nil,0);

      hURL := InternetOpenURL(hInet,PAnsiChar(url),nil,0,0,0);
      if FileExists(ExtractFilePath(Application.ExeName)+folder) then
        DeleteFile(ExtractFilePath(Application.ExeName)+folder);
      AssignFile(sFile,ExtractFilePath(Application.ExeName)+folder);
      Rewrite(sFile,1);
      repeat

        InternetReadFile(hURL,@BufArr,Sizeof(BufArr),BufLen);
        BlockWrite(sFile,BufArr,BufLen);
        setLength(progress,length(progress)+1);
        progress[length(progress)-1].id := hId;
        progress[length(progress)-1].progress := round(random(100));

        sleep(0);
      until BufLen=0;
      CloseFile(sFile);

end;

procedure TControlThread.Execute;
var
  i: integer;
begin
  while not terminated do
  begin
    if length(progress)> 0 then
      begin
        for i := 0 to Length(progress)-1 do
          begin
          if progress[i].id = 1 then
            Form1.ProgressBar1.Position := progress[i].progress
          else
            Form1.ProgressBar2.Position := progress[i].progress;
          Form1.Memo1.Lines.Add(timetostr(now)+'_'+inttostr(progress[i].id));
      Application.ProcessMessages;    
          end;
      SetLength(progress,0);
      end;
   sleep(0);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ctrl: TControlThread;
  pr1: TProgressThread;
begin
  ctrl := TControlThread.Create(false);
  pr1 := TProgressThread.Create(1,'Data\file1.txt','http://127.0.0.1/Launcher/download/theme.rlt');
  
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  pr2: TProgressThread;
begin
pr2 := TProgressThread.Create(2,'Data\file2.txt','http://127.0.0.1/Launcher/download/theme.rlt');
end;

end.

Код


procedure TProgressThread.Execute;
begin
      Synchronize(DoWork);
      sleep(50);
end;

Код


unit Unit30;

interface

uses
  Generics.Collections,
  System.SyncObjs,
  System.Math,
  Vcl.ExtCtrls, Vcl.StdCtrls, System.Classes, Vcl.Controls, Vcl.ComCtrls,
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, Vcl.Forms, Vcl.Graphics;

type
  TForm30 = class(TForm)
    ProgressBar1: TProgressBar;
    Button1: TButton;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TTask = class
  public
    FileName: string;
    FileSize: Int64;
    DownloadedSize: Int64;
  end;

  TTaskStorage = class
  private
    FData: TQueue<TTask>;
    FSync: TCriticalSection;
    FTotalSize: Int64;
    FDownloadedTotal: Int64;
    function GetCount: Integer;
    function GetDownloadedTotal: Int64;
    function GetTotalSize: Int64;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddTask(Task: TTask);
    function ExtractTask: TTask;
    procedure DownloadedFilePart(PartSize: Integer);
    property Count: Integer read GetCount;
    property TotalSize: Int64 read GetTotalSize;
    property DownloadedTotal: Int64 read GetDownloadedTotal;
  end;

  TWorkerThread = class(TThread)
  private
    procedure ProcessTask(Task: TTask);
  protected
    procedure Execute; override;
  end;

var
  Form30: TForm30;

implementation

var
  TaskStorage: TTaskStorage = nil;

{$R *.dfm}

procedure TForm30.Button1Click(Sender: TObject);
const
  ThreadCount = 5;
  FilesCount = 50;
var
  I: Integer;
  T: TTask;
begin
  for I := 1 to FilesCount do
  begin
    T := TTask.Create;
    T.FileName := IntToStr(I);
    T.FileSize := Random(1024 * 1024);
    T.DownloadedSize := 0;

    TaskStorage.AddTask(T);
  end;

  for I := 1 to ThreadCount do
    TWorkerThread.Create;
end;

procedure TForm30.Timer1Timer(Sender: TObject);
begin
  ProgressBar1.Max := TaskStorage.TotalSize;
  ProgressBar1.Position := TaskStorage.DownloadedTotal;
end;

{ TTaskStorage }

procedure TTaskStorage.AddTask(Task: TTask);
begin
  FSync.Enter;
  try
    FTotalSize := FTotalSize + Task.FileSize;
    FData.Enqueue(Task);
  finally
    FSync.Leave;
  end;
end;

constructor TTaskStorage.Create;
begin
  FData := TQueue<TTask>.Create;
  FSync := TCriticalSection.Create;
end;

destructor TTaskStorage.Destroy;
begin
  FreeAndNil(FData);
  FreeAndNil(FSync);
  inherited;
end;

procedure TTaskStorage.DownloadedFilePart(PartSize: Integer);
begin
  FSync.Enter;
  try
    FDownloadedTotal := FDownloadedTotal + PartSize;
  finally
    FSync.Leave;
  end;
end;

function TTaskStorage.ExtractTask: TTask;
begin
  FSync.Enter;
  try
    if FData.Count = 0 then
      Exit(nil);

    Result := FData.Dequeue;
  finally
    FSync.Leave;
  end;
end;

function TTaskStorage.GetCount: Integer;
begin
  FSync.Enter;
  try
    Result := FData.Count;
  finally
    FSync.Leave;
  end;
end;

function TTaskStorage.GetDownloadedTotal: Int64;
begin
  FSync.Enter;
  try
    Result := FDownloadedTotal;
  finally
    FSync.Leave;
  end;
end;

function TTaskStorage.GetTotalSize: Int64;
begin
  FSync.Enter;
  try
    Result := FTotalSize;
  finally
    FSync.Leave;
  end;
end;

{ TWorkerThread }

procedure TWorkerThread.Execute;
var
  T: TTask;
begin
  FreeOnTerminate := True;

  T := TaskStorage.ExtractTask;
  while T <> nil do
  begin

    ProcessTask(T);

    T := TaskStorage.ExtractTask;
  end;
end;

procedure TWorkerThread.ProcessTask(Task: TTask);
const
  Speed = 1024 * 1024;
var
  I: Integer;
  BytesCopied: Integer;
begin

  while Task.FileSize > Task.DownloadedSize do
  begin
    BytesCopied := Min(Random(Speed), Task.FileSize - Task.DownloadedSize);
    Task.DownloadedSize := Task.DownloadedSize + BytesCopied;

    TaskStorage.DownloadedFilePart(BytesCopied);
    Sleep(Random(1000));
  end;
end;

initialization
  TaskStorage := TTaskStorage.Create;

finalization
  FreeAndNil(TaskStorage);

end.