学步园

//------------------------------------------------------------------------- 
//  文件名：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. 
 
---------------------------------------------------------------