多線程idhttp下載文件源代碼

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, IdBaseComponent, IdAntiFreezeBase, IdAntiFreeze,
  IdThreadComponent, IdFTP ,IdException;
type
  MyException1 = class(exception)//自定義的異常類 
end;
type
  TThread1 = class(TThread)
  private
    fCount, tstart, tlast: integer;
    tURL, tFile, temFileName: string;
    tResume: Boolean;
    tStream: TFileStream;
  protected
    procedure Execute; override;
  public
    constructor create1(aURL, aFile, fileName: string; bResume: Boolean; Count,
      start, last: integer);
    procedure DownLodeFile(); //下載文件 
  end;
type
  TForm1 = class(TForm)
    IdAntiFreeze1: TIdAntiFreeze;
    IdHTTP1: TIdHTTP;
    Button1: TButton;
    ProgressBar1: TProgressBar;
    Label1: TLabel;
    Label2: TLabel;
    Button2: TButton;
    Button3: TButton;
    ListBox1: TListBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
    procedure Button2Click(Sender: TObject);
    procedure IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: string);
    procedure Button3Click(Sender: TObject);
  private
  public
    nn, aFileSize, avg: integer;
    time1, time2: TDateTime;
    MyThread: array[1..10] of TThread;
    procedure GetThread();
    procedure AddFile();
    procedure NewAddFile();
    function GetURLFileName(aURL: string): string;
    function GetFileSize(aURL: string): integer;
  end;
var
  Form1: TForm1;
implementation
var
  AbortTransfer: Boolean;
  aURL, aFile: string;
  tcount: integer; //檢查文件是否全部下載完畢 
{$R *.dfm}
  //get FileName 
function TForm1.GetURLFileName(aURL: string): string;
var
  i: integer;
  s: string;
begin //返回下載地址的文件名 
  s := aURL;
  i := Pos('/', s);
  while i <> 0 do //去掉"/"前面的內容剩下的就是文件名了 
  begin
    Delete(s, 1, i);
    i := Pos('/', s);
  end;
  Result := s;
end;
//get FileSize 
function TForm1.GetFileSize(aURL: string): integer;
var
  FileSize: integer;
begin
  IdHTTP1.Head(aURL);
  FileSize := IdHTTP1.Response.ContentLength;
  IdHTTP1.Disconnect;
  Result := FileSize;
end;
//執行下載 
procedure TForm1.Button1Click(Sender: TObject);
var
  j: integer;
begin
    //savedialog1. 
  try
    time1 := Now;
    tcount := 0;
    aURL := Edit1.Text; //下載地址 
    if aURL = '' then
    begin
       MessageDlg('請輸入下載地址！',mtError,[mbOK],0);
       Exit;
    end;
    aFile := GetURLFileName(Edit1.Text); //得到文件名 
    savedialog1.FileName :=afile;
    if savedialog1.Execute then
    if Edit2.Text = '' then
    begin
      case MessageDlg('請輸入線程數，最大支持10個線程，默認爲單線程下載！', mtConfirmation, [mbYes, mbNo], 0) of
        mrYes: nn:=1; //默認 
        mrNo: Exit; //重新輸入 
      end;
    end
    else
      nn := StrToInt(Edit2.Text); //線程數 
      if nn > 10 then
      begin
        raise MyException1.Create('輸入超過線程限制數，請重新輸入！');
      end;
      j := 1;
      aFileSize := GetFileSize(aURL);
      avg := trunc(aFileSize / nn);
      begin
        try
          GetThread();
          while j <= nn do
          begin
            MyThread[j].Resume; //喚醒線程 
            j := j + 1;
          end;
        except
          Showmessage('創建線程失敗!');
          Exit;
        end;
      end;
  except
    on E:EConvertError do//捕捉內建的Econverterror異常 
    begin
      //ShowMessage('請輸入數字'); 
      MessageDlg('請輸入數字'+#13,mtError,[mbOK],0);
      Exit;
    end;
    on E:MyException1 do//捕捉自定義的MyException異常 
    begin
      MessageDlg(E.Message,mtError,[mbOK],0);
      Edit2.Text:= '';
      Exit;
    end;
    on E:EIdSocketError do//捕捉內建的EIdSocketError異常 
    begin
      MessageDlg('連接不上服務器，或服務起未開啓！',mtError,[mbOK],0);
      Exit;
    end;
    on E:EIdConnectException do//捕捉內建的EIdSocketError異常 
    begin
      MessageDlg('連接不上服務器，或服務起未開啓！',mtError,[mbOK],0);
      Exit;
    end;
    on E:EIdHTTPProtocolException do//捕捉內建的EIdSocketError異常 
    begin
      MessageDlg('目標文件找不到！',mtError,[mbOK],0);
      Exit;
    end;
  else
    raise //reraise其他異常 
  end;
end;
//開始下載前,將ProgressBar1的最大值設置爲需要接收的數據大小. 
procedure TForm1.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  AbortTransfer := true;
  ProgressBar1.Max := AWorkCountMax;
  ProgressBar1.Min := 0;
  ProgressBar1.Position := 0;
end;
//接收數據的時候,進度將在ProgressBar1顯示出來. 
procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
  if AbortTransfer then
  begin
    //IdHTTP1.Disconnect; //中斷下載 
  end;
  ProgressBar1.Position := AWorkCount;
  //ProgressBar1.Position:=ProgressBar1.Position+AWorkCount; //*******顯示速度極快 
  Application.ProcessMessages;
  //***********************************這樣使用不知道對不對 
end;
//中斷下載 
procedure TForm1.Button2Click(Sender: TObject);
var
  i : integer;
begin
  try
    if AbortTransfer then
      begin
        i:=1;
        while i <= nn do
          begin
          MyThread[i].Suspend;
          i := i + 1;
           end;
       AbortTransfer := false;
       button2.Caption:='開始';
   end else
     begin
     i:=1;
     while i <= nn do
       begin
       MyThread[i].Resume;
       i := i + 1;
       end;
      AbortTransfer := True;
     button2.Caption:='暫停';
    end;
  except
    on E:EThread do
    begin
    end;
  else
    raise //reraise其他異常 
end;
  //IdHTTP1.Disconnect; 
end;
//狀態顯示 
procedure TForm1.IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: string);
begin
  ListBox1.ItemIndex := ListBox1.Items.Add(AStatusText);
