UindexFTP基于ICS实现的FTP操作类[转]

//-----------------------------------------
//组件定义CUindexFTP类
//编写环境:Borland Delphi 7.0 +WinXP
//编写时间:12:47 11.21
//作者地址:****** **
//实现功能:搜索引擎核心类之一,实现一个简化FTP操作的控件
//-----------------------------------------
//更新日志:
//14:51 2006-11-7
//ddd50:修正了新添加站点无法搜索的错误并修改相关错误.
//ZengJun:允许站点入口地址不填写结束的斜杠.
//ZengJun:被分到VIP分组的站点排名更加靠前.
//ZengJun:优化代码,对已经检索的且没有更新的网页不记录内容.
//
//12:54 2006-11-6
//ZengJun:借助于FastMM对程序进行内存泄漏检查,重写了替换函数等存在内存泄漏的类,再次规范化代码.
//LRCMP4工作室:在他(QQ:472053531)的建议下,在程序新建查询线程前处理一次消息,避免界面出现"卡"的现象.
//ZengJun:增加网站列表导入导出功能,整理代码,将不常用的字符串函数放于NCstring.PAS中.
//
//12:10 2006-11-3
//ZengJun:修正信息片算法的一处不合理,提高信息片算法的效率.
//ZengJun:应正龙数据要求,可以自定义程序版权,可搜索多级子域名,添加仅搜索指定关键词功能.
//ZengJun:增加违禁关键字检查功能,并可以打印违禁网页列表.
//
//13:08 2006-10-29
//ZengJun:修正发现的错误,优化编码,R2.Beta测试继续.
//ZengJun:不纪录无意义的小数字,对网页URL跳转进行检查,改善收录不合格链接的情况.
//ZengJun:修正SQLserver数据库创建脚本中未实现部分字段唯一性约束的错误.
//ZengJun:将ASP.Net网页部分与VS.Net编辑环境脱离,用户可以直接编辑网页文件并立即在IIS上看到修改效果.
//
//13:32 2006-10-19
//ZengJun:修正网页显示时空标题网页为正文首行.
//ZengJun:加入时间栏图标,当程序在运行时点叉叉按钮会缩小到时间栏中.
//ZengJun:信息片算法在进行动态排序时,由于未检查索引范围,导致程序崩溃,现已解决.
//ZengJun:进度条和界面的刷新占用了大量资源,导致CPU一直100%,现在改为在几个关键点才显示进度.
//
//21:29 2006-10-16
//zlnic:感谢咸阳市正龙资讯有限公司,赞助服务器一台(双奔腾四2.4G+512M内存),Uindex非常感谢!
//ZengJun:修正在SQLserver上调试时发现的错误,优化测试版源代码.
//ZengJun:加入对禁止内容检测支持,用户可以自定义敏感词表以实现选择性标志.
//ZengJun:改善对明显的跳转和无意义网页的检测.
//
//11:40 2006-10-15
//cnjlc:修改CHM文档,加入SQLserver数据库的格式描述.
//ZengJun:实际测试了ASPX搜索页面,修正R1发行版时留下的若干问题.
//ZengJun:索引程序可以自动识别CSW,将CSW5.0的一个DLL和两个词库文件复制到Lucene.Net.exe相同目录即可实现中文分词索引.
//ZengJun:加入站点搜索页面上限值(默认5120),同时增加禁止访问列表,站点导出功能.
//
//20:36 2006-10-13
//飞来飞去:搜索运行一段时间后CPU占用变大,原因是信息片全部存储,现已修正为存储哈希值并动态调整信息片概率列表,信息片算法最多额外占用96KB.
//ZengJun:信息片拆分算法存在问题,效率和逻辑现已修正.
//
//15:03 2006-10-6
//ZengJun:Uindex第一版发行,Uindex.R1首次将WWW搜索和FTP搜索作为合集发行.
//ZengJun:界面部分设计完成,发行这个版本花费了我4个月的休息时间,修改1895次,源代码文件合计5820行.
//
//11:23 2006-10-1
//ZengJun:开始实现界面逻辑,准备发行UindexWeb.R1.
//ZengJun:PageRank物理分值计算模块设计完成,网页长度和连接信息比均考虑在内,主要使用正态分布(GAUSS)函数,和拟GAMMA函数计算分值.
//ZengJun:网页解析组件在处理弹出窗口时存在问题,更正为在onurl时先效验地址合法性.
//ZengJun:信息片算法开始发挥功用,搜索网页结果中无效信息明显减少.
//
//20:23 2006-9-26
//ZengJun:WWW搜索发布内部测试版本,UindexWeb.R1,这个版本的发布经历了1260次修改,仍然有很多未定的算法,功能.
//ZengJun:ICS.V6.Beta的HTTPCli组件在使用异步传输时出现超时处理异常,修正为阻塞模式.
//
//21:43 2006-9-15
//ZengJun:WWW搜索陷入困境,开学后实习结束了,编写Web搜索的热情反而比不上修改UindexFTP的热情,面对困难都想退却了,等待状态好转继续(实际上花费了整整1个月的休息时间).
//
//21:17 2006-8-29
//ZengJun:在发现连接算法中使用多次递归,而不是像信息片算法那样一次完成,主要是为了算法清晰,例外主要的时间也不是花在Html分析上而是在网页读取上,更重要的工作是协调多个线程。
//ZengJun:在与TPerlRegEx进行网页链接提取的比较中,RegEx把操作变得简单很多,但是搜索项目不吝惜复杂,自主实现链接分析,换来的是正则无法比拟的速度.
//
//2006-8-22
//ZengJun:设计将更多的人的因素加到搜索中,比如文件类型识别,域名IP归属识别,网页编程语言识别等。
//ZengJun:当前版本Delphi 7 Entireprise Edition 字符处理函数posex存在bug,当string为空时会出现非法读取错误,因此在使用前需要判断一下,这里没有新写一个posex函数.
//

unit UindexFTP;interfaceuses 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;implementationprocedure 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.