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.

推荐阅读

web
javax.mail.search.BodyTerm.matchPart()方法的使用及代码示例

javax.mail.search.BodyTerm.matchPart()方法的使用及代码示例 ... [详细]

蜡笔小新 2024-11-13 15:24:50
netty
面试中如何回答“零拷贝”技术问题？

零拷贝技术是提高I/O性能的重要手段，常用于Java NIO、Netty、Kafka等框架中。本文将详细解析零拷贝技术的原理及其应用。 ... [详细]

蜡笔小新 2024-11-13 02:03:52
rsa
PHP 对象生命周期与内存管理

本文详细介绍了 PHP 中对象的生命周期、内存管理和魔术方法的使用，包括对象的自动销毁、析构函数的作用以及各种魔术方法的具体应用场景。 ... [详细]

蜡笔小新 2024-11-12 13:35:26
dll
探讨HTTP隧道技术在RDP暴力破解中的应用

本文介绍了如何利用HTTP隧道技术在受限网络环境中绕过IDS和防火墙等安全设备，实现RDP端口的暴力破解攻击。文章详细描述了部署过程、攻击实施及流量分析，旨在提升网络安全意识。 ... [详细]

蜡笔小新 2024-11-12 12:08:47
dll
开发中遇到的一些常见问题及解决方案

本文总结了一些开发中常见的问题及其解决方案，包括特性过滤器的使用、NuGet程序集版本冲突、线程存储、溢出检查、ThreadPool的最大线程数设置、Redis使用中的问题以及Task.Result和Task.GetAwaiter().GetResult()的区别。 ... [详细]

蜡笔小新 2024-11-12 08:20:05
metadata
使用 Matplotlib 保存 Python 动态图像为视频文件的方法与技巧

本文介绍了如何利用 `matplotlib` 库中的 `FuncAnimation` 类将 Python 中的动态图像保存为视频文件。通过详细解释 `FuncAnimation` 类的参数和方法，文章提供了多种实用技巧，帮助用户高效地生成高质量的动态图像视频。此外，还探讨了不同视频编码器的选择及其对输出文件质量的影响，为读者提供了全面的技术指导。 ... [详细]

蜡笔小新 2024-11-11 22:11:30
int
InfluxDB、collectd与Grafana的详细安装与配置指南

本文详细介绍了 InfluxDB、collectd 和 Grafana 的安装与配置流程。首先，按照启动顺序依次安装并配置 InfluxDB、collectd 和 Grafana。InfluxDB 作为时序数据库，用于存储时间序列数据；collectd 负责数据的采集与传输；Grafana 则用于数据的可视化展示。文中提供了 collectd 的官方文档链接，便于用户参考和进一步了解其配置选项。通过本指南，读者可以轻松搭建一个高效的数据监控系统。 ... [详细]

蜡笔小新 2024-11-11 19:54:24
dll
在Windows系统中安装TensorFlow GPU版的详细指南与常见问题解决

在Windows系统中安装TensorFlow GPU版是许多深度学习初学者面临的挑战。本文详细介绍了安装过程中的每一个步骤，并针对常见的问题提供了有效的解决方案。通过本文的指导，读者可以顺利地完成安装并避免常见的陷阱。 ... [详细]

蜡笔小新 2024-11-11 19:02:49
int
Cocos2d-x学习笔记：基础概念解析与内存管理机制深入探讨

在《Cocos2d-x学习笔记：基础概念解析与内存管理机制深入探讨》中，详细介绍了Cocos2d-x的基础概念，并深入分析了其内存管理机制。特别是针对Boost库引入的智能指针管理方法进行了详细的讲解，例如在处理鱼的运动过程中，可以通过编写自定义函数来动态计算角度变化，利用CallFunc回调机制实现高效的游戏逻辑控制。此外，文章还探讨了如何通过智能指针优化资源管理和避免内存泄漏，为开发者提供了实用的编程技巧和最佳实践。 ... [详细]

蜡笔小新 2024-11-11 14:49:31
web
PHP 各版本对比：标准版与最新顶级版的详细分析

PHP 各版本对比：标准版与最新顶级版的详细分析 ... [详细]

蜡笔小新 2024-11-11 13:23:25
int
深入解析 Synchronized 锁的升级机制及其在并发编程中的应用

深入解析 Synchronized 锁的升级机制及其在并发编程中的应用 ... [详细]

蜡笔小新 2024-11-11 13:09:38
timestamp
Cacti 数据库错误：SQL 查询失败，错误代码 145

在使用 Cacti 进行监控时，发现已运行的转码机未产生流量，导致 Cacti 监控界面显示该转码机处于宕机状态。进一步检查 Cacti 日志，发现数据库中存在 SQL 查询失败的问题，错误代码为 145。此问题可能是由于数据库表损坏或索引失效所致，建议对相关表进行修复操作以恢复监控功能。 ... [详细]

蜡笔小新 2024-11-11 12:57:49
timestamp
CentOS 6.7系统维护：查看补丁及常用巡检命令汇总

在 CentOS 6.7 系统维护中，常用的巡检命令包括：`uname -a` 用于查看内核、操作系统和 CPU 信息；`head -n 1 /etc/issue` 用于查看操作系统的版本；`cat /proc/cpuinfo` 用于获取详细的 CPU 信息；`hostname` 用于显示当前主机名；`ls` 命令则用于列出目录内容。这些命令可以帮助系统管理员快速了解系统的运行状态和配置信息，确保系统的稳定性和安全性。 ... [详细]

蜡笔小新 2024-11-10 11:31:40
int
使用Shell脚本高效部署MHA高可用集群

本文介绍了如何利用Shell脚本高效地部署MHA（MySQL High Availability）高可用集群。通过详细的脚本编写和配置示例，展示了自动化部署过程中的关键步骤和注意事项。该方法不仅简化了集群的部署流程，还提高了系统的稳定性和可用性。 ... [详细]

蜡笔小新 2024-11-10 10:15:46
int
Python多线程编程技巧与实战应用详解

Python多线程编程技巧与实战应用详解 ... [详细]

蜡笔小新 2024-11-09 20:44:15

小白

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

Tags | 热门标签

RankList | 热门文章