求 delphi FTP传输的一个例子

Question

我看了indy自带的例子,有点太大了 
谁有个小点的例子给我发过来啊!
只要能够实现FTP传输就够了.最好还是用indy组件里的控件

Answer 1

直接用indy 里面的indyFTP 控件就可以了！还可以实现断点传输。

Answer 2

给你一个利用IE的winet的例子，我自己正在用，证明没有问题。
如果对您有帮助，请您结贴unit Ftp;
  
{ FTP example using WININET.PAS rather than   
  an ACTIVEX control. Requires WININET.PAS and  
  WININET.DLL. WININET.DLL you can get from   
  Microsoft, WININET.PAS is available from  
  www.borland.com, or with some versions of
  Delphi 2.0.  You might Respond to OnNewDir events as follows:
  procedure TForm1.FTP1NewDir(Sender: TObject);
  begin  
    ListBox1.Items := MyFtp1.FindFiles; // Get the directory list  
  end;     
}  
  
interface  
  
uses  
Windows, Classes, WinINet,SysUtils;  
    
type  
tmyftp =class(TObject)
//  TMyFtp = class(TObject)
  private  
    FContext: Integer;  
    FINet: HInternet;  
    FFtpHandle: HInternet;  
    FCurFiles: TStringList;  
    FServer: string;  
    FOnNewDir: TNotifyEvent;  
    FCurDir: string;  
    FUserID: string;  
    FPassword: string;       
    function GetCurrentDirectory: string;  
    procedure SetUpNewDir;  
  protected  
    destructor Destroy; override;
  public  
    //constructor Create(AOwner: TComponent); override;
    constructor Create();
    function Connect: Boolean;  
    function FindFiles: TStringList;  
    function ChangeDirExact(S: string): Boolean;  
    function ChangeDirCustom(S: string): Boolean;  
    function BackOneDir: Boolean;  
    function GetFile(FTPFile, NewFile: string): Boolean;  
    function SendFile(FTPFile, NewFile: string): Boolean;  
    function SendFile2(FTPFile, NewFile: string): Boolean;  
    function CustomToFileName(S: string): string;
    function CreateDirectory(S: string):Boolean;
  published  
    property CurFiles: TStringList read FCurFiles;  
    property CurDir: string read FCurDir;  
    property UserID: string read FUserID write FUserID;
    property Password: string read FPassword write FPassword;  
    property Server: string read FServer write FServer;  
    property OnNewDir: TNotifyEvent read FOnNewDir   
                write FOnNewDir;  
  end;  
  
procedure Register;  implementation  
  
  
  
// A few utility functions  
  
function GetFirstToken(S: string; Token: Char): string;  
var  
  Temp: string;  
  Index: INteger;
begin  Index := Pos(Token, S);
  if Index < 1 then begin  
    GetFirstToken := '';  
    Exit;  
  end;  
  Dec(Index);  
  SetLength(Temp, Index);  
  Move(S[1], Temp[1], Index);  
  GetFirstToken := Temp;  
end;  
  
function StripFirstToken(S: string; Ch: Char): string;  
var  
  i, Size: Integer;  
begin  
  i := Pos(Ch, S);  
  if i = 0 then begin  
    StripFirstToken := S;  
    Exit;  
  end;  
  Size := (Length(S) - i);  
  Move(S[i + 1], S[1], Size);  
  SetLength(S, Size);  
  StripFirstToken := S;  
end;  
  
function ReverseStr(S: string): string;  
var  
  Len: Integer;  
  Temp: String;  
  i,j: Integer;  
begin  
  Len := Length(S);  
  SetLength(Temp, Len);  
  j := Len;  
  for i := 1 to Len do begin  
    Temp[i] := S[j];  
    dec(j);  
  end;  
  ReverseStr := Temp;  
end;  
  
function StripLastToken(S: string; Token: Char): string;  
var  
  Temp: string;  
  Index: INteger;  
begin  
  SetLength(Temp, Length(S));  
  S := ReverseStr(S);  
  Index := Pos(Token, S);  
  Inc(Index);  
  Move(S[Index], Temp[1], Length(S) - (Index - 1));  
  SetLength(Temp, Length(S) - (Index - 1));  
  StripLastToken := ReverseStr(Temp);  
end;  
  
  
procedure Register;  
begin  
//  RegisterComponents('Unleash', [TMyFtp]);  
end;  
  
