1 unit Unit1;
  2 
  3 interface
  4 
  5 uses
  6   //引用   Vcl.ExtActns
  7   Vcl.ExtActns,
  8 
  9   System.SysUtils, System.Types, System.UITypes, System.Classes,
 10   System.Variants,
 11   FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
 12   IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, FMX.Edit;
 13 
 14 type
 15   TForm1 = class(TForm)
 16     GroupBox1: TGroupBox;
 17     ProgressBar1: TProgressBar;
 18     Edit1: TEdit;
 19     GroupBox2: TGroupBox;
 20     Edit3: TEdit;
 21     Edit4: TEdit;
 22     Label1: TLabel;
 23     Label2: TLabel;
 24     Label3: TLabel;
 25     Button1: TButton;
 26     procedure Button1Click(Sender: TObject);
 27   private
 28     procedure URL_OnDownloadProgress(Sender: TDownLoadURL;
 29       Progress, ProgressMax: Cardinal; StatusCode: TURLDownloadStatus;
 30       StatusText: String; var Cancel: Boolean);
 31 
 32   public
 33     { Public declarations }
 34   end;
 35 
 36 var
 37   Form1: TForm1;
 38 
 39 implementation
 40 
 41 {$R *.fmx}
 42 var
 43   DownLoadURL1:TDownLoadURL;
 44 
 45 //url=网络文件  'http://helloroman.oicp.net:8000/test.rar';
 46 //Filename=保存到本地文件 'D:\Administrator\Desktop\123.rar';
 47 function DownLoadFile(url,Filename:string):boolean;
 48 var
 49   DownLoadURL1:TDownLoadURL;
 50 begin
 51     try
 52       DownLoadURL1:=TDownLoadURL.Create(Form1);
 53       DownLoadURL1.URL:= url;
 54       DownLoadURL1.Filename:= Filename;
 55       DownLoadURL1.OnDownloadProgress:=Form1.URL_OnDownloadProgress;
 56       DownLoadURL1.ExecuteTarget(nil);
 57       DownLoadURL1.Free;
 58       Result:=true;
 59     except
 60        Result:=false;
 61     end;
 62 end;
 63 
 64 
 65 procedure DownLoadThread;
 66 begin
 67   Form1.label3.Text:='0 kb / 0 kb';
 68 
 69   if DirectoryExists(ExtractFilePath(Form1.edit4.text)) then
 70   begin
 71        if not DownLoadFile(Form1.edit3.text,Form1.edit4.text) then
 72              Form1.GroupBox1.Text:='下载失败'
 73         else
 74            Form1.GroupBox1.Text:='下载完毕';
 75   end
 76   else
 77      SHowMessage(Form1.edit4.text + '不存在！');
 78 
 79 end;
 80 
 81 
 82 procedure TForm1.Button1Click(Sender: TObject);
 83 begin
 84      TThread.CreateAnonymousThread(DownLoadThread).Start;
 85 end;
 86 
 87 function BytesToStr(iBytes: Integer): String;
 88 var
 89   iKb: Integer;
 90 begin
 91   iKb := Round(iBytes / 1024);
 92   if iKb > 1000 then
 93     Result := Format('%.2f MB', [iKb / 1024])
 94   else
 95     Result := Format('%d KB', [iKb]);
 96 end;
 97 
 98 
 99 // 获取网络文件名
100 function GetUrlFileName(url:string):string;
101 var
102  str:string;
103 begin
104  url:=StringReplace(StrRScan(PChar(url),'/'), '/', '',[rfReplaceAll]);
105  if Pos('=',url) > 0 then
106     url:=StringReplace(StrRScan(PChar(url),'='), '=', '',[rfReplaceAll]);
107  Result:=url;
108 end;
109 
110 
111 
112 procedure TForm1.URL_OnDownloadProgress(Sender: TDownLoadURL;
113   Progress, ProgressMax: Cardinal; StatusCode: TURLDownloadStatus;
114   StatusText: String; var Cancel: Boolean);
115 begin
116 
117 
118   ProgressBar1.Max := ProgressMax div 100;
119   ProgressBar1.Value := Progress div 100;
120 
121 
122   Caption := StatusText;
123 
124   case StatusCode of
125     dsFindingResource:GroupBox1.Text:='查找资源...';
126     dsConnecting:GroupBox1.Text:='连接中...';
127     dsRedirecting:GroupBox1.Text:='';
128     dsBeginDownloadData:GroupBox1.Text:='准备下载文件...';
129     dsDownloadingData:GroupBox1.Text:='下载中...';
130 
131   end;
132 
133 
134   Edit1.Text:= Format('文件名：%s',[GetUrlFileName(Edit3.Text)]);
135   label3.Text := Format('%s / %s', [BytesToStr(Progress),BytesToStr(ProgressMax)]);
136 end;
137 
138 end.