帮帮忙：如何把FTP服务器（HP Unix缺省的ftp服务）某一目录的全部文件拷贝到自己计算机里？

Demo里面是控制台模式，你看着改吧：
{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  23310: FTPServer_console.dpr
{
{   Rev 1.1    25/10/2004 22:48:54  ANeillans    Version: 9.0.17
{ Verified
}
{
{   Rev 1.0    12/09/2003 22:47:52  ANeillans
{ Initial Checkin
{ Verified against Indy 9 and D7
}
{
  Demo Name:  FTP Server Demo
  Created By: Bas Gooijen
          On: Unknown  Notes:
    FTP Server Demo
    Sample of the usage of the TIdFtpServer component.
    Also shows how to use Indy in console apps    Username: myuser
    Password: mypass
  Version History:
    None  Tested:
   Indy 9:
     D5:     Untested
     D6:     Untested
     D7:     25th Oct 2004 by Andy Neillans
             Tested with Microsoft FTP Client
}program FTPServer_console;{$APPTYPE console}
uses
  Classes,
  windows,
  sysutils,
  IdFTPList,
  IdFTPServer,
  idtcpserver,
  IdSocketHandle,
  idglobal,
  IdHashCRC;type
  TFTPServer = class
  private
    { Private declarations }
    IdFTPServer: tIdFTPServer;
    IdFTPServerThread :TIdFTPServerThread;
    procedure IdFTPServer1UserLogin( ASender: TIdFTPServerThread; const AUsername, APassword: string; var AAuthenticated: Boolean ) ;
    procedure IdFTPServer1ListDirectory( ASender: TIdFTPServerThread; const APath: string; ADirectoryListing: TIdFTPListItems ) ;
    procedure IdFTPServer1RenameFile( ASender: TIdFTPServerThread; const ARenameFromFile, ARenameToFile: string ) ;
    procedure IdFTPServer1RetrieveFile( ASender: TIdFTPServerThread; const AFilename: string; var VStream: TStream ) ;
    procedure IdFTPServer1StoreFile( ASender: TIdFTPServerThread; const AFilename: string; AAppend: Boolean; var VStream: TStream ) ;
    procedure IdFTPServer1RemoveDirectory( ASender: TIdFTPServerThread; var VDirectory: string ) ;
    procedure IdFTPServer1MakeDirectory( ASender: TIdFTPServerThread; var VDirectory: string ) ;
    procedure IdFTPServer1GetFileSize( ASender: TIdFTPServerThread; const AFilename: string; var VFileSize: Int64 ) ;
    procedure IdFTPServer1DeleteFile( ASender: TIdFTPServerThread; const APathname: string ) ;
    procedure IdFTPServer1ChangeDirectory( ASender: TIdFTPServerThread; var VDirectory: string ) ;
    procedure IdFTPServer1CommandXCRC( ASender: TIdCommand ) ;
    procedure IdFTPServer1DisConnect( AThread: TIdPeerThread ) ;
  protected
    function TransLatePath( const APathname, homeDir: string ) : string;
  public
    constructor Create; reintroduce;
    destructor Destroy; override;
  end;constructor TFTPServer.Create;
begin
  IdFTPServer := tIdFTPServer.create( nil ) ;
  IdFTPServer.DefaultPort := 8002;
  IdFTPServer.AllowAnonymousLogin := False;
  IdFTPServer.EmulateSystem := ftpsUNIX; // TIdFTPServerThread(Self).HomeDir := 'e:\';
// IdFTPServer.EmulateSystem := ftpsDos;
  IdFTPServer.HelpReply.text := 'Help is not implemented';
  //IdFTPServer.
  IdFTPServer.OnChangeDirectory := IdFTPServer1ChangeDirectory;
  IdFTPServer.OnChangeDirectory := IdFTPServer1ChangeDirectory;
  IdFTPServer.OnGetFileSize := IdFTPServer1GetFileSize;
  IdFTPServer.OnListDirectory := IdFTPServer1ListDirectory;
  IdFTPServer.OnUserLogin := IdFTPServer1UserLogin;
  IdFTPServer.OnRenameFile := IdFTPServer1RenameFile;
  IdFTPServer.OnDeleteFile := IdFTPServer1DeleteFile;
  IdFTPServer.OnRetrieveFile := IdFTPServer1RetrieveFile;
  IdFTPServer.OnStoreFile := IdFTPServer1StoreFile;
  IdFTPServer.OnMakeDirectory := IdFTPServer1MakeDirectory;
  IdFTPServer.OnRemoveDirectory := IdFTPServer1RemoveDirectory;
  IdFTPServer.Greeting.NumericCode := 220;
  IdFTPServer.OnDisconnect := IdFTPServer1DisConnect;
  with IdFTPServer.CommandHandlers.add do
  begin
    Command := 'XCRC';
    OnCommand := IdFTPServer1CommandXCRC;
  end;
  IdFTPServer.Active := true;
end;function CalculateCRC( const path: string ) : string;
var
  f: tfilestream;
  value: dword;
  IdHashCRC32: TIdHashCRC32;
begin
  IdHashCRC32 := nil;
  f := nil;
  try
    IdHashCRC32 := TIdHashCRC32.create;
    f := TFileStream.create( path, fmOpenRead or fmShareDenyWrite ) ;
    value := IdHashCRC32.HashValue( f ) ;
    result := inttohex( value, 8 ) ;
  finally
    f.free;
    IdHashCRC32.free;
  end;
end;procedure TFTPServer.IdFTPServer1CommandXCRC( ASender: TIdCommand ) ;
// note, this is made up, and not defined in any rfc.
var
  s: string;
begin
  with TIdFTPServerThread( ASender.Thread ) do
  begin
    if Authenticated then
    begin
      try
        s := ProcessPath( CurrentDir, ASender.UnparsedParams ) ;
        s := TransLatePath( s, TIdFTPServerThread( ASender.Thread ) .HomeDir ) ;
       // s := 'E:\Working\数据同步';
        ASender.Reply.SetReply( 213, CalculateCRC( s ) ) ;
      except
        ASender.Reply.SetReply( 500, 'file error' ) ;
      end;
    end;
  end;
end;destructor TFTPServer.Destroy;
begin
  IdFTPServer.free;
  inherited destroy;
end;function StartsWith( const str, substr: string ) : boolean;
begin
  result := copy( str, 1, length( substr ) ) = substr;
end;function BackSlashToSlash( const str: string ) : string;
var
  a: dword;
begin
  result := str;
  for a := 1 to length( result ) do
    if result[a] = '\' then
      result[a] := '/';
end;function SlashToBackSlash( const str: string ) : string;
var
  a: dword;
begin
  result := str;
  for a := 1 to length( result ) do
    if result[a] = '/' then
      result[a] := '\';
end;function TFTPServer.TransLatePath( const APathname, homeDir: string ) : string;
var
  tmppath: string;
begin
  result := SlashToBackSlash( homeDir ) ;
  tmppath := SlashToBackSlash( APathname ) ;
  if homedir = '/' then
  begin
    result := tmppath;
    exit;
  end;  if length( APathname ) = 0 then
    exit;
  if result[length( result ) ] = '\' then
    result := copy( result, 1, length( result ) - 1 ) ;
  if tmppath[1] <> '\' then
    result := result + '\';
  result := result + tmppath;
end;function GetSizeOfFile( const APathname: string ) : int64;
begin
  result := FileSizeByName( APathname ) ;
end;function GetNewDirectory( old, action: string ) : string;
var
  a: integer;
begin
  if action = '../' then
  begin
    if old = '/' then
    begin
      result := old;
      exit;
    end;
    a := length( old ) - 1;
    while ( old[a] <> '\' ) and ( old[a] <> '/' ) do
      dec( a ) ;
    result := copy( old, 1, a ) ;
    exit;
  end;
  if ( action[1] = '/' ) or ( action[1] = '\' ) then
    result := action
  else
    result := old + action;
end;procedure TFTPServer.IdFTPServer1UserLogin( ASender: TIdFTPServerThread;
  const AUsername, APassword: string; var AAuthenticated: Boolean ) ;
begin
  AAuthenticated := ( AUsername = 'myuser' ) and ( APassword = 'mypwd' ) ;
  if not AAuthenticated then
    exit;
  ASender.HomeDir := 'e:\';   //FTP客户端访问的根目录
  asender.currentdir := '/';
end;

procedure TFTPServer.IdFTPServer1ListDirectory( ASender: TIdFTPServerThread; const APath: string; ADirectoryListing: TIdFTPListItems ) ;  procedure AddlistItem( aDirectoryListing: TIdFTPListItems; Filename: string; ItemType: TIdDirItemType; size: int64; date: tdatetime ) ;
  var
    listitem: TIdFTPListItem;
  begin
    listitem := aDirectoryListing.Add;
    listitem.ItemType := ItemType;
    listitem.FileName := Filename;
    listitem.OwnerName := 'anonymous';
    listitem.GroupName := 'all';
    listitem.OwnerPermissions := '---';
    listitem.GroupPermissions := '---';
    listitem.UserPermissions := '---';
    listitem.Size := size;
    listitem.ModifiedDate := date;
  end;var
  f: tsearchrec;
  a: integer;
begin
  ADirectoryListing.DirectoryName := apath;  a := FindFirst( TransLatePath( apath, ASender.HomeDir ) + '*.*', faAnyFile, f ) ;
  while ( a = 0 ) do
  begin
    if (f.Name <> '.') and (f.Name <> '..') then
    begin
      if ( f.Attr and faDirectory > 0 )  then        AddlistItem( ADirectoryListing, f.Name, ditDirectory, f.size, FileDateToDateTime( f.Time ) )
      else
        AddlistItem( ADirectoryListing, f.Name, ditFile, f.size, FileDateToDateTime( f.Time ) ) ;
    end;
    a := FindNext( f ) ;
  end;  FindClose( f ) ;
end;procedure TFTPServer.IdFTPServer1RenameFile( ASender: TIdFTPServerThread;
  const ARenameFromFile, ARenameToFile: string ) ;
begin
  if not MoveFile( pchar( TransLatePath( ARenameFromFile, ASender.HomeDir ) ) , pchar( TransLatePath( ARenameToFile, ASender.HomeDir ) ) ) then
    RaiseLastWin32Error;
end;procedure TFTPServer.IdFTPServer1RetrieveFile( ASender: TIdFTPServerThread;
  const AFilename: string; var VStream: TStream ) ;
begin
  VStream := TFileStream.create( translatepath( AFilename, ASender.HomeDir ) , fmopenread or fmShareDenyWrite ) ;
end;procedure TFTPServer.IdFTPServer1StoreFile( ASender: TIdFTPServerThread;
  const AFilename: string; AAppend: Boolean; var VStream: TStream ) ;
begin
  if FileExists( translatepath( AFilename, ASender.HomeDir ) ) and AAppend then
  begin
    VStream := TFileStream.create( translatepath( AFilename, ASender.HomeDir ) , fmOpenWrite or fmShareExclusive ) ;
    VStream.Seek( 0, soFromEnd ) ;
  end
  else
    VStream := TFileStream.create( translatepath( AFilename, ASender.HomeDir ) , fmCreate or fmShareExclusive ) ;
end;procedure TFTPServer.IdFTPServer1RemoveDirectory( ASender: TIdFTPServerThread;
  var VDirectory: string ) ;
begin
  RmDir( TransLatePath( VDirectory, ASender.HomeDir ) ) ;
end;procedure TFTPServer.IdFTPServer1MakeDirectory( ASender: TIdFTPServerThread;
  var VDirectory: string ) ;
begin
  MkDir( TransLatePath( VDirectory, ASender.HomeDir ) ) ;
end;procedure TFTPServer.IdFTPServer1GetFileSize( ASender: TIdFTPServerThread;
  const AFilename: string; var VFileSize: Int64 ) ;
begin
  VFileSize := GetSizeOfFile( TransLatePath( AFilename, ASender.HomeDir ) ) ;
end;procedure TFTPServer.IdFTPServer1DeleteFile( ASender: TIdFTPServerThread;
  const APathname: string ) ;
begin
  DeleteFile( pchar( TransLatePath( ASender.CurrentDir + '/' + APathname, ASender.HomeDir ) ) ) ;
end;procedure TFTPServer.IdFTPServer1ChangeDirectory( ASender: TIdFTPServerThread;
  var VDirectory: string ) ;
begin
  VDirectory := GetNewDirectory( ASender.CurrentDir, VDirectory ) ;
  //VDirectory := GetNewDirectory('E:\Working\数据同步', VDirectory) ;
end;procedure TFTPServer.IdFTPServer1DisConnect( AThread: TIdPeerThread ) ;
begin
  //  nothing much here
end;begin
  with TFTPServer.Create do
  try
    writeln( 'Running, press [enter] to terminate' ) ;
    readln
  finally
    free;
  end;
end.

有缺省的FTP啊，呵呵，你先telnet一下端口，看开没，确认一下用户名和密码有没有错，客户端加个try看看有报什么错没

挺复杂的，没太看明白，本来以为用idFtp控件很简单就连接到服务器上，然后能看见文件列表，把需要下载的文件下载到本机，现在的问题是连接都失败～我先保存您的回复，再研究一下，现在我要实现的目标好象不是那么复杂吧？我对网络编程是一窍不通的，请别见笑。刚才看了一下idFTP控件，其能够提供，查看目录功能，拷贝功能，改变目录等等功能，现在关键是连接都连不上先帮我解决这个问题，好吗？这么连接老失败：
idFTPC.Username:='admin';
  idFTPC.Password:='Admin';
  idFTPC.Host:='333.224.212.222';
//  idFTPC.Port:=21;
  idFTPC.Login;
  if not idFTPC.Connected then showmessage('no connect.');

在DOS下，telnet，ftp到服务器都没问题，按照
idFTPC.Username:='admin';
  idFTPC.Password:='Admin';
  idFTPC.Host:='333.224.212.222';
//  idFTPC.Port:=21;
  idFTPC.Login;
  if not idFTPC.Connected then showmessage('no connect.');始终连接不到服务器上，有啥问题吗？

老大着急用，加我QQ：33016667，指点我一下，行吗？
idFTP咋用啊？其帮助没找到如何连接服务器的例子

靠，你没有idftpc.connect() ，就判断connected ，服了你
当然连不上了

呵呵，我以为login就行呢～（重操旧业，真手生啊）
已经connect上了～问题又来了：
idFTPC.List(AFiles,'*');
显示的列表少了第一个字符！
在dos下显示是：
drw-rw-rw-   1 user     group           0 Jun  9  2005 阅读类
drw-rw-rw-   1 user     group           0 Jun  9  2005 杂货
drw-rw-rw-   1 user     group           0 Sep 14  2005 赠送软件
drw-rw-rw-   1 user     group           0 Jun  9  2005 知识类
drw-rw-rw-   1 user     group           0 Jun  9  2005 制作类用软件读出的是：
rw-rw-rw-   1 user     group           0 Jun  9  2005 阅读类
rw-rw-rw-   1 user     group           0 Jun  9  2005 杂货
rw-rw-rw-   1 user     group           0 Sep 14  2005 赠送软件
rw-rw-rw-   1 user     group           0 Jun  9  2005 知识类
rw-rw-rw-   1 user     group           0 Jun  9  2005 制作类对于文件是不是得一个一个地判断，然后copy到本机里？
比例：
rw-rw-rw-   1 user     group     7233986 Jun  3  2005 PQ8.0.rar
就得判断出PQ8.0.rar是文件，然后down下？真的很菜，让您见笑了～～～～

if IdFTP1.DirectoryListing.Items[DirectoryListBox.ItemIndex].ItemType = ditDirectory then //如果是目录则
begin
end
else
begin
//文件
end;

谢谢～
我刚研究出用
  Memo_disp.Clear;
  for i:=0 to idFTPC.DirectoryListing.Count-1  do
  Memo_disp.Lines.Add(idFTPC.DirectoryListing.Items[i].Text);是正确的，不过你的这个类型判断更高明！！！！
激动中。
继续进行。。

这个问题就比较棘手了：客户端登录到服务器上，用list命令显示时，有的可正确显示出，但有的显示不出，听同事讲好象是操作系统的cmd里没有集成ftp，而集成到IE里（用ie上ftp就正常），程序也是这个现象，只要在cmd 下ftp list正常，软件也正常；如果显示不出（虽然ie下可以显示），软件也显示不出。

procedure changedirs(dirname : String)LS := TStringList.Create;
IdFTP1.ChangeDir(DirName);
IdFTP1.TransferType := ftASCII;
DirectoryListBox.Items.Clear;
IdFTP1.List(LS);
DirectoryListBox.Items.Assign(LS);
没见过你说的问题啊

dabaicai:您好
我就是按照你说的，结果相同，提示：can't build data connetion,connetion time out
在执行IdFTP1.List(LS);时候，程序停了好长时间才出现这个错误的。个人感觉idFTP控件执行list时候，调用了操作系统的list或dir功能。谢谢

要先connect()
怎么一个问题发了这么多帖子啊

哦，说错了，呵呵
这是我用户登录函数:
function Tfrm_Main.UserLog: boolean;
begin
  Result := False;     try
    FTPClient.Host := sHost;
    FTPClient.Port := iProt;
    FTPClient.Username := UserName;
    FTPClient.Password := sPwd;
    FTPClient.Connect(true,10000);
    if FTPClient.Connected then
    Result := True;
  except
    Result := False;
  end;

end;显示目录
procedure Tfrm_Main.ShowDir(iKind : integer);
var
  filelist : TStringList;
  i : integer;
  sType : String;
  ss,sall : String[50];
begin
  filelist := TStringList.Create;
  try
    FTPClient.ChangeDir('/');
    FTPClient.ChangeDir(ftpDir);
    {lbxFile.Clear;
    FTPClient.List(filelist);
    if filelist.Count = 0 then
    begin
      btnDown.Enabled := False;
      Exit;
    end
    else
      btnDown.Enabled := True;
    for i := 0 to filelist.Count - 1 do
    begin
      if FTPClient.DirectoryListing.Items[i].ItemType = ditDirectory then
      begin
        isDir := True;
        lbxFile.Lines.Add('[文件夹]'+FTPClient.DirectoryListing.Items[i].FileName);
      end
      else
        lbxFile.Lines.Add(FTPClient.DirectoryListing.Items[i].FileName);
      //
    end;  }
  finally
    filelist.Free;
  end;
end;

dabaicai:您好
用FTPClient控件有can't build data connetion,connetion time out这个错误吗？
在执行IdFTP1.List(LS);时候，程序停了好长时间才出现这个错误的。个人感觉idFTP控件执行list时候，调用了操作系统的list或dir功能。现在就剩list服务器目录的问题了～
其他下载等问题已经基本解决了。谢谢关注

什么叫现在就剩list服务器目录的问题了?

现在list提示：
can't build data connetion,connetion time out这个错误吗？
在执行IdFTP1.List(LS);时候，程序停了好长时间才出现这个错误的。

这个没有和服务器连接上,应该事服务器的问题了,你看看用IE能否登录该FTP就知道是不是服务器问题

用IE能登录该FTP服务器的，CMD状态下登录成功，但用ls命令或dir时就长时间没有反应，如果用此程序就出现上述的错误。

可能是因为你的服务器是unix的原因,你改改客户端控件的属性试试

使用的是：IdFTPC控件，但不知道修改哪个属性；好象不是服务器unix的原因，证据如下：软件执行list提示：
can't build data connetion,connetion time out这个错误吗？
在执行IdFTP1.List(LS);时候，程序停了好长时间才出现这个错误的。用ie登录ftp完全正确，随便下载一个ftp客户端软件下载也没问题；
用自己写的软件就出现上述错误。。回楼上：列表逐个下载已经没问题啦～～～～
用的是递归，挺不错。

function Tfrm_Main.UserLog: boolean;
begin
  Result := False;     try
    FTPClient.Host := sHost;
    FTPClient.Port := iProt;
    FTPClient.Username := UserName;
    FTPClient.Password := sPwd;
    FTPClient.Connect(true,10000);
    if FTPClient.Connected then
    Result := True;
  except
    Result := False;
  end;

end;

对，解决了～
同时要把ftp控件的passive设置为true即可啦～～～～终于要结贴了。。在此非常感谢 dabaicai(菜鸟) 大侠的大力支持，后期问题基本都解决了。

参与者给予2分，其他98分给予了dabaicai(菜鸟) ，呵呵～～～

调试易

帮帮忙：如何把FTP服务器（HP Unix缺省的ftp服务）某一目录的全部文件拷贝到自己计算机里？

解决方案 »