//constructor TMyFtp.Create(AOwner: TComponent);
constructor TMyFtp.Create();
begin
//  inherited Create(AOwner);  
  FCurFiles := TStringList.Create;  
  FINet := InternetOpen('WinINet1', 0, nil, 0, 0);  
end;  
  
destructor TMyFtp.Destroy;  
begin  
  if FINet <> nil then  
    InternetCloseHandle(FINet);  
  if FFtpHandle <> nil then  
    InternetCloseHandle(FFtpHandle);  
  inherited Destroy;  
end;  
  

Answer 3

function TMyFtp.Connect: Boolean;  
begin  
  FContext := 255;  
  FftpHandle := InternetConnect(FINet, PChar(FServer), 0,  
   PChar(FUserID), PChar(FPassWord),  
   Internet_Service_Ftp, 0, FContext);  
  if FFtpHandle = nil then  
    Result := False  
  else begin  
    SetUpNewDir;           
    Result := True;  
  end;  
end;  
  
function TMyFtp.GetCurrentDirectory: string;  
var  
  Len: DWORD;  
  S: string;  
begin  
  Len := 0;
  ftpGetCurrentDirectory(FFTPHandle, PChar(S), Len);
  SetLength(S, Len);  
  ftpGetCurrentDirectory(FFTPHandle, PChar(S), Len);
  Result := S;
end;
  
procedure TMyFtp.SetUpNewDir;  
begin  
  FCurDir := GetCurrentDirectory;  
  if Assigned(FOnNewDir) then  
    FOnNewDir(Self);               
end;  
  
function GetDots(NumDots: Integer): string;  
var  
  S: string;  
  i: Integer;  
begin  
  S := '';  
  for i := 1 to NumDots do  
    S := S + ' ';  
  Result := S;  
end;  
  
function GetFindDataStr(FindData: TWin32FindData): string;  
var  
  S: string;  
  Temp: string;  
begin  
  case FindData.dwFileAttributes of  
    FILE_ATTRIBUTE_ARCHIVE: S := 'A';  
//    FILE_ATTRIBUTE_COMPRESSED: S := 'C';  
    FILE_ATTRIBUTE_DIRECTORY: S := 'D';  
    FILE_ATTRIBUTE_HIDDEN: S := 'H';  
    FILE_ATTRIBUTE_NORMAL: S := 'N';  
    FILE_ATTRIBUTE_READONLY: S := 'R';  
    FILE_ATTRIBUTE_SYSTEM: S := 'S';  
    FILE_ATTRIBUTE_TEMPORARY: S := 'T';  
  else  
    S := IntToStr(FindData.dwFileAttributes);  
  end;  
  S := S + GetDots(75);  
  Move(FindData.CFilename[0], S[6], StrLen(FindData.CFileName));  
  Temp := IntToStr(FindData.nFileSizeLow);  
  Move(Temp[1], S[25], Length(Temp));  
  Result := S;  
end;  
  
function TMyFtp.FindFiles: TStringList;  
var  
  FindData: TWin32FindData;  
  FindHandle: HInternet;  
begin  
   FindHandle := FtpFindFirstFile(FFtphandle, '*.*',FindData, 0, 0);  
   if FindHandle = nil then begin  
     Result := nil;  
     Exit;  
   end;  
   FCurFiles.Clear;  
   FCurFiles.Add(GetFindDataStr(FindData));  
   while InternetFindnextFile(FindHandle, @FindData) do  
     FCurFiles.Add(GetFindDataStr(FindData));  
   InternetCloseHandle(Findhandle);  
   GetCurrentDirectory;  
   Result := FCurFiles;  
end;  
  
function TMyFtp.CustomToFileName(S: string): string;  
const  
  PreSize = 6;  
var  
  Temp: string;  
  TempSize: Integer;  
begin  
  Temp := '';  
  TempSize := Length(S) - PreSize;   
  SetLength(Temp, TempSize);  
  Move(S[PreSize], Temp[1], TempSize);  
  Temp := GetFirstToken(Temp, ' ');  
  Result := Temp;  
end;  
  
function TMyFtp.BackOneDir: Boolean;  
var  
  S: string;  
begin  
  S := FCurDir;  
  S := StripLastToken(S, '/');  
  if S = '/' then begin  
    Result := False;  
    Exit;  
  end;  
  
  if S <> '' then begin  
    ChangeDirExact(S);  
    Result := True;  
  end else begin  
    ChangeDirExact('/');  
    Result := True;  
  end;  
  
