封装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.