求ftp源代码! ( 积分: 200 )

  • 主题发起人 主题发起人 楚非帆
  • 开始时间 开始时间

楚非帆

Unregistered / Unconfirmed
GUEST, unregistred user!
idftp是垃圾,不知道borland怎么会用id的产品。
nmftp没用过,不过看大家的评价也不怎么样!

200分求ftp下载源程序。不要控件!my email:chu@sykd.cn

附送资料两篇。
一篇ftp协议,请哪位高手有时间帮忙看一下写一个源代码
http://www.delphibbs.com/delphibbs/dispq.asp?lid=505194
一个多线程ftp下载的c++源代码,请懂C++的高手帮忙改一下
http://www.csdn.com.cn/program/3923.htm
 
idftp是垃圾,不知道borland怎么会用id的产品。
nmftp没用过,不过看大家的评价也不怎么样!

200分求ftp下载源程序。不要控件!my email:chu@sykd.cn

附送资料两篇。
一篇ftp协议,请哪位高手有时间帮忙看一下写一个源代码
http://www.delphibbs.com/delphibbs/dispq.asp?lid=505194
一个多线程ftp下载的c++源代码,请懂C++的高手帮忙改一下
http://www.csdn.com.cn/program/3923.htm
 
关注一哈

------------------------
www.e-lines.com.cn
 
你可以参考《Delphi 网络通信协议分析与应用实现》
上面有用API来实现的。
 
没有此书!如果有pdf,请不吝赐教!
 
TIdFTP的控件不就好了。最近帮朋友写了一个垃圾毕设。你要求是不是太高了!!

既然,你说人家的控件垃圾。要不然,你就自己按FTP协议搞好了。hehe~
 
同意Doll_paul的说法
 
我说了求ftp源程序,还说让我自己搞,我说了没有这水平。
不会就闭嘴阿,要么像鳄鱼先生那样提点建设性的意见!
 
为什么要自己开发呀
 
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, wininet,
StdCtrls, ComCtrls, FileCtrl;