end;
//退出程序 
procedure TForm1.Button3Click(Sender: TObject);
begin
  //application.Terminate; 
  IdHTTP1.DisconnectSocket;
  Form1.close;
end;
//循環產生線程 
procedure TForm1.GetThread();
var
  i: integer;
  start: array[1..100] of integer;
  last: array[1..100] of integer;   //改用了數組，也可不用 
  fileName: string;
begin
  i := 1;
  while i <= nn do
  begin
    start[i] := avg * (i - 1);
    last[i] := avg * i -1; //這裏原先是last:=avg*i; 
    if i = nn then
    begin
      last[i] := avg*i + aFileSize-avg*nn; //這裏原先是aFileSize 
    end;
    fileName := aFile + IntToStr(i);
    MyThread[i] := TThread1.create1(aURL, aFile, fileName, false, i, start[i],
      last[i]);
    i := i + 1;
  end;
end;
procedure TForm1.AddFile(); //合併文件 
var
  mStream1, mStream2: TMemoryStream;
  i: integer;
begin
try
  i := 1;
  mStream1 := TMemoryStream.Create;
  mStream2 := TMemoryStream.Create;
  mStream1.loadfromfile(afile + '1');
  while i < nn do
  begin
    mStream2.loadfromfile(afile + IntToStr(i + 1));
    mStream1.seek(mStream1.size, soFromBeginning);
    mStream1.copyfrom(mStream2, mStream2.size);
    mStream2.clear;
    i := i + 1;
  end;
  FreeAndNil(mStream2);
  mStream1.SaveToFile(afile);
  FreeAndNil(mStream1);
  //刪除臨時文件 
  i:=1;
   while i <= nn do
  begin
    deletefile(afile + IntToStr(i));
    i := i + 1;
  end;
  Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('下載成功');
except
    i:=1;
    while i <= nn do
    begin
    if FileExists(aFile+inttostr(i)) then
    deletefile(afile + IntToStr(i));
    i := i + 1;
    end;
    ShowMessage('下載文件出錯，臨時文件已刪除，請重新下載！')
  end;
end;
procedure TForm1.NewAddFile(); //合併文件 
var
  i: Integer;
  InStream, OutStream : TFileStream;
  SourceFile : String;
