封装Ftp API函数，实现上传，下载文件，创建目录

//-------------------------------------------------------------------------  
//  文件名：WLFtp.pas  
//  描述：封装Ftp  API函数，实现上传，下载文件，创建目录  
//  
//  类名：TWLFtp  
//  作者：Win  Lai  
//  创建日期：2004-1-9  
//  修改日期：2004-1-11  
//-------------------------------------------------------------------------  
unit  WLFtp;  
 
interface  
 
uses  
           Windows,  Messages,  Variants,SysUtils,  Classes,  Wininet,  Dialogs;  
 
type  
           TWLFtp  =  class(TObject)  
 
           private  
                       FInetHandle:  HInternet;  //  句柄  
                       FFtpHandle:  HInternet;  //  句柄  
 
                       FHost:  string;  //  主机IP地址  
                       FUserName:  string;  //  用户名  
                       FPassword:  string;  //  密码  
                       FPort:  integer;  //  端口  
 
                       FCurrentDir:  string;  //  当前目录  
 
           public  
                       constructor  Create;virtual;  
                       destructor  Destroy;override;  
 
                       function  Connect:  boolean;  
                       function  Disconnect:  boolean;  
 
                       function  UploadFile(RemoteFile:  PChar;  NewFile:  PChar):  boolean;  
                       function  DownloadFile(RemoteFile:  PChar;  NewFile:  PChar):  boolean;  
 
                       function  CreateDirectory(Directory:  PChar):  boolean;  
 
                       function  LayerNumber(dir:  string):  integer;  
                       function  MakeDirectory(dir:  string):  boolean;  
                       function  FTPMakeDirectory(dir:  string):  boolean;  
                       function  IndexOfLayer(index:  integer;  dir:  string):  string;  
                       function  GetFileName(FileName:  string):  string;  
                       function  GetDirectory(dir:  string):  string;  
 
                       property  InetHandle:  HInternet  read  FInetHandle  write  FInetHandle;  
                       property  FtpHandle:  HInternet  read  FFtpHandle  write  FFtpHandle;  
                       property  Host:  string  read  FHost  write  FHost;  
                       property  UserName:  string  read  FUserName  write  FUserName;  
                       property  Password:  string  read  FPassword  write  FPassword;  
                       property  Port:  integer  read  FPort  write  FPort;  
 
                       property  CurrentDir:  string  read  FCurrentDir  write  FCurrentDir;  
 
end;  
 
 
implementation  
 
//-------------------------------------------------------------------------  
//  构造函数  
constructor  TWLFtp.Create;  
begin  
           inherited  Create;  
 
end;  
 
//-------------------------------------------------------------------------  
//  析构函数  
destructor  TWLFtp.Destroy;  
begin  
 
           inherited  Destroy;  
end;  
 
//-------------------------------------------------------------------------  
//  链接服务器  
function  TWLFtp.Connect:  boolean;  
begin  
           try  
                       Result  :=  false;  
                       //  创建句柄  
                       FInetHandle  :=  InternetOpen(PChar('KOLFTP'),  0,  nil,  nil,  0);  
                       FtpHandle  :=  InternetConnect(FInetHandle,  PChar(Host),  FPort,  PChar(FUserName),  
                                                                       PChar(FPassword),  INTERNET_SERVICE_FTP,  0,  255);  
                       if  Assigned(FtpHandle)  then  
                       begin  
                                   Result  :=  true;  
                       end;  
 
           except  
                       Result  :=  false;  
           end;  
end;  
 
//-------------------------------------------------------------------------  
//  断开链接  
function  TWLFtp.Disconnect:  boolean;  
begin  
           try  
                       InternetCloseHandle(FFtpHandle);  
                       InternetCloseHandle(FInetHandle);  
                       FtpHandle:=nil;  
                       inetHandle:=nil;  
 
                       Result  :=  true;  
           except  
                       Result  :=  false;  
           end;  
end;  
 
//-------------------------------------------------------------------------  
//  上传文件  
function  TWLFtp.UploadFile(RemoteFile:  PChar;  NewFile:  PChar):  boolean;  
begin  
           try  
                       Result  :=  true;  
                       FTPMakeDirectory(NewFile);  
                       if  not  FtpPutFile(FFtpHandle,  RemoteFile,  NewFile,  
                                                           FTP_TRANSFER_TYPE_BINARY,  255)  then  
                       begin  
                                   Result  :=  false;  
                       end;  
           except  
                       Result  :=  false;  
           end;  
end;  
 