type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
txtFTP: TEdit;
txtUsername: TEdit;
txtPassword: TEdit;
txtPath: TEdit;
CheckBox1: TCheckBox;
btnOpen: TButton;
btnList: TButton;
btnClose: TButton;
StatusBar1: TStatusBar;
ListBox1: TListBox;
DriveComboBox1: TDriveComboBox;
DirectoryListBox1: TDirectoryListBox;
FileListBox1: TFileListBox;
btnDownload: TButton;
RadioButton2: TRadioButton;
RadioButton1: TRadioButton;
btnUpload: TButton;
btnMkDir: TButton;
btnRmDir: TButton;
btnDelete: TButton;
btnRename: TButton;
procedure btnOpenClick(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btnListClick(Sender: TObject);
procedure ListBox1DblClick(Sender: TObject);
procedure btnDownloadClick(Sender: TObject);
procedure FileListBox1Change(Sender: TObject);
procedure DriveComboBox1Change(Sender: TObject);
procedure DirectoryListBox1Change(Sender: TObject);
procedure FileListBox1Click(Sender: TObject);
procedure btnUploadClick(Sender: TObject);
procedure btnMkDirClick(Sender: TObject);
procedure btnRmDirClick(Sender: TObject);
procedure btnDeleteClick(Sender: TObject);
procedure btnRenameClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
hInternet: pointer ;
hConnect: pointer ;
localDir: string ;

const
RootDot = '..' ;


implementation

{$R *.DFM}

function GetFTPDirectory(hConnect: pointer): string ;
var
dwDir: DWORD ;
Dir: array [0..255] of char ;
begin
dwDir := sizeof(Dir) ;

// FtpGetCurrentDirectory retrieves the current directory for the connection.
// returns True if successful
if FtpGetCurrentDirectory(hConnect, Dir, dwDir) Then
begin
if StrRScan(Dir, '/') + 1 = StrEnd(Dir) then
result := trim(StrPas(Dir))
else
result := trim(StrPas(Dir)) + '/' ;
end ;
end ;


procedure GetFTPDirectoryContents() ;
var
WFD: TWin32FindData ;

hFind: pointer ;

FTPPath: String;
begin
Form1.ListBox1.Clear ;

// Obtain the current FTP path
FTPPath := GetFTPDirectory(hConnect) ;

If FTPPath <> '/' Then Form1.ListBox1.Items.Add(RootDot) ;

FTPPath := FTPPath + '*.*' ;

if (hInternet <> nil) then
begin
if (hConnect <> nil) then
begin
// obtain the file handles via FtpFindFirstFile
// Search the first available file or directory
hFind := FtpFindFirstFile(hConnect,
pchar(FTPPath),
WFD,
INTERNET_FLAG_RELOAD OR INTERNET_FLAG_NO_CACHE_WRITE,
$0) ;

If (hFind <> nil) then
begin
repeat
If strLen(WFD.cFileName) > 0 Then
begin
If WFD.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY Then
Form1.ListBox1.Items.Add(StrPas(WFD.cFileName) + '/')
else
Form1.ListBox1.Items.Add(strPas(WFD.cFileName)) ;
end ;

// Search the next available file or directory
until not InternetFindNextFile(hFind, @WFD) ;

// close file handle
InternetCloseHandle(hFind) ;
end ;
end ;
end ;
end ;


procedure TForm1.btnOpenClick(Sender: TObject);
var
FTPSite: String ;
begin
// Begin the FTP process by obtaining a handle to an internet session.
//
// INTERNET_OPEN_TYPE_DIRECT = 1; {direct to net}
// INTERNET_OPEN_TYPE_PROXY = 3; {via named proxy }
// INTERNET_FLAG_NO_CACHE_WRITE = $04000000; {don't write this item to the cache}

if CheckBox1.Checked = True then
hInternet := InternetOpen(pchar('FTP Application'),
INTERNET_OPEN_TYPE_PROXY,
nil,
nil,
INTERNET_FLAG_NO_CACHE_WRITE)
else
hInternet := InternetOpen(pchar('FTP Application'),
INTERNET_OPEN_TYPE_DIRECT,
nil,
nil,
INTERNET_FLAG_NO_CACHE_WRITE) ;

// If internet session created OK
if (hInternet <> nil) then
begin
FTPSite := txtFTP.Text ;

// 产生FTP service 的handle值?
//
// nServerPort: INTERNET_DEFAULT_FTP_PORT = 21
// FTP服务器的预设通讯端口(设定Internet服务的通讯端口)?
//
// dwService: INTERNET_SERVICE_FTP = 1
// FTP服务(设定Internet 服务类型)?

if (txtUsername.Text = '') and (txtPassword.Text = '') then
// anonymous
hConnect := InternetConnect(hInternet, pchar(FTPSite),
INTERNET_DEFAULT_FTP_PORT,
nil,
nil,
INTERNET_SERVICE_FTP,
INTERNET_FLAG_EXISTING_CONNECT OR INTERNET_FLAG_PASSIVE,
$0)

else
hConnect := InternetConnect(hInternet, pchar(FTPSite),
INTERNET_DEFAULT_FTP_PORT,
pchar(txtUsername.Text),
pchar(txtPassword.Text),
INTERNET_SERVICE_FTP,
INTERNET_FLAG_EXISTING_CONNECT OR INTERNET_FLAG_PASSIVE,
$0) ;

// If connection created OK
If (hConnect <> nil) Then
begin
// Get Current Directory
txtPath.Text := GetFTPDirectory(hConnect) ;

btnOpen.Enabled := False ;
btnList.Enabled := True ;
btnClose.Enabled := True ;

if (txtUsername.Text = '') and (txtPassword.Text = '') then
StatusBar1.Panels[0].Text := 'FTP Connection Opened - anonymous'
else
StatusBar1.Panels[0].Text := 'FTP Connection Opened - ' + txtUsername.Text ;
end
else
begin
btnOpen.Enabled := True ;
btnList.Enabled := False ;
btnClose.Enabled := False ;

StatusBar1.Panels[0].Text := 'Error: Can not create Connection Session.' ;
end ;
end
else
begin
btnOpen.Enabled := True ;
btnList.Enabled := False ;
btnClose.Enabled := False ;

StatusBar1.Panels[0].Text := 'Error: Can not create Internet Session.' ;
end ;
end;


procedure TForm1.btnCloseClick(Sender: TObject);
begin
// close internet service connection
if (hConnect <> nil) then
begin
InternetCloseHandle(hConnect) ;
hConnect := nil ;
StatusBar1.Panels[0].Text := 'Internet Service Closed.' ;
end ;

// close internet session
if (hInternet <> nil) then
begin
InternetCloseHandle(hInternet) ;
hInternet := nil ;
StatusBar1.Panels[0].Text := 'Internet Connection Closed.' ;
end ;

btnOpen.Enabled := True ;
btnList.Enabled := False ;
btnClose.Enabled := False ;
btnDownload.Enabled := False ;
btnUpload.Enabled := False ;

StatusBar1.Panels[0].Text := 'FTP connection closed.' ;

txtPath.Text := '' ;
ListBox1.Clear ;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
btnOpen.Enabled := True ;
btnList.Enabled := False ;
btnClose.Enabled := False ;
btnDownload.Enabled := False ;
btnUpload.Enabled := False ;

ListBox1.Clear ;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// close internet service connection
if (hConnect <> nil) then
begin
InternetCloseHandle(hConnect) ;
hConnect := nil ;
end ;

// close internet session
if (hInternet <> nil) then
begin
InternetCloseHandle(hInternet) ;
hInternet := nil ;
end ;

application.Terminate ;
end;


procedure TForm1.btnListClick(Sender: TObject);
begin
GetFTPDirectoryContents();

btnOpen.Enabled := False ;
btnList.Enabled := True ;
btnClose.Enabled := True ;

btnDownload.Enabled := True ;
btnUpload.Enabled := True ;
end;


procedure TForm1.ListBox1DblClick(Sender: TObject);
var
NewPath: String ;
FTPPath: String ;
i: integer ;
begin
for i := 0 to (ListBox1.Items.Count - 1) do
begin
if ListBox1.Selected then
NewPath := ListBox1.items.Strings
end;

If (NewPath <> RootDot) And (StrRScan(pchar(NewPath), '/') + 1 <> StrEnd(pchar(NewPath))) Then
exit
else
begin
ListBox1.Clear ;

FTPPath := GetFTPDirectory(hConnect) ;

if StrRScan(pchar(FTPPath), '/') + 1 = StrEnd(pchar(FTPPath)) then
FTPPath := trim(FTPPath) + NewPath
else
FTPPath := trim(FTPPath) + NewPath + '/' ;

// set the new path using the API
FtpSetCurrentDirectory(hConnect, pchar(FTPPath)) ;

// reflect the new path in the text box
txtPath.Text := GetFTPDirectory(hConnect) ;

// reload the list with the current directory
GetFTPDirectoryContents();
end ;
end ;


//
// Download File from FTP server to local directory
//
procedure TForm1.btnDownloadClick(Sender: TObject);
var
RemoteFile: String ;
LocalFile: String ;
sFile: String ;
FTPPath: String ;
i: integer ;
blnReturn: boolean ;
dwInternetFlags: DWORD ;
begin
if (hConnect <> nil) then
begin
FTPPath := GetFTPDirectory(hConnect) ;

for i := 0 to (ListBox1.Items.Count - 1) do
begin
if ListBox1.Selected then
sFile := ListBox1.items.Strings
end;

If (sFile = '') or (sFile = RootDot) or (StrRScan(pchar(sFile), '/') + 1 = StrEnd(pchar(sFile))) Then
exit
else
begin
// FTP Remote file name
RemoteFile := FTPPath + sFile ;

// Local file name
LocalFile := localDir + sFile ;

StatusBar1.Panels[0].Text := 'Downloading' ;

// FILE_ATTRIBUTE_ARCHIVE = $00000020;
// FTP_TRANSFER_TYPE_UNKNOWN = $00000000;

// FTP download (get)
if RadioButton1.Checked then
dwInternetFlags := FTP_TRANSFER_TYPE_BINARY
else
dwInternetFlags := FTP_TRANSFER_TYPE_ASCII ;

blnReturn := FtpGetFile(hConnect,
pchar(RemoteFile),
pchar(LocalFile),
False,
FILE_ATTRIBUTE_ARCHIVE,
dwInternetFlags,
$0) ;

If blnReturn then
begin
// Download successfully
StatusBar1.Panels[0].Text := 'Downloaded successfully.' ;
ShowMessage('Downloaded successfully.');
end
else
begin
// Error
StatusBar1.Panels[0].Text := 'Downloaded error.' ;
ShowMessage('Downloaded error.');
end ;

FileListBox1.Update ;
end ;
end ;
end;


procedure TForm1.FileListBox1Change(Sender: TObject);
begin
FileListBox1.Refresh ;
end;


procedure TForm1.DriveComboBox1Change(Sender: TObject);
begin
localDir := DriveComboBox1.Drive + ':/' ;
StatusBar1.Panels[0].Text := 'Local Drive: ' + localDir ;

DirectoryListBox1.OnChange(nil) ;
end;


procedure TForm1.DirectoryListBox1Change(Sender: TObject);
begin
If (StrRScan(pchar(DirectoryListBox1.Directory), '/') + 1 <>
StrEnd(pchar(DirectoryListBox1.Directory))) Then

localDir := DirectoryListBox1.Directory + '/'
else
localDir := DirectoryListBox1.Directory ;

StatusBar1.Panels[0].Text := 'Local Directory: ' + localDir ;
end;


procedure TForm1.FileListBox1Click(Sender: TObject);
begin
StatusBar1.Panels[0].Text := 'Local File: ' + FileListBox1.FileName ;
end;


//
// Upload File from local directory to FTP server
//
procedure TForm1.btnUploadClick(Sender: TObject);
var
RemoteFile: String ;
LocalFile: String ;
sFile: String ;
FTPPath: String ;
i: integer ;
blnReturn: boolean ;
dwInternetFlags: DWORD ;
begin
if (hConnect <> nil) then
begin
FTPPath := GetFTPDirectory(hConnect) ;

for i := 0 to (FileListBox1.Items.Count - 1) do
begin
if FileListBox1.Selected then
sFile := FileListBox1.Items.Strings
end;

If (sFile = '') Then
exit
else
begin
// Local file name
LocalFile := localDir + sFile ;

// FTP Remote file name
RemoteFile := FTPPath + sFile ;

StatusBar1.Panels[0].Text := 'Uploading' ;

// FILE_ATTRIBUTE_ARCHIVE = $00000020;

// FTP upload (put)
if RadioButton1.Checked then
dwInternetFlags := FTP_TRANSFER_TYPE_BINARY
else
dwInternetFlags := FTP_TRANSFER_TYPE_ASCII ;

blnReturn := FtpPutFile(hConnect,
pchar(LocalFile),
pchar(RemoteFile),
dwInternetFlags,
$0) ;

If blnReturn then
begin
// Download successfully
StatusBar1.Panels[0].Text := 'Uploaded successfully.' ;
ShowMessage('Uploaded successfully.');
end
else
begin
// Error
StatusBar1.Panels[0].Text := 'Uploaded error.' ;
ShowMessage('Uploaded error.');
end ;

GetFTPDirectoryContents();

ListBox1.Update ;
end ;
end ;
end;

procedure TForm1.btnMkDirClick(Sender: TObject);
var
RemoteDir: string;
blnReturn: boolean ;
begin
if (hConnect <> nil) then
begin
RemoteDir := InputBox('FTP Create Directory', 'Enter a new remote directory: ', '');

If (RemoteDir = '') Then
exit
else
begin
// Create a FTP Remote Directory
blnReturn := FtpCreateDirectory(hConnect, pchar(RemoteDir)) ;

StatusBar1.Panels[0].Text := 'Making a new FTP directory' ;

If blnReturn then
begin
// Create Directory successfully
StatusBar1.Panels[0].Text := 'Created directory successfully.' ;
ShowMessage('Created directory successfully.');
end
else
begin
// Error
StatusBar1.Panels[0].Text := 'Created directory error.' ;
ShowMessage('Created directory error.');
end ;

GetFTPDirectoryContents();

ListBox1.Update ;
end ;
end ;
end;


procedure TForm1.btnRmDirClick(Sender: TObject);
var
RemoteDir: string;
FTPPath: String ;
blnReturn: boolean ;
i: integer;
begin
for i := 0 to (ListBox1.Items.Count - 1) do
begin
if ListBox1.Selected then
RemoteDir := ListBox1.items.Strings
end;

If (RemoteDir = '') or (StrRScan(pchar(RemoteDir), '/') + 1 <> StrEnd(pchar(RemoteDir))) Then
exit
else
begin
if (hConnect <> nil) then
begin
FTPPath := GetFTPDirectory(hConnect) ;

Delete(RemoteDir, Length(RemoteDir), 1);

// Remove a FTP Remote Directory
RemoteDir := FTPPath + RemoteDir ;

blnReturn := FtpRemoveDirectory(hConnect, pchar(RemoteDir)) ;

StatusBar1.Panels[0].Text := 'Removing a FTP directory' ;

If blnReturn then
begin
// Remove Directory successfully
StatusBar1.Panels[0].Text := 'Removed directory successfully.' ;
ShowMessage('Removed directory successfully.');
end
else
begin
// Error
StatusBar1.Panels[0].Text := 'Removed directory error.' ;
ShowMessage('Removed directory error.');
end ;

GetFTPDirectoryContents();

ListBox1.Update ;
end ;
end ;
end;


procedure TForm1.btnDeleteClick(Sender: TObject);
var
RemoteFile: string;
FTPPath: String ;
blnReturn: boolean ;
i: integer;
begin
for i := 0 to (ListBox1.Items.Count - 1) do
begin
if ListBox1.Selected then
RemoteFile := ListBox1.items.Strings
end;

If (RemoteFile = '') or
(RemoteFile = RootDot) or
(StrRScan(pchar(RemoteFile), '/') + 1 = StrEnd(pchar(RemoteFile))) Then
exit
else
begin
if (hConnect <> nil) then
begin
FTPPath := GetFTPDirectory(hConnect) ;

// Remove a FTP Remote Directory
RemoteFile := FTPPath + RemoteFile ;

blnReturn := FtpDeleteFile(hConnect, pchar(RemoteFile)) ;

StatusBar1.Panels[0].Text := 'Removing a FTP file' ;

If blnReturn then
begin
// Remove file successfully
StatusBar1.Panels[0].Text := 'Removed file successfully.' ;
ShowMessage('Removed file successfully.');
end
else
begin
// Error
StatusBar1.Panels[0].Text := 'Removed file error.' ;
ShowMessage('Removed file error.');
end ;

GetFTPDirectoryContents();

ListBox1.Update ;
end ;
end ;
end;


procedure TForm1.btnRenameClick(Sender: TObject);
var
RemoteOldFile: string;
RemoteNewFile: string;
FTPPath: String ;
blnReturn: boolean ;
i: integer;
begin
for i := 0 to (ListBox1.Items.Count - 1) do
begin
if ListBox1.Selected then
RemoteOldFile := ListBox1.items.Strings
end;

If (RemoteOldFile = '') or
(RemoteOldFile = RootDot) or
(StrRScan(pchar(RemoteOldFile), '/') + 1 = StrEnd(pchar(RemoteOldFile))) Then
exit
else
begin
RemoteNewFile := InputBox('FTP Rename File',
'Enter a new remote file name for ' + RemoteOldFile + ': ', '');

If (RemoteNewFile = '') Then exit ;

if (hConnect <> nil) then
begin
FTPPath := GetFTPDirectory(hConnect) ;

RemoteOldFile := FTPPath + RemoteOldFile ;
RemoteNewFile := FTPPath + RemoteNewFile ;

// Remove a FTP Remote Directory
blnReturn := FtpRenameFile(hConnect,
pchar(RemoteOldFile),
pchar(RemoteNewFile)) ;

StatusBar1.Panels[0].Text := 'Renaming a FTP file' ;

If blnReturn then
begin
// Rename file successfully
StatusBar1.Panels[0].Text := 'Renamed file successfully.' ;
ShowMessage('Renamed file successfully.');
end
else
begin
// Error
StatusBar1.Panels[0].Text := 'Renamed file error.' ;
ShowMessage('Renamed file error.');
end ;

GetFTPDirectoryContents();

ListBox1.Update ;
end ;
end ;
end;

end.
 
unit PTUpLoad; //注意:pTUpLoad是当前unit保存建议的文件名

interface
uses
NMFtp, IdWinsock, windows, Dialogs, SysUtils, Classes,
ZLib, Registry, INIFILES; //注意 pdm是数据模块pdm.pas
type TUpLoad = class
private
public
app: string;
constructor Create(lapp: string); //构造函数
function UPLOAD(ulFile: string): boolean;
end;
var UPLOAD: TUpLoad;


implementation

uses PPUBPAS;

constructor TUpLoad.Create(lapp: string); //构造函数
begin
app := lapp;
end;


function TUpLoad.UPLOAD(ulFile: string): boolean;
var NMFTP1: TNMFTP;
sDest: string;
begin
sDest := copy(ulFile, length(app) + 1, 255); // 开始不能含 /
result := false;
NMFTP1 := TNMFTP.Create(nil);
NMFTP1.Host := getinikey(pchar(app + 'NetUpdate.ini'), 'ftp', 'Host');
NMFTP1.Port := strtoint(getinikey(pchar(app + 'NetUpdate.ini'), 'ftp', 'Port'));
NMFTP1.UserID := getinikey(pchar(app + 'NetUpdate.ini'), 'ftp', 'UserID');
NMFTP1.Password := getinikey(pchar(app + 'NetUpdate.ini'), 'ftp', 'Password');
try
NMFTP1.Connect();
except
showmessage('远程Ftp服务器没有启动或没有建立用户名!');
NMFTP1.Free;
exit;
end;
try
if pos('/', sDest) > 0 then NMFTP1.MakeDirectory(copy(sDest, 1, pos('/', sDest) - 1));
except
showmessage('服务器目录:' + copy(sDest, 1, pos('/', sDest) - 1) + '已经存在!');
end;


try
NMFTP1.UPLOAD(ulFile, sDest);
except
showmessage('上传失败,原因未知:可能是没有分配用户名,或用户没有!');
NMFTP1.Free;
exit;
end;

NMFTP1.Free;
result := true;
end;
 
function IsFileInUse(fName : string ):boolean; //检测文件是否正在使用
var
HFileRes : HFILE;
begin
Result := false;
if not FileExists(fName) then
exit;
HFileRes := CreateFile(pchar(fName), GENERIC_READ or GENERIC_WRITE,0, nil, OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL, 0);
Result := (HFileRes = INVALID_HANDLE_VALUE);
if not Result then
CloseHandle(HFileRes);
end;

procedure TDownForm.DownLoadDir(LocalPath,ServerPath:string);
var
i,count1:integer;
att:TIdDirItemType;
FileList : TStrings;
Name{, Line}: String;
ss:string;
begin
try begin
FileList := TStringList.Create;
ChageDir(serverpath);
Application.ProcessMessages;
if AnsiLastChar(serverpath) <> '/' then
serverpath := serverpath + '/';
if AnsiLastChar(localpath) <> '/' then
localpath := localpath + '/';
if not DirectoryExists(localpath+serverpath) then ForceDirectories(localpath+serverpath);
IdFTP1.List(FileList);
Application.ProcessMessages;
count1:=IdFTP1.DirectoryListing.Count;
for i:=0 to count1-1 do begin
ss:=IdFTP1.DirectoryListing.Items.FileName;
att:=IdFTP1.DirectoryListing.Items.ItemType;
if (att<>ditDirectory) then begin
if not DirectoryExists(localpath+serverpath) then ForceDirectories(localpath+serverpath);
BytesToTransfer := IdFTP1.Size(ss);
if IsFileInUse(ss)=False then
IdFTP1.Get(ss,localpath+serverpath+ss,true)
else Exit;
Application.ProcessMessages;
lbl1.Caption:='已下载:'+ss;
lbl1.Update;
end
end;
for i:=0 to count1-1 do begin
ss:=IdFTP1.DirectoryListing.Items.FileName;
att:=IdFTP1.DirectoryListing.Items.ItemType;
BytesToTransfer := IdFTP1.Size(ss);
if (att=ditDirectory) and (ss <> '.') AND (ss <> '..') then begin
Name := ss;
if not DirectoryExists(localpath+serverpath+Name) then ForceDirectories(localpath+serverpath+Name);
DownLoadDir(localpath+serverpath,Name);
Application.ProcessMessages
end;
end;
ChageDir('..');//这句是返回前一个目录,写的另一个函数,可以用IdFTP1.ChangeDir替换
Filelist.Free;
end
except
end;
end;

procedure Tf_yrdwfileinfo.FTP_DownloadDir(remote_dir,local_dir:string); //下载整个目录,并遍历所有子目录 使用clftp
var
i,j,count1:integer;
att,ss:string;
current_dir,remote_dir2,currfile:string;
temp_dir,ftpdir:string;
F:textfile;
diratt:string;
filei:TFtpFileInfo;
lst : TStringList;
begin
ftpdir:=FtpClient1.HostDirName;
remote_dir2:=ftpdir+'/'+remote_dir;
FtpClient1.HostDirName :=remote_dir2;
//==========刷新目录
ftprefurbish(False );
//==========
current_dir:=remote_dir2; //主目录
temp_dir :=remote_dir ;
if not DirectoryExists(local_dir) then CreateDir(local_dir);
if not directoryexists(local_dir+'/'+temp_dir) then createdir(local_dir+'/'+temp_dir);

lst := TStringList.Create;
lst.LoadFromFile(TEMP_FILE_NAME);
for i :=2 to lst.Count - 1 do
begin
diratt:=lst;
filei:=GetFileInfo(diratt);
if (copy(filei.Attrib ,1,1)<>'d') then
begin
//if not DirectoryExists(local_dir) then CreateDir(local_dir); //创退本地目录
//==========下载文件
ftpclient1.Pwd ;
currfile:=ftpclient1.DirResult ;
currfile:=currfile+'/'+filei.FileName ;
ftpclient1.HostFileName :=currfile;
Ftpclient1.Binary :=true;
FtpClient1.TypeSet ;
ftpclient1.LocalFileName :=local_dir+'/'+temp_dir+'/'+filei.FileName ;
ftpclient1.Get ;
Ftpclient1.Binary :=false;
FtpClient1.TypeSet ;
//==========
end
else
begin
if not (filei.Filename ='..') then
begin
FTP_DownloadDir(filei.FileName,local_dir+'/'+remote_dir);
end;
end;
end;
lst.Free ;
end;
 
我可能没有说清楚,我想要的是用socket来进行ftp下载的例程。
鳄鱼先生和啊啊啊啊啊提供的是利用api完成。而13708782004和killer分别提供了用nmftp控件和indy的idftp控件完成下载的例程。

虽然没有找到想要的东西,不过通过网上的搜索已经独立完成了自己需要的东东(看样子偷懒是搞不成的)。非常感谢上述四位dfw的帮助。也请路过的dfw收藏此贴,此贴有三种实现ftp的方法哦,可能会对你以后的工作有所帮助!!!
分数不多,敬请笑纳!
 
后退
顶部