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

作者：小白 | 来源：互联网 | 2023-05-19 10:16

-----------------------------------------组件定义CUindexFTP类编写环境:BorlandDelphi7.0+WinXP

//-----------------------------------------
//组件定义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;
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.

推荐阅读

ip
深入解析Linux下的I/O多路转接epoll技术

本文深入解析了Linux下的I/O多路转接epoll技术，介绍了select和poll函数的问题，以及epoll函数的设计和优点。同时讲解了epoll函数的使用方法，包括epoll_create和epoll_ctl两个系统调用。 ... [详细]

蜡笔小新 2023-12-10 14:18:30
ip
Nginx使用AWStats日志分析的步骤及注意事项

本文介绍了在Centos7操作系统上使用Nginx和AWStats进行日志分析的步骤和注意事项。通过AWStats可以统计网站的访问量、IP地址、操作系统、浏览器等信息，并提供精确到每月、每日、每小时的数据。在部署AWStats之前需要确认服务器上已经安装了Perl环境，并进行DNS解析。 ... [详细]

蜡笔小新 2023-12-14 19:42:01
ip
SQL日志收缩及截断方法详解

本文详细介绍了SQL日志收缩的方法，包括截断日志和删除不需要的旧日志记录。通过备份日志和使用DBCC SHRINKFILE命令可以实现日志的收缩。同时，还介绍了截断日志的原理和注意事项，包括不能截断事务日志的活动部分和MinLSN的确定方法。通过本文的方法，可以有效减小逻辑日志的大小，提高数据库的性能。 ... [详细]

蜡笔小新 2023-12-14 18:23:25
ip
Android 新闻App的本地服务器搭建教程

本文介绍了在开发Android新闻App时，搭建本地服务器的步骤。通过使用XAMPP软件，可以一键式搭建起开发环境，包括Apache、MySQL、PHP、PERL。在本地服务器上新建数据库和表，并设置相应的属性。最后，给出了创建new表的SQL语句。这个教程适合初学者参考。 ... [详细]

蜡笔小新 2023-12-14 17:15:19
java
Oracle优化新常态的五大禁止及其性能隐患

本文介绍了Oracle优化新常态中的五大禁止措施，包括禁止外键、禁止视图、禁止触发器、禁止存储过程和禁止JOB，并分析了这些禁止措施可能带来的性能隐患。文章还讨论了这些禁止措施在C/S架构和B/S架构中的不同应用情况，并提出了解决方案。 ... [详细]

蜡笔小新 2023-12-12 12:55:55
dll
使用集算器将日志文件结构化，轻松使用SQL查询

本文介绍了一种轻巧方便的工具——集算器，通过使用集算器可以将文本日志变成结构化数据，然后可以使用SQL式查询。集算器利用集算语言的优点，将日志内容结构化为数据表结构，SPL支持直接对结构化的文件进行SQL查询，不再需要安装配置第三方数据库软件。本文还详细介绍了具体的实施过程。 ... [详细]

蜡笔小新 2023-12-11 13:27:46
java
在虚拟服务器上安装oracle 10g客户端的问题及解决方法

本文讨论了在VMWARE5.1的虚拟服务器Windows Server 2008R2上安装oracle 10g客户端时出现的问题，并提供了解决方法。错误日志显示了异常访问违例，通过分析日志中的问题帧，找到了解决问题的线索。文章详细介绍了解决方法，帮助读者顺利安装oracle 10g客户端。 ... [详细]

蜡笔小新 2023-12-11 13:08:10
ip
[Windows]_[网络]_[浏览器无法访问网站DNS_PROBE_POSSIBLE]

场景1.IE,Firefox浏览器访问不了网站,谷歌浏览器可以,返回错误码DNS_PROBE_POSSIBLE.2.pingwww.qq.com可以ping通,ping局域 ... [详细]

蜡笔小新 2023-10-17 17:55:37
object
C#学习教程：在Console中工作但在Windows窗体中不工作的异步代码分享

本文分享了一个关于在C#中使用异步代码的问题，作者在控制台中运行时代码正常工作，但在Windows窗体中却无法正常工作。作者尝试搜索局域网上的主机，但在窗体中计数器没有减少。文章提供了相关的代码和解决思路。 ... [详细]

蜡笔小新 2023-12-14 15:56:00
ip
ASP.NET Tips: 获取插入记录的ID的方法详解

本文详细介绍了在ASP.NET中获取插入记录的ID的几种方法，包括使用SCOPE_IDENTITY()和IDENT_CURRENT()函数，以及通过ExecuteReader方法执行SQL语句获取ID的步骤。同时，还提供了使用这些方法的示例代码和注意事项。对于需要获取表中最后一个插入操作所产生的ID或马上使用刚插入的新记录ID的开发者来说，本文提供了一些有用的技巧和建议。 ... [详细]

蜡笔小新 2023-12-13 17:03:18
ip
MySQL显示SQL语句执行时间的实例详解

本文详细介绍了如何使用MySQL来显示SQL语句的执行时间，并通过MySQL Query Profiler获取CPU和内存使用量以及系统锁和表锁的时间。同时介绍了效能分析的三种方法：瓶颈分析、工作负载分析和基于比率的分析。 ... [详细]

蜡笔小新 2023-12-12 16:16:42
ip
服务器上的操作系统有哪些，如何选择适合的操作系统？

本文介绍了服务器上常见的操作系统，包括系统盘镜像、数据盘镜像和整机镜像的数量。同时，还介绍了共享镜像的限制和使用方法。此外，还提供了关于华为云服务的帮助中心，其中包括产品简介、价格说明、购买指南、用户指南、API参考、最佳实践、常见问题和视频帮助等技术文档。对于裸金属服务器的远程登录，本文介绍了使用密钥对登录的方法，并提供了部分操作系统配置示例。最后，还提到了SUSE云耀云服务器的特点和快速搭建方法。 ... [详细]

蜡笔小新 2023-12-12 13:33:19
ip
RouterOS 5.16软路由安装图解教程

本文介绍了如何安装RouterOS 5.16软路由系统，包括系统要求、安装步骤和登录方式。同时提供了详细的图解教程，方便读者进行操作。 ... [详细]

蜡笔小新 2023-12-12 10:22:22
ip
嵌入式处理器的架构与内核发展历程

本文主要介绍了嵌入式处理器的架构与内核发展历程，包括不同架构的指令集的变化，以及内核的流水线和结构。通过对ARM架构的分析，可以更好地理解嵌入式处理器的架构与内核的关系。 ... [详细]

蜡笔小新 2023-12-11 15:38:57
java
操作系统的定义和功能

本文介绍了操作系统的定义和功能，包括操作系统的本质、用户界面以及系统调用的分类。同时还介绍了进程和线程的区别，包括进程和线程的定义和作用。 ... [详细]

蜡笔小新 2023-12-11 14:17:13

小白

这个家伙很懒，什么也没留下！

Tags | 热门标签

RankList | 热门文章