//------------------------------------------------------------------------- // 文件名:WLFtp.pas // 描述:封装Ftp API函数,实现上传,下载文件,创建目录 // // 类名:TWLFtp // 作者:Win Lai // 创建日期:2004-1-9 // 修改日期:2004-1-11 //------------------------------------------------------------------------- unit WLFtp;interfaceuses 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.
// 文件名:WLFtp.pas
// 描述:封装Ftp API函数,实现上传,下载文件,创建目录
//
// 类名:TWLFtp
// 作者:Win Lai
// 创建日期:2004-1-9
// 修改日期:2004-1-11
//-------------------------------------------------------------------------
unit WLFtp;interfaceuses
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.