//-------------------------------------------------------------------------  
//  下载文件  
function  TWLFtp.DownloadFile(RemoteFile:  PChar;  NewFile:  PChar):  boolean;  
begin  
           try  
                       Result  :=  true;  
                       MakeDirectory(NewFile);  
                       if  not  FtpGetFile(FFtpHandle,  RemoteFile,  NewFile,  
                                                                                   True,  FILE_ATTRIBUTE_NORMAL,  FTP_TRANSFER_TYPE_BINARY  OR  INTERNET_FLAG_RELOAD,  255)  then  
                       begin  
                                   Result  :=  false;  
                       end;  
           except  
                       Result  :=  false;  
           end;  
end;  
 
//-------------------------------------------------------------------------  
//  创建目录  
function  TWLFtp.CreateDirectory(Directory:  PChar):  boolean;  
begin  
           try  
                       Result  :=  true;  
                       if  FtpCreateDirectory(FFtpHandle,  Directory)=false  then  
                       begin  
                                   Result  :=  false;  
                       end;  
           except  
                       Result  :=  false;  
           end;  
end;  
 
//-------------------------------------------------------------------------  
//  目录数  
function  TWLFtp.LayerNumber(dir:  string):  integer;  
var  
           i:  integer;  
           flag:  string;  
begin  
           Result  :=  0;  
 
           for  i:=1  to  Length(dir)  do  
           begin  
                       flag  :=  Copy(dir,i,1);  
                       if  (flag='/')  or  (flag='/')  then  
                       begin  
                                   Result  :=  Result  +  1;  
                       end;  
           end;  
end;  
 
//-------------------------------------------------------------------------  
//  创建目录  
function  TWLFtp.FTPMakeDirectory(dir:  string):  boolean;  
var  
           count,  i:  integer;  
           SubPath:  string;  
begin  
           Result  :=  true;  
           count  :=  LayerNumber(dir);  
 
           for  i:=1  to  count  do  
           begin  
                       SubPath  :=  IndexOfLayer(i,  dir);  
                       if  CreateDirectory(PChar(CurrentDir+SubPath))=false  then  
                       begin  
                                   Result  :=  false;  
                       end;  
           end;  
end;  
 
//-------------------------------------------------------------------------  
//  创建目录  
function  TWLFtp.MakeDirectory(dir:  string):  boolean;  
var  
           count,  i:  integer;  
           SubPath:  string;  
           str:  string;  
begin  
           Result  :=  true;  
           count  :=  LayerNumber(dir);  
           str  :=  GetDirectory(dir);  
 
           for  i:=2  to  count  do  
           begin  
                       SubPath  :=  IndexOfLayer(i,  str);  
                       if  not  DirectoryExists(SubPath)  then  
                       begin  
                                   if  not  CreateDir(SubPath)  then  
                                   begin  
                                               Result  :=  false;  
                                   end;  
                       end;  
           end;  
end;  
 
//-------------------------------------------------------------------------  
//  获取index层的目录  
function  TWLFtp.IndexOfLayer(index:  integer;  dir:  string):  string;  
var  
           count,  i:  integer;  
           ch:  string;  
begin  
           Result  :=  '';  
           count  :=  0;  
           for  i:=1  to  Length(dir)  do  
           begin  
                       ch  :=  Copy(dir,  i,  1);  
                       if  (ch='/')  or  (ch='/')  then  
                       begin  
                                   count  :=  count+1;  
                       end;  
                       if  count=index  then  
                       begin  
                                   break;  
                       end;  
                       Result  :=  Result  +  ch;  
           end;  
end;  
 
//-------------------------------------------------------------------------  
//  获取文件名  
function  TWLFtp.GetFileName(FileName:  string):  string;  
begin  
           Result  :=  '';  
           while  (Copy(FileName,  Length(FileName),  1)<>'/')  and  (Length(FileName)>0)  do  
           begin  
                       Result  :=  Copy(FileName,  Length(FileName),  1)+Result;  
                       Delete(FileName,  Length(FileName),  1);  
           end;  
end;  
 
//-------------------------------------------------------------------------  
//  获取目录  
function  TWLFtp.GetDirectory(dir:  string):  string;  
begin  
           Result  :=  dir;  
           while  (Copy(Result,  Length(Result),  1)<>'/')  and  (Length(Result)>0)  do  
           begin  
                       Delete(Result,  Length(Result),  1);  
           end;  
 
{            if  Copy(Result,  Length),  1)='/'  then  
           begin  
                       Delete(Result,  1,  1);  
           end;}  
end;  
 
//-------------------------------------------------------------------------  
end.