用delphi實現ftp多線程下載原始碼(轉)

標籤：設定   exist   多線程   run   edit   ring   rtt   star   items   

//接收檔案 
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; 

//得到檔案大小 
function TForm1.GetFileSize(aURL: string):integer; 
var 
FileSize : integer; 
tStream: TFileStream; 
FileName: String; 
begin 
//tStream.size := 0; 
IdFTP1.StructureMount(aURL);********************************不知道用的對不對? 
//FileSize := IdFTP1.Response.ContentLength; 
FileSize := IdFTP1.size(FileName); 
//FileSize := IdFTP1.ContentLength(FileName); 
IdFTP1.Abort; 
Result := FileSize; 

end; 


//多線程下載 
procedure TForm1.Button11Click(Sender: TObject); 
var 
m:integer; 
begin 
Showmessage(‘OK!主線程在執行，獲得檔案名稱並顯示在Edit5中‘); 
aURL := Edit4.Text; //ftp方式 
aFile := GetURLFileName(Edit4.Text);//得到檔案名稱 
xx:= StrToInt(Edit5.Text); //輸入的線程數 
m:=1; 
aFileSize := GetFileSize(aURL); 
avg := trunc(aFileSize/xx); 
try 
GetThread(); 
while m<=xx do 
begin 
MyThread[m].Resume; //喚醒線程 
m :=m+1; 
end; 
except 
Showmessage(‘建立線程失敗!‘); 
Exit; 
end; 
end; 

//開始下載前,將ProgressBar1的最大值設定為需要接收的資料大小.******************* 
procedure TForm1.IdFTP1WorkBegin(Sender:TObject; AWorkMode: TWorkMode; 
const AWorkCountMax: Integer); 
begin 
AbortTransfer := False; 
ProgressBar1.Max:=AWorkCountMax; 
ProgressBar1.Min:=0; 
ProgressBar1.Position:=0; 
end; 

//狀態顯示 
procedure TForm1.IdFTP1Status(ASender: TObject;const AStatus: TIdStatus; 
const AStatusText: String); 
begin 
ListBox1.ItemIndex :=ListBox1.Items.Add(AStatusText); 
end; 

// 多線程的產生 
procedure TForm1.GetThread(); 
var 
i ,start,last : integer; 
FileName : String; 
begin 
i:=1; 
while i<=xx do 
begin 
if i=1 then 
begin 
start := 0; 
last := avg*i; 
end 
else 
start := avg*(i-1); 
last := avg*i; 
FileName:=aFile+IntToStr(i); 
MyThread[i]:=TThread1.create(aURL,aFile,FileName, false , i,start,last); 
i :=i+1; 
end; 
end; 

//建構函式 
constructor TThread1.create(aURL,aFile,FileName: String; bResume: Boolean ;Count,start,last:integer); 
begin 
inherited create(true); 
FreeOnTerminate := true; 
tURL := aURL; 
tFile := aFile; 
tCount := Count; 
tResume := bResume; 
tstart :=start; 
tlast :=last; 
temFileName:= FileName; 
end; 

//下載檔案函數 
procedure TThread1.DownLodeFile(); 
var 
//ftp: TIdFTP; 
TIdFTP1 : TIdFTP; 
tStream: TFileStream; 
begin 
TIdFTP1 := TIdFTP.Create(nil); 
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 
TIdFTP1.MaxLineLength := tstart;(不對)********************檔案下載的開始位置用TIdFTP什麼屬性來設定? 
TIdFTP1.MinLineLength := tlast;(不對)*********************檔案下載的結束位置用TIdFTP什麼屬性來設定? 


end; 
try 
//TIdFTP1.Get(temFileName,tStream,true); //開始下載 
TIdFTP1.Get(tURL,tStream); //開始下載 
Form1.ListBox1.ItemIndex :=Form1.ListBox1.Items.Add(temFileName+‘download‘); 
finally 
tStream.Free; 
end; 
end; 

procedure TThread1.Execute; 
begin 
if Form1.Edit4.Text<>‘‘ then 
synchronize(DownLodeFile) 
else 
exit; 
end;

用delphi實現ftp多線程下載原始碼(轉)