begin
  try
    i := 1;
    OutStream:=TFileStream.Create(aFile,fmCreate);
    //OutStream:=TFileStream.Create(('D/1/'+aFile),fmCreate); //此句與savedialog衝突，發生異常，使savedialog指定路徑無效。 
    while i <= nn do
    begin
      SourceFile := afile + IntToStr(i);
      InStream:=TFileStream.Create(SourceFile, fmOpenRead);
      OutStream.CopyFrom(InStream,0);
      FreeAndNil(InStream);
      i:= i+1;
    end;
    FreeAndNil(OutStream);
    //刪除臨時文件 
    i:=1;
    while i <= nn do
    begin
    deletefile(afile + IntToStr(i));
    i := i + 1;
    end;
  except
    i:=1;
    while i <= nn do
    begin
    if FileExists(aFile+inttostr(i)) then
    deletefile(afile + IntToStr(i));
    i := i + 1;
    end;
  end;
  if FileExists(aFile) then
  begin
    FreeAndNil(OutStream);
    InStream := TFileStream.Create(aFile, fmOpenWrite);
    if InStream.Size < aFileSize then
    begin
      FreeAndNil(InStream);
      deletefile(afile);
      //ShowMessage('下載文件出錯，臨時文件已刪除，請重新下載！') 
      Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('下載文件出錯，臨時文件已刪除，請重新下載！');
    end
    else
    begin
      FreeAndNil(InStream);
      Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('下在成功');
    end;
  end;
  
end;
//構造函數 
constructor TThread1.create1(aURL, aFile, fileName: string; bResume: Boolean;
  Count, start, last: integer);
begin
  inherited create(true);
  FreeOnTerminate := true;
  tURL := aURL;
  tFile := aFile;
  fCount := Count;
  tResume := bResume;
  tstart := start;
  tlast := last;
  temFileName := fileName;
end;
//下載文件函數 
procedure TThread1.DownLodeFile();
var
  temhttp: TIdHTTP;
begin
  temhttp := TIdHTTP.Create(nil);
  temhttp.onWorkBegin := Form1.IdHTTP1WorkBegin;
  temhttp.onwork := Form1.IdHTTP1work;
  temhttp.onStatus := Form1.IdHTTP1Status;
  Form1.IdAntiFreeze1.OnlyWhenIdle := False; //設置使程序有反應. 
  if FileExists(temFileName) then //如果文件已經存在 
    tStream := TFileStream.Create(temFileName, fmOpenWrite)
  else
    tStream := TFileStream.Create(temFileName, fmCreate);
  if tResume then //續傳方式 
  begin
    exit;
  end
  else //覆蓋或新建方式 
  begin
    temhttp.Request.ContentRangeStart := tstart;
    temhttp.Request.ContentRangeEnd := tlast;
  end;
  try
    ///try 
      temhttp.Get(tURL, tStream); //開始下載 
    except
      if FileExists(temFileName) then
      begin
      freeandnil(tstream);
      deletefile(temFileName);//本來想用來刪除未下完的文件，可惜不成功，有的線程沒有刪除，只有部分刪除了， 
                              //不過這樣導致後面合併文件時出錯，同樣也可以把臨時文件刪除。 
      //ShowMessage('下載文件出錯，臨時文件已刪除，請重新下載！');/ 
      end;
      temhttp.Disconnect;
    end;
    Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add(temFileName +
      'download');
  //finally 
    freeandnil(tstream);
    temhttp.Disconnect;
  //end; 
end;
procedure TThread1.Execute;
begin
  if Form1.Edit1.Text <> '' then
    //synchronize(DownLodeFile) 
    DownLodeFile
  else
    exit;
  inc(tcount);
  if tcount = Form1.nn then //當tcount=nn時代表全部下載成功 
  begin
    Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('正在合併刪除臨時文件');
    Form1.NewAddFile;
    form1.time2 := Now;
    Form1.Label5.Caption := FormatDateTime ('n:ss', form1.Time2-Form1.Time1) + ' seconds';
  end;
end;
end. 
多線程idhttp下載文件源代碼

容器中nginx無法使用同一個網絡下的容器域名

Python: SunMoonTimeCalculator

「Pygors跨平臺GUI」1：Pygors跨平臺GUI應用研究

NETCore中實現一個輕量無負擔的極簡任務調度ScheduleTask

docker使用特定的網絡

使用c#強大的表達式樹實現對象的深克隆之解決循環引用的問題

「Pygors跨平臺GUI」2：安裝MinGW-w64、MSYS2還是WSL2

nodejs學習07——API

避免DbContext同時在多個線程調用

GPT-4o 引領人機交互新風向，向量數據庫賽道沸騰了

Delphi中進行延時的4種方法

不使用API讀取ini

多線程idhttp下載文件源代碼

VB 使用API讀寫INI

VB讓程序啓動時自動改名

https://yachay.unat.edu.pe/blog/index.php?comment_area=format_blog&comment_component=blog&comment_co

linux以太網驅動總結
