با کمی جستجو در این زمینه می توانید اطلاعات خیلی خوبی به دست بیاورید من به طور مختصر کدهای این برنامه را قرار دادم که با ایده گرفتن از آن و یا جستجو بیشتر نتایج بهتری به دست بیاورید . این برنامه کوچک قادر است فایل های روی host را دانلود کنید و نرمافزار خود را به روز کنید با دیگر object های آن مثل plogin می توانید اتصال به اینترنت را هم چک کنید و ... .
شی های مورد نیاز : IdLogEvent1 و IdAntiFreeze1 وIdFTP1 و DirectoryListBox و ProgressBar1 و... .
با استفاده از 4 فیلد متنی آدرس host و نام کاربری و کلمه عبور و آدرس فایل بر روی host را دریافت می کنیم . در دکمه connect کد زیر را می نویسیم .
.
.
procedure TMainForm.ConnectButtonClick(Sender: TObject);
begin
ConnectButton.Enabled := false;
if IdFTP1.Connected then try
if TransferrignData then IdFTP1.Abort;
IdFTP1.Quit;
finally
CurrentDirEdit.Text := '/';
DirectoryListBox.Items.Clear;
SetFunctionButtons(false);
ConnectButton.Caption := 'Connect';
ConnectButton.Enabled := true;
ConnectButton.Default := true;
end
else with IdFTP1 do try
Username := UserIDEdit.Text;
Password := PasswordEdit.Text;
Host := FtpServerEdit.Text;
Connect;
Self.ChageDir(CurrentDirEdit.Text);
SetFunctionButtons(true);
SaveFTPHostInfo(FtpServerEdit.Text, 'FTPHOST');
finally
ConnectButton.Enabled := true;
if Connected then begin
ConnectButton.Caption := 'Disconnect';
ConnectButton.Default := false;
end;
end;
end;
و در دکمه download کد زیر را وارد کنید .
procedure TMainForm.DirectoryListBoxDblClick(Sender: TObject);
Var
Name{, Line}: String;
begin
if not IdFTP1.Connected then exit;
//Line := DirectoryListBox.Items[DirectoryListBox.ItemIndex];
Name := IdFTP1.DirectoryListing.Items[DirectoryListBox.ItemIndex].FileName;
ED_File.Text:=Name;
if IdFTP1.DirectoryListing.Items[DirectoryListBox.ItemIndex].ItemType = ditDirectory then begin
// Change directory
SetFunctionButtons(false);
ChageDir(Name);
SetFunctionButtons(true);
end
else begin
try
SaveDialog1.FileName := Name;
if SaveDialog1.Execute then begin
SetFunctionButtons(false);
IdFTP1.TransferType := ftBinary;
BytesToTransfer := IdFTP1.Size(Name);
if FileExists(Name) then begin
case MessageDlg('File aready exists. Do you want to resume the download operation?',
mtConfirmation, mbYesNoCancel, 0) of
mrYes: begin
BytesToTransfer := BytesToTransfer - FileSizeByName(Name);
IdFTP1.Get(Name, SaveDialog1.FileName, false, true);
end;
mrNo: begin
IdFTP1.Get(Name, SaveDialog1.FileName, true);
end;
mrCancel: begin
exit;
end;
end;
end
else begin
IdFTP1.Get(Name, SaveDialog1.FileName, false);
end;
end;
finally
SetFunctionButtons(true);
end;
end;
end;
در eventهای idftp1 قسمت dFTP1WorkEnd و IdFTP1WorkBeginو IdFTP1Work کدهای زیر را وارد کنید .
procedure TMainForm.IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
Var
S: String;
TotalTime: TDateTime;
// RemainingTime: TDateTime;
H, M, Sec, MS: Word;
DLTime: Double;
begin
TotalTime := Now - STime;
DecodeTime(TotalTime, H, M, Sec, MS);
Sec := Sec + M * 60 + H * 3600;
DLTime := Sec + MS / 1000;
if DLTime > 0 then
AverageSpeed := {(AverageSpeed + }(AWorkCount / 1024) / DLTime{) / 2};
if AverageSpeed > 0 then begin
Sec := Trunc(((ProgressBar1.Max - AWorkCount) / 1024) / AverageSpeed);
S := Format('%2d:%2d:%2d', [Sec div 3600, (Sec div 60) mod 60, Sec mod 60]);
S := 'Time remaining ' + S;
end
else S := '';
S := FormatFloat('0.00 KB/s', AverageSpeed) + '; ' + S;
case AWorkMode of
wmRead: StatusBar1.Panels[1].Text := 'Download speed ' + S;
wmWrite: StatusBar1.Panels[1].Text := 'Uploade speed ' + S;
end;
if AbortTransfer then IdFTP1.Abort;
ProgressBar1.Position := AWorkCount;
AbortTransfer := false;
end;
//*********************
procedure TMainForm.IdFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
begin
TransferrignData := true;
AbortButton.Visible := true;
AbortTransfer := false;
STime := Now;
if AWorkCountMax > 0 then ProgressBar1.Max := AWorkCountMax
else ProgressBar1.Max := BytesToTransfer;
AverageSpeed := 0;
end;
//**********************
procedure TMainForm.IdFTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
AbortButton.Visible := false;
StatusBar1.Panels[1].Text := 'Transfer complete.';
BytesToTransfer := 0;
TransferrignData := false;
ProgressBar1.Position := 0;
AverageSpeed := 0;
end;
اگه کد برنامه را برای دانلود می کذاشتید خیلی بهتر بود