//-------------------------------------------------------------------------

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