idftplist.pas

photo.163.com 相册下载器 多线程下载

{   Rev 1.9    12/11/2002 05:52:18 PM  JPMugaas
{ Fixed MS-DOS parser.  A bug would be triggered with
{ "MS-DOS-MicrosoftFTP5.0-1.txt".  The parser would locate the first 43 in a
{ seconds portion of the dir entry instead of the file size column which also
{ contained 43.  Thanks, Jeff Easton for reporting this little gem.  Also
{ removed some unneeded variables from the MS-DOS parser.
}
{
{   Rev 1.8    12/11/2002 03:37:06 PM  JPMugaas
{ Added LocalFileName property and the parsers now set this.  This property is
{ a suggested filename for saving the file in the local system.  Pathes are
{ removed from the FileName property and the version mark is stripped with VMS
{ FTP Servers.
}
{
{   Rev 1.7    12/9/2002 09:34:38 PM  JPMugaas
{ Novel Netware with NFS Volume namespace was not working as expected.  A space
{ at position in Unknown 1 and 2 was throwing things off.  I simplified the
{ logic and refined the detection further.
}
{
{   Rev 1.6    12/9/2002 06:57:50 PM  JPMugaas
{ Added a new symbolic type for cases where a Unix server would return a / at
{ the the end of the LinkedTo file name for a dir (clarifying if a link points
{ to a file or a dir).  If using the DIR -F, some dir names will have a / at
{ the end and executable programs may have a * at the end.  Updated the UNIX
{ parser for new -F param. support.  Note that the -F parameter is from the ls
{ command.  Most servers get dir lists simply by piping output from the /bin/ls
{ command.  NcFTP server will also simulate the ls output.
}
{
{   Rev 1.5    12/7/2002 03:20:10 PM  JPMugaas
{ NCSA FTP server for MS-DOS - I hope.  I think it is included in the Telnet
{ package.
}
{
{   Rev 1.4    12/6/2002 08:46:34 PM  JPMugaas
{ KA9Q Support.  KA9Q is a set of Internet programs for MS-DOS including a FTP
{ server.  This was popular in the late 1980's and early 1990's.   It's not in
{ use much anymore but might be used by Ham radio operators.
}
{
{   Rev 1.3    12/1/2002 04:20:56 PM  JPMugaas
{ added flfNextLine to handle cases where we can't determine the format of a
{ dir with a particular line returned by the server.  Expanded Unix Parser to
{ also handle Unitree FTP servers.  We now handle Unitree servers and I have
{ verified that Unix ls -l * output now works (note that many Unix servers
{ simply pipe output from that program).
}
{
{   Rev 1.0    11/13/2002 08:28:58 AM  JPMugaas
{ Initial import from FTP VC.
}
unit IdFTPList;

{
NOTE:  For this class, I recommend that you read some secionts in the

Operating Systems Handbook

The book is out of print but is freely available at:

http://www.snee.com/bob/opsys.html

 - Fixes as per user request for parsing non-detailed lists (SP).
   [Added flfNoDetails list format].

Initial version by
  D. Siders
  Integral Systems
  October 2000

Additions and extensions
  A Neillans

  Apr.2002
  - Fixed bug with MSDos Listing format - space in front of file names.

  Sep.2001 & Jan.2002
  - Merged changes submitted by Andrew P.Rybin

  Doychin Bondzhev ([e-mail])
  dSoft-Bulgaria

  2002 - Aug-23 - J. Peter Mugaas
   - fixed a parsing bug in all parsers.  A file name begging with a space will
     throw off the parsers.  Modified VMS parser to permit file names containing spaces

  2002 - Aug-22 - J. Peter Mugaas
   - VM/CMS - now returns OwnerName - I think.
   - Added RecType for VM/CMS.
   - Renamed BlockSize to NumberBlocks. Note:  Block size in VMS is usually 512 anyway
(we hard-code that for a constant) and in VM/CMS, the block size is either
800, 512, 1024, 2048, or 4096 at the whim of the user and we can't get the
block size from the DIR listing.  In other words, any block size property is
useless.
   - Changed VMS behvioar to be consistant with this.
   - Insider Privillages property added to TIdFTPListItem.  This is the
OwnerPermissions for Novell Netware.  Note that Novell Privillages are far different
than Unix permissions so they belong in a different property.
   - added VMS file owner and group.  See: http://seqaxp.bio.caltech.edu/www/vms_beginners_faq.html#FILE00
   - VMS file protections (permissions).  See: http://www.djesys.com/vms/freevms/mentor/vms_prot.html#prvs

  2002 - Aug-20 - J. Peter Mugaas
   - Added Novell Netware directory parsing.
   - Rewrote IdFTPList Novell Netware parsing.  File names with spaces are now
     properly handled.  The code also has a side effect of stripping out a zero
     that occurred in a directory that was probably due to a quirk.

  2002 - Aug-19 - J. Peter Mugaas
   - Improved VMS Directory partsing.  It NO LONGER is dependant upon specific
   column widthes.
   - Fixed bugs in VM file parsing and determination.
   - Now handles multiline VMS file list entries.

  2002 - Aug-18 - J. Peter Mugaas
   - VM/CMS or VM/ESA Mainframe directory format parsing added
   - VMS parsing added

  February 2001
  - TFTPListItem now descends from TCollectionItem
  - TFTPList now descends from TCollection
  Jun 2001
  - Fixes in UNIX format parser
  Aug 2001
  - It is now used in the FTP server component
}

interface

uses
  Classes, IdGlobal, IdException, IdFTPCommon, SysUtils;

{ Indy TIdFtp extensions to support automatic parsing of FTP directory listings }

type
  EIdInvalidFTPListingFormat = class(EIdException);

  TIdDirItemType = (ditDirectory, ditFile, ditSymbolicLink, ditSymbolicLinkDir,
    ditBlockDev, ditCharDev, ditFIFO, ditSocket);

   {For MVS JES Job status}
  TIdJESJobStatus = (IdJESNotApplicable, IdJESReceived, IdJESHold, IdJESRunning, IdJESOuptutAvailable);
  {For VSE PowerQueue Job dispositions}

  TIdFTPListItems = class;

  // TIdFTPListItem stores an item in the FTP directory listing
  TIdFTPListItem = class(TCollectionItem)
  protected
    FSize: Int64;
    FItemCount: Integer;
    FData: string;
    FFileName: string;
    FLocalFileName : string; //suggested file name for local file
    FSizeAvail : Boolean;
    FModifiedAvail : Boolean;
    {    FUnixGroupPermissions: string;
    FGroupName: string;
    FUnixOwnerPermissions: string;
    FOwnerName: string;
    FUnixOtherPermissions: string;
    FUnixinode : Integer;      }
    FModifiedDate: TDateTime;
    //the item below is for cases such as MLST output, EPLF, and Distinct format
    //which usually reports dates in GMT
    FModifiedDateGMT : TDateTime;
    //Creation time values are for MLSD data output and can be returned by the
    //the MLSD parser in some cases
{    FCreationDate: TDateTime;
    FCreationDateGMT : TDateTime;
    //Unique ID for an item to prevent yourself from downloading something twice
    FUniqueID : String;
    //
    FLinkedItemName : string; }
    FItemType: TIdDirItemType;
    //an error has been reported in the DIR listing itself for an item
    FDirError : Boolean;
    //property set methods
    procedure SetFileName(const AValue : String);
    //may be used by some descendent classes
    property ModifiedDateGMT : TDateTime read FModifiedDateGMT write FModifiedDateGMT;
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create(AOwner: TCollection); override;
    destructor Destroy; override;

    property Data: string read FData write FData;

    property Size: Int64 read FSize write FSize;
    property ModifiedDate: TDateTime read FModifiedDate write FModifiedDate;


    property FileName: string read FFileName write SetFileName;
    property LocalFileName : string read FLocalFileName write FLocalFileName;
    property ItemType: TIdDirItemType read FItemType write FItemType;
    property SizeAvail : Boolean read FSizeAvail write FSizeAvail;
    property ModifiedAvail : Boolean read FModifiedAvail write FModifiedAvail;

   
  end;

  TIdOnGetCustomListFormat = procedure(AItem: TIdFTPListItem; var VText: string) of object;
  TIdOnParseCustomListFormat = procedure(AItem: TIdFTPListItem) of object;

  // TFTPList is the container and parser for items in the directory listing
  TIdFTPListItems = class(TCollection)
  protected
    FDirectoryName: string;
    //
    procedure SetDirectoryName(const AValue: string);
    function GetItems(AIndex: Integer): TIdFTPListItem;
    procedure SetItems(AIndex: Integer; const Value: TIdFTPListItem);
  public
    function Add: TIdFTPListItem;
    constructor Create; reintroduce;
    function IndexOf(AItem: TIdFTPListItem): Integer;
    property DirectoryName: string read FDirectoryName write SetDirectoryName;
    property Items[AIndex: Integer]: TIdFTPListItem read GetItems write SetItems; default;
  end;

implementation
Uses IdContainers, IdResourceStrings, IdStrings;

{ TFTPListItem }

constructor TIdFTPListItem.Create(AOwner: TCollection);
begin
  inherited Create(AOwner);
  Data := '';    {Do not Localize}
  FItemType := ditFile;
  Size := 0;
  ModifiedDate := 0.0;
  FFileName := '';    {Do not Localize}
  FLocalFileName := '';
    FSizeAvail := True;
    FModifiedAvail := True;
end;

procedure TIdFTPListItem.Assign(Source: TPersistent);
Var
  Item: TIdFTPListItem;
begin
  Item := TIdFTPListItem(Source);
  Data := Item.Data;
  ItemType := Item.ItemType;

  Size := Item.Size;
  ModifiedDate := Item.ModifiedDate;
  FileName := Item.FileName;
end;

{ TFTPList }

constructor TIdFTPListItems.Create;
begin
  inherited Create(TIdFTPListItem);
end;

function TIdFTPListItems.Add: TIdFTPListItem;
begin
  Result := TIdFTPListItem(inherited Add);
end;

function TIdFTPListItems.GetItems(AIndex: Integer): TIdFTPListItem;
begin
  Result := TIdFTPListItem(inherited Items[AIndex]);
end;

function TIdFTPListItems.IndexOf(AItem: TIdFTPListItem): Integer;
Var
  i: Integer;
begin
  result := -1;
  for i := 0 to Count - 1 do
    if AItem = Items[i] then begin
      result := i;
      break;
    end;
end;

procedure TIdFTPListItems.SetItems(AIndex: Integer; const Value: TIdFTPListItem);
begin
  inherited Items[AIndex] := Value;
end;

procedure TIdFTPListItems.SetDirectoryName(const AValue: string);
begin
  if not TextIsSame(FDirectoryName, AValue) then begin       
    FDirectoryName := AValue;
    Clear;
  end;
end;

procedure TIdFTPListItem.SetFileName(const AValue: String);
var i : Integer;
    LLowerCase : Boolean;
const LLowCase = ['a','b','c','d','e','f','g','h','i','j','k','l','m',  {do not localize}
                 'n','o','p','q','r','s','t','u','v','w','x','y','z'];   {do not localize}
begin

  if (FLocalFileName = '') or (UpperCase(FFileName) = UpperCase(FLocalFileName)) then
  begin
    //we do things this way because some file systems use all capital letters or are
    //case insensivite.  The Unix file is case sensitive and Unix users tend to
    //prefer lower case filenames.  We do not want to force lowercase if a file
    //has both uppercase and lowercase because the uppercase letters are rpobably intentional
    LLowerCase := True;
    for i := 1 to Length(AValue) do
    begin
      if CharIsInSet(AValue, i, LLowCase) then
      begin
        LLowerCase := False;
        Break;
      end;
    end;
    if LLowerCase then
    begin
      FLocalFileName := LowerCase(AValue);
    end
    else
    begin
      FLocalFileName := AValue;
    end;
  end;
   FFileName := AValue;
end;

destructor TIdFTPListItem.Destroy;
begin
  inherited;
end;

end.