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.

推荐阅读

io
Oracle 11g 创建表空间与基础配置

本文详细介绍了Oracle 11g中的创建表空间的方法，以及如何设置客户端和服务端的基本配置，包括用户管理、环境变量配置等。 ... [详细]

蜡笔小新 2024-11-21 18:54:39
uri
CentOS下ProFTPD的安装与配置指南

本文详细介绍在CentOS操作系统上安装和配置ProFTPD服务的方法，包括基本配置、安全设置及高级功能的启用。 ... [详细]

蜡笔小新 2024-11-21 09:45:56
foreach
PHP面试题精选及答案解析

本文精选了新浪PHP笔试题及最新的PHP面试题，并提供了详细的答案解析，帮助求职者更好地准备PHP相关的面试。 ... [详细]

蜡笔小新 2024-11-19 20:00:19
copy
Java代码保护与混淆：ProGuard详解

在Java开发中，保护代码安全是一个重要的课题。由于Java字节码容易被反编译，因此使用代码混淆工具如ProGuard变得尤为重要。本文将详细介绍如何使用ProGuard进行代码混淆，以及其基本原理和常见问题。 ... [详细]

蜡笔小新 2024-11-18 16:46:17
io
Redis：缓存与内存数据库详解

本文介绍了数据库的基本分类，重点探讨了关系型与非关系型数据库的区别，并详细解析了Redis作为非关系型数据库的特点、工作模式、优点及持久化机制。 ... [详细]

蜡笔小新 2024-11-18 14:16:11
io
开发笔记:empireCMS 帝国cms功能总结

开发笔记:empireCMS 帝国cms功能总结 ... [详细]

蜡笔小新 2024-11-17 19:03:16
metadata
对象存储与块存储、文件存储等对比

看到一篇文档，讲对象存储，好奇，搜索文章，摘抄,学习记录！背景：传统存储在面对海量非结构化数据时，在存储、分享与容灾上面临很大的挑战，主要表现在以下几个方面：传统存储并非为非结 ... [详细]

蜡笔小新 2024-11-17 18:21:23
io
Spring Boot与Graylog集成实现微服务日志聚合与分析

本文介绍了如何在Graylog中配置输入源，并详细说明了Spring Boot项目中集成Graylog的日志聚合和分析方法，包括logback.xml的多环境配置。 ... [详细]

蜡笔小新 2024-11-17 11:47:30
object
IC卡操作功能实现

本文介绍了如何通过C#语言调用动态链接库（DLL）中的函数来实现IC卡的基本操作，包括初始化设备、设置密码模式、获取设备状态等，并详细展示了将TextBox中的数据写入IC卡的具体实现方法。 ... [详细]

蜡笔小新 2024-11-21 11:02:19
io
protobuf 使用心得：解析与编码陷阱

本文记录了一次在广告系统中使用protobuf进行数据交换时遇到的问题及其解决过程。通过这次经历，我们将探讨protobuf的特性和编码机制，帮助开发者避免类似的陷阱。 ... [详细]

蜡笔小新 2024-11-20 14:35:41
cmd
Git配置及常用命令详解

本文介绍了如何在不同操作系统上安装Git，以及一些基本和高级的Git操作，包括项目初始化、文件状态检查、版本控制、分支管理、标签处理、版本回退等，并简要提及了开源许可协议的选择。 ... [详细]

蜡笔小新 2024-11-19 19:52:34
runtime
解决Tomcat启动时出现org.apache.catalina.LifecycleException异常的方法

在尝试启动Java应用服务器Tomcat时，遇到了org.apache.catalina.LifecycleException异常。本文详细记录了异常的具体表现形式，并提供了有效的解决方案。 ... [详细]

蜡笔小新 2024-11-19 11:46:52
io
如何处理PHP缺少扩展的问题

本文将详细介绍如何解决PHP环境中缺少扩展的问题，包括检查当前环境、修改配置文件以及验证修改是否生效的具体步骤，帮助开发者更好地管理和使用PHP扩展。 ... [详细]

蜡笔小新 2024-11-19 09:19:01
io
Selenium 2 测试用例详解

本文详细介绍了使用 Selenium 2 进行测试的各种类型和注意事项，包括静态内容测试、链接测试、功能测试、动态元素测试、Ajax 测试以及断言与验证的区别。 ... [详细]

蜡笔小新 2024-11-18 21:59:48
io
HPE OEM Brocade 300 交换机无中断固件升级指南

本文详细介绍了如何通过FTP方式对HPE OEM Brocade 300交换机进行无中断固件升级，确保网络服务的连续性。 ... [详细]

蜡笔小新 2024-11-17 12:12:22

小白

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

Tags | 热门标签

RankList | 热门文章