ICS TFTPClient 的相关操作。

unit UindexFTP;
interface
uses
SysUtils, Classes ,StrUtils ,OverbyteIcsWndControl, OverbyteIcsFtpCli;
type
TFindFile = procedure(FileName,EditTime,Attribute,Owner,Group,Size:string) of object;
TFindDir = procedure(DirName,EditTime,Attribute,Owner,Group:string) of object;
TOnMessage = procedure(msg:string) of object;
TOnTimeOut = procedure(status:integer) of object;
CUindexFTP = class(TComponent)
private
//来自ICS的TFTPclient控件,基本上成了Winsock的实现
//结果我不得不写一个更加友好的FTP组件UindexFTP
MySpider : TFtpClient;
Fusername : string;
Fpassword : string;
Fserverport : integer;
Fserver : string;
Fversion : string;
FWorkDir : string;
FFindFile : TFindFile;
FFindDir : TFindDir;
FOnMessage : TOnMessage;
FOnTimeOut : TOnTimeOut;
procedure Display(Sender: TObject; var Msg: String);
procedure Error(Sender: TObject; var Msg: String);
procedure StateChange(Sender: TObject);
procedure ParseList(List:string);
protected
Ftimeout : integer;
FConnTimeOut : integer;
Fstatus : integer;
public
constructor Create(Owner: TComponent); override;
destructor Destroy; override;
function connect():boolean;
function ChangeDir(dir:string):boolean;
function ListDir():integer;
published
property TimeOut : integer Read Ftimeout Write Ftimeout;
property Host : string Read Fserver Write Fserver;
property User : string Read Fusername Write Fusername;
Property Pass : string Read Fpassword Write Fpassword;
property Port : integer Read Fserverport Write Fserverport;
property ConnTimeOut : integer read FConnTimeOut Write FConnTimeOut;
property OnFindFile : TFindFile Read FFindFile write FFindFile;
property OnFindDir : TFindDir read FFindDir write FFindDir;
Property CurrentDir : string read FWorkDir write FWorkDir;
property OnMessage : TOnMessage read FOnMessage write FOnMessage;
property OnTimeOut : TOnTimeOut read FOnTimeOut write FOnTimeOut;
property Status : integer read Fstatus write Fstatus;
Property version : string read Fversion;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('FPiette', [CUindexFTP]);
end;
{ CUindexFTP }
function CUindexFTP.ChangeDir(dir: string): boolean;
begin
result:=false;
if MySpider.Connected then begin
MySpider.HostDirName:=dir;
FWorkDir:=dir;
result:=MySpider.Cwd;
end else begin
if assigned(OnTimeOut) then OnTimeOut(MySpider.StatusCode);
end;
end;
function CUindexFTP.connect: boolean;
begin
result :=false;
MySpider.HostName:=Fserver;
MySpider.UserName:=Fusername;
MySpider.PassWord:=Fpassword;
MySpider.Port:=IntToStr(Fserverport);
MySpider.Timeout:=Ftimeout;
MySpider.MultiThreaded:=true;
if MySpider.Open then
if MySpider.User then
result :=MySpider.Pass;
end;
constructor CUindexFTP.Create(Owner: TComponent);
begin
inherited Create(Owner);
MySpider:=TFtpClient.Create(nil);
MySpider.OnDisplay:=Display;
MySpider.OnError:=Error;
MySpider.OnStateChange:=StateChange;
Fserverport:=21;
Fusername:='anonymous';
Fversion :='UindexFTP V3.0';
Ftimeout :=10;
FConnTimeOut:=10;
end;
destructor CUindexFTP.Destroy;
begin
MySpider.Abort;
MySpider.Free;
inherited Destroy;
end;
procedure CUindexFTP.Display(Sender: TObject; var Msg: String);
begin
if assigned(OnMessage) then OnMessage(Msg);
end;
procedure CUindexFTP.Error(Sender: TObject; var Msg: String);
begin
if assigned(OnMessage) then OnMessage(Msg);
end;
function CUindexFTP.ListDir: integer;
var stm:TMemoryStream;
mylist:TStringList;
buffer:string;
ItemCount:integer;
begin
result:=0;
if MySpider.Connected then begin
stm:=TMemoryStream.Create;
mylist:=TStringList.Create;
try
MySpider.LocalStream:=stm;
if MySpider.Dir then begin
setlength(buffer,stm.size);
stm.Seek(0, soFromBeginning);
stm.Read(buffer[1],stm.size);
mylist.Text:=buffer;
for ItemCount := 0 to mylist.Count-1 do
begin
ParseList(mylist[ItemCount]);
end;
end;
finally
MySpider.LocalStream:=nil;
stm.Free;
mylist.Free;
end;
end else begin
if assigned(OnTimeOut) then OnTimeOut(MySpider.StatusCode);
end;
end;
procedure CUindexFTP.ParseList(List: string);
var i,j,k:integer;
Line,FileDate,FileName,FileAttribute,Owner,Group,FileSize:string;
begin
if List<>'' then begin
Line:=List;
if Line[1] in ['0'..'9'] then begin
//WinNT FTP Service
//微软的IIS附带的 FTP 服务器 DOS 响应选中
i:=pos(#32,Line);
FileDate:=Copy(Line,1,i-1);
Line:=Trim(Copy(Line,i+1,length(Line)-i));
j:=pos(#32,Line);
FileDate:=FileDate+' '+Copy(Line,1,j-1);
Line:=Trim(Copy(Line,j+1,length(Line)-j));
k:=pos('>',Line);
if k>0 then begin
//发现的是目录
FileName:=Trim(Copy(Line,k+1,length(Line)-k));
if Assigned(OnFindDir) then OnFindDir(FileName,FileDate,'','','');
end else begin
//发现的是文件
k:=pos(#32,Line);
FileSize:=Copy(Line,1,k-1);
FileName:=Trim(Copy(Line,k+1,length(Line)-k));
if Assigned(OnFindFile) then OnFindFile(FileName,FileDate,'','','',FileSize);
end;
end else begin
//UNIX SVR 4 或其兼容服务器 目录列表格式:
//drwxr-xr-x 6 1001 1001 512 Jan 19 2006 download
//属性 保留 用户 组 大小 时间 文件名
i:=pos(#32,Line);
FileAttribute:=Copy(Line,1,i-1);
Line:=Trim(Copy(Line,i+1,length(Line)-i));
//6 1001 1001 512 Jan 19 2006 download
i:=pos(#32,Line);
//保留
Line:=Trim(Copy(Line,i+1,length(Line)-i));
//1001 1001 512 Jan 19 2006 download
i:=pos(#32,Line);
Owner:=Copy(Line,1,i-1);
Line:=Trim(Copy(Line,i+1,length(Line)-i));
//1001 512 Jan 19 2006 download
i:=pos(#32,Line);
Group:=Copy(Line,1,i-1);
Line:=Trim(Copy(Line,i+1,length(Line)-i));
//512 Jan 19 2006 download
i:=pos(#32,Line);
FileSize:=Copy(Line,1,i-1);
Line:=Trim(Copy(Line,i+1,length(Line)-i));
//-------------------------------------------------------------------
//Jan 19 2006 download
//查找 3 次空格,做trim即可得到文件名
//-------------------------------------------------------------------
i:=pos(#32,Line);
FileDate:=Copy(Line,1,i-1);
Line:=Trim(Copy(Line,i+1,length(Line)-i));
i:=pos(#32,Line);
FileDate:=FileDate +' '+ Copy(Line,1,i-1);
Line:=Trim(Copy(Line,i+1,length(Line)-i));
i:=pos(#32,Line);
FileDate:=FileDate +' '+ Copy(Line,1,i-1);
FileName:=Trim(Copy(Line,i+1,length(Line)-i));
if LowerCase(List[1])='d' then begin
if Assigned(OnFindDir) then OnFindDir(FileName,FileDate,FileAttribute,Owner,Group);
end else begin
if Assigned(OnFindFile) then OnFindFile(FileName,FileDate,FileAttribute,Owner,Group,FileSize);
end;
end;
end;
end;
procedure CUindexFTP.StateChange(Sender: TObject);
begin
Fstatus:=MySpider.StatusCode;
end;
end.