end;  
  

Answer 4

// Changes to specific directory in S  
function TMyFtp.ChangeDirExact(S: string): Boolean;  
begin
  if S <> '' then
    FtpSetCurrentDirectory(FFTPHandle, PChar(S));
  Result := True;
  FindFiles;
  SetUpNewDir;  
end;  
  
// Assumes S has been returned by GetFindDataString;  
function TMyFtp.ChangeDirCustom(S: string): Boolean;  
begin  
  S := CustomToFileName(S);  
  if S <> '' then  
    FtpSetCurrentDirectory(FFTPHandle, PChar(S));  
  Result := True;  
  FindFiles;  
  SetUpNewDir;  
end;  
  
function TMyFtp.GetFile(FTPFile, NewFile: string): Boolean;  
begin  
  Result := FtpGetFile(FFTPHandle, PChar(FTPFile), PChar(NewFile),  
               False, File_Attribute_Normal,  
               Ftp_Transfer_Type_Binary, 0);  
end;  
  
{-------------------------------------------------------------------------------
  过程名: TMyFtp.SendFile
  作  者: 梦晰
  日  期: 2007-3-5 15:30:56
  参  数: FTPFile, NewFile: string
  返回值: Boolean
  描  述:
  备  注:  修改记录
  日期       版本       修改人      修改内容
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}
function TMyFtp.SendFile(FTPFile, NewFile: string): Boolean;
//const  
//  Size:DWord = 3000;
var
  Transfer: Bool;
  Error:DWORD;
  Size:DWord;
  S: string;
  ErrorInfo:string;
begin
  Size:=3000;
  Transfer := FtpPutFile(FFTPHandle, PChar(FTPFile),
                         PChar(NewFile),
                         Ftp_Transfer_Type_Binary, 0);   if not Transfer then begin
     begin     Error := GetLastError;
     FormatMessage ( FORMAT_MESSAGE_ALLOCATE_BUFFER  and
                     FORMAT_MESSAGE_IGNORE_INSERTS  and
                     FORMAT_MESSAGE_FROM_SYSTEM,
                     nil,
                     Error, // 此乃错误代码，通常在程序中可由 GetLastError()得之
                     LANG_NEUTRAL,
                     PAnsiChar(ErrorInfo),
                     //(LPTSTR) & lpBuffer,
                      0 ,
                     nil );//     MessageBox( HWND( nil),PAnsiChar(ErrorInfo), 'FTP服务器', MB_OK + MB_ICONSTOP);//     ShowMessage(Format('Error Number: %d. Hex: %x',
//                       [Error, Error]));
    SetLength(S, Size);
    if not InternetGetLastResponseInfo(Error, PChar(S), Size) then
    begin
      Error := GetLastError;
//      ShowMessage(Format('Error Number: %d. Hex: %x',
//        [Error, Error]));
    end;
//    ShowMessage(Format('Error Number: %d. Hex: %x Info: %s',
//                       [Error, Error, S]));
   end
  end else
//    ShowMessage('Success');
  Result := Transfer;
end;function TMyFtp.SendFile2(FTPFile, NewFile: string): Boolean;
var  
  FHandle: HInternet;  
begin  
  FHandle :=  FtpOpenFile(FFTPHandle, 'sam.txt', GENERIC_READ,  
                           FTP_TRANSFER_TYPE_BINARY, 0);  
  if FHandle <> nil then  
  InternetCloseHandle(FHandle)  
  else  
//    ShowMessage('Failed');  
  Result := True;  
end;  
  
function TMyFtp.CreateDirectory(S: string): Boolean;
var
  Transfer:Boolean;
  Error:DWORD;
  size:DWord;
begin
   size:=3000;
   Transfer := FtpCreateDirectory(FftpHandle,PAnsiChar(S));   if not Transfer then
     begin
     Error := GetLastError;    SetLength(S, Size);
       if not InternetGetLastResponseInfo(Error, PChar(S), Size) then
     begin
       Error := GetLastError;
       S:=Trim(S);
//       ShowMessage(Format('Error Number: %d. Hex: %x',
//         [Error, Error]));
      end;
     S:=Trim(S);
//   ShowMessage(Format('Error Number: %d. Hex: %x Info: %s',
//                        [Error, Error, S]));
      end;    end;end.

Answer 5

到这里去下载吧
http://www.indyproject.org/Sockets/Demos/index.aspx