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