idftplistoutput.pas

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

{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  16230: IdFTPListOutput.pas
{
{   Rev 1.17    10/26/2004 9:36:26 PM  JPMugaas
{ Updated ref.
}
{
{   Rev 1.16    10/26/2004 9:19:14 PM  JPMugaas
{ Fixed references.
}
{
{   Rev 1.15    10/1/2004 6:17:12 AM  JPMugaas
{ Removed some dead code.
}
{
{   Rev 1.14    6/27/2004 1:45:36 AM  JPMugaas
{ Can now optionally support LastAccessTime like Smartftp's FTP Server could. 
{ I also made the MLST listing object and parser support this as well.
}
{
    Rev 1.13    6/11/2004 9:34:44 AM  DSiders
  Added "Do not Localize" comments.
}
{
{   Rev 1.12    4/19/2004 5:06:02 PM  JPMugaas
{ Class rework Kudzu wanted.
}
{
{   Rev 1.11    2004.02.03 5:45:34 PM  czhower
{ Name changes
}
{
{   Rev 1.10    24/01/2004 19:18:48  CCostelloe
{ Cleaned up warnings
}
{
{   Rev 1.9    1/4/2004 12:09:54 AM  BGooijen
{ changed System.Delete to IdDelete
}
{
{   Rev 1.8    11/26/2003 6:23:44 PM  JPMugaas
{ Quite a number of fixes for recursive dirs and a few other things that
{ slipped my mind.
}
{
    Rev 1.7    10/19/2003 2:04:02 PM  DSiders
  Added localization comments.
}
{
{   Rev 1.6    3/11/2003 07:36:00 PM  JPMugaas
{ Now reports permission denied in subdirs when doing recursive listts in Unix
{ export.
}
{
{   Rev 1.5    3/9/2003 12:01:26 PM  JPMugaas
{ Now can report errors in recursive lists.
{ Permissions work better.
}
{
{   Rev 1.4    3/3/2003 07:18:34 PM  JPMugaas
{ Now honors the FreeBSD -T flag and parses list output from a program using
{ it.  Minor changes to the File System component.
}
{
{   Rev 1.3    2/26/2003 08:57:10 PM  JPMugaas
{ Bug fix.  The owner and group should be left-justified.
}
{
{   Rev 1.2    2/24/2003 07:24:00 AM  JPMugaas
{ Now honors more Unix switches just like the old code and now work with the
{ NLIST command when emulating Unix.  -A switch support added.  Switches are
{ now in constants.
}
{
{   Rev 1.1    2/23/2003 06:19:42 AM  JPMugaas
{ Now uses Classes instead of classes.
}
{
{   Rev 1.0    2/21/2003 06:51:46 PM  JPMugaas
{ FTP Directory list output object for the FTP server.
}
unit IdFTPListOutput;

interface

uses IdFTPList, Classes, IdTStrings;

type
  //we can't use the standard FTP MLSD option types in the FTP Server
  //because we support some minimal things that the user can't set.
  //We have the manditory items to make it harder for the user to mess up.

  TIdFTPFactOutput = (ItemType,Modify,Size,Perm,Unique,UnixMODE,UnixOwner,UnixGroup,CreateTime,LastAccessTime);
  TIdFTPFactOutputs = set of TIdFTPFactOutput;
  TIdDirOutputFormat = (doUnix, doWin32, doEPLF);
  TIdFTPListOutputItem = class(TIdFTPListItem)
  protected
    FLinkCount: Integer;
    FGroupName: string;
    FOwnerName : String;
    FLinkedItemName : string;
    FNumberBlocks : Integer;
    FInode : Integer;
    FLastAccessDate: TDateTime;
    FLastAccessDateGMT: TDateTime;
    FCreationDate: TDateTime;
    FCreationDateGMT : TDateTime;
    //Unique ID for an item to prevent yourself from downloading something twice
    FUniqueID : String;
    //MLIST things
    FMLISTPermissions : String;

    FUnixGroupPermissions: string;
    FUnixOwnerPermissions: string;
    FUnixOtherPermissions: string;
    FUnixinode : Integer;
    //an error has been reported in the DIR listing itself for an item
    FDirError : Boolean;
  public
    property NumberBlocks : Integer read FNumberBlocks write FNumberBlocks;
    property Inode : Integer read FInode write FInode;
      //Last Access time values are for MLSD data output and can be returned by the
      //MLST command
    property LastAccessDate: TDateTime read FLastAccessDate write FLastAccessDate;
    property LastAccessDateGMT : TDateTime read FLastAccessDateGMT write FLastAccessDateGMT;

      //Creation time values are for MLSD data output and can be returned by the
      //MLST command
    property CreationDate: TDateTime read FCreationDate write FCreationDate;
    property CreationDateGMT : TDateTime read FCreationDateGMT write FCreationDateGMT;
    // If this is not blank, you can use this as a unique identifier for an item to prevent
    // yourself from downloading the same item twice (which is not easy to see with some
    // some FTP sites where symbolic links or similar things are used.
    //Valid only with EPLF and MLST
    property UniqueID : string read FUniqueID write FUniqueID;
    //Creation time values are for MLSD data output and can be returned by the
    //the MLSD parser in some cases
    property ModifiedDateGMT;
    //MLIST Permissions
    property MLISTPermissions : string read FMLISTPermissions write FMLISTPermissions;
    property UnixOwnerPermissions: string read FUnixOwnerPermissions write FUnixOwnerPermissions;
    property UnixGroupPermissions: string read FUnixGroupPermissions write FUnixGroupPermissions;
    property UnixOtherPermissions: string read FUnixOtherPermissions write FUnixOtherPermissions;
    property LinkCount: Integer read FLinkCount write FLinkCount;
    property OwnerName: string read FOwnerName write FOwnerName;
    property GroupName: string read FGroupName write FGroupName;
    property LinkedItemName : string read FLinkedItemName write FLinkedItemName;

    property DirError : Boolean read FDirError write FDirError;
  end;
  TIdFTPListOutput = class(TCollection)
  protected
    FSwitches : String;
    FOutput : String;
    FDirFormat : TIdDirOutputFormat;
    FExportTotalLine : Boolean;
    function GetLocalModTime(AItem : TIdFTPListOutputItem) : TDateTime; virtual;
    function UnixItem(AItem : TIdFTPListOutputItem) : String; virtual;
    function Win32Item(AItem : TIdFTPListOutputItem) : String; virtual;
    function EPLFItem(AItem : TIdFTPListOutputItem) : String; virtual;
    function NListItem(AItem : TIdFTPListOutputItem) : String; virtual;
    function MListItem(AItem : TIdFTPListOutputItem; AMLstOpts : TIdFTPFactOutputs) : String; virtual;
    procedure InternelOutputDir(AOutput : TIdStrings; ADetails : Boolean = true); virtual;
    function UnixINodeOutput(AItem : TIdFTPListOutputItem) : String;
    function UnixBlocksOutput(AItem : TIdFTPListOutputItem) : String;
    function UnixGetOutputOwner(AItem : TIdFTPListOutputItem) : String;
    function UnixGetOutputGroup(AItem : TIdFTPListOutputItem) : String;
    function UnixGetOutputOwnerPerms(AItem : TIdFTPListOutputItem) : String;
    function UnixGetOutputGroupPerms(AItem : TIdFTPListOutputItem) : String;
    function UnixGetOutputOtherPerms(AItem : TIdFTPListOutputItem) : String;

    function GetItems(AIndex: Integer): TIdFTPListOutputItem;
    procedure SetItems(AIndex: Integer; const AValue: TIdFTPListOutputItem);

  public
    function Add: TIdFTPListOutputItem;
    constructor Create; reintroduce;
    function IndexOf(AItem: TIdFTPListOutputItem): Integer;
    property Items[AIndex: Integer]: TIdFTPListOutputItem read GetItems write SetItems; default;

    procedure LISTOutputDir(AOutput : TIdStrings); virtual;
    procedure MLISTOutputDir(AOutput : TIdStrings; AMLstOpts : TIdFTPFactOutputs); virtual;
    procedure NLISTOutputDir(AOutput : TIdStrings); virtual;


    property DirFormat : TIdDirOutputFormat read FDirFormat write FDirFormat;
    property Switches : String read FSwitches write FSwitches;
    property Output : String read FOutput write FOutput;
    property ExportTotalLine : Boolean read FExportTotalLine write FExportTotalLine;
  end;

const
  DEF_FILE_OWN_PERM = 'rw-';                {do not localize}
  DEF_FILE_GRP_PERM = DEF_FILE_OWN_PERM;
  DEF_FILE_OTHER_PERM = 'r--';              {do not localize}
  DEF_DIR_OWN_PERM = 'rwx';                 {do not localize}
  DEF_DIR_GRP_PERM = DEF_DIR_OWN_PERM;
  DEF_DIR_OTHER_PERM = 'r-x';               {do not localize}
  DEF_OWNER = 'root';                       {do not localize}

{NLIST and LIST switches - based on /bin/ls }
{
  Note that the standard Unix form started simply by Unix
  FTP deamons piping output from the /bin/ls program for both
  the NLIST and LIST FTP commands.  The standard /bin/ls
  program has several standard switches that allow the output
  to be customized.  For our output, we wish to emulate this behavior.

  Microsoft IIS even honors a subset of these switches dealing sort order
  and recursive listings.   It does not honor some sort-by-switches although
  we honor those in Win32 (hey, we did MS one better, not that it says much though.

}
const
  {format switches - used by Unix mode only}
  SWITCH_COLS_ACCROSS = 'x';
  SWITCH_COLS_DOWN = 'C';
  SWITCH_ONE_COL = '1';
  SWITCH_ONE_DIR = 'f';
  SWITCH_COMMA_STREAM = 'm';
  SWITCH_LONG_FORM = 'l';
  {recursive for both Win32 and Unix forms}
  SWITCH_RECURSIVE = 'R';
  {sort switches - used both by Win32 and Unix forms}
  SWITCH_SORT_REVERSE = 'r';
  SWITCH_SORTBY_MTIME = 't';
  SWITCH_SORTBY_CTIME = 'u';
  SWITCH_SORTBY_EXT = 'X';
  SWITCH_SORTBY_SIZE = 'S';
  {Output switches for Unix mode only}
  SWITCH_CLASSIFY = 'F';
  //
{     -F  Put aslash (/) aftereach filename if the file is a directory, an
  asterisk (*) if the file is executable, an equal sign(=) if the
  file is an AF_UNIX address family socket, andan ampersand (@) if
  the file is asymbolic link.Unless the -H option isalso used,
  symbolic links are followed to see ifthey might be adirectory; see
  above.

  From:
  http://www.mcsr.olemiss.edu/cgi-bin/man-cgi?ls+1   }
  SWITCH_SLASHDIR = 'p';
  SWITCH_QUOTEDNAME = 'Q';
  SWITCH_PRINT_BLOCKS = 's';
  SWITCH_PRINT_INODE = 'i';
  SWITCH_SHOW_ALLPERIOD = 'a'; //show all entries even ones with a pariod starting the filename/hidden
  //note that anything starting with a period is shown except for the .. and . entries for security reasons
  SWITCH_HIDE_DIRPOINT = 'A'; //hide the "." and ".." entries
  SWITCH_BOTH_TIME_YEAR = 'T'; //This is used by FTP Voyager with a Serv-U FTP Server to both
  //a time and year in the FTP list.  Note that this does conflict with a ls -T flag used to specify a column size
  //on Linux but in FreeBSD, the -T flag is also honored.
implementation

uses
  IdContainers, IdGlobal, IdFTPCommon, IdGlobalProtocols, IdStrings, SysUtils;

type
  TDirEntry = class(TObject)
  protected
    FPathName : String;
    FDirListItem : TIdFTPListOutputItem;
    FSubDirs : TIdObjectList;
    FFileList : TIdBubbleSortStringList;

  public
    constructor Create(const APathName : String; ADirListItem : TIdFTPListOutputItem);
    destructor Destroy; override;
//    procedure Sort(ACompare: TIdSortCompare;const Recurse : Boolean = True);
    procedure SortAscendFName;
    procedure SortDescendFName;
    procedure SortAscendMTime;
    procedure SortDescendMTime;
    procedure SortAscendSize;
    procedure SortDescendSize;
    procedure SortAscendFNameExt;
    procedure SortDescendFNameExt;
    function AddSubDir(const APathName : String; ADirEnt : TIdFTPListOutputItem) : Boolean;
    function AddFileName(const APathName : String; ADirEnt : TIdFTPListOutputItem) : Boolean;
    property SubDirs : TIdObjectList read FSubDirs;
    property FileList : TIdBubbleSortStringList read FFileList;
    property PathName : String read FPathName;
    property DirListItem : TIdFTPListOutputItem read FDirListItem;
  end;

function RawSortAscFName(AItem1, AItem2: TObject; const ASubDirs : Boolean = True): Integer;
var LItem1, LItem2 : TIdFTPListItem;
{
> 0 (positive)	Item1 is less than Item2
   0	Item1 is equal to Item2
< 0 (negative)	Item1 is greater than Item2
}
  LTmpPath1, LTmpPath2 : String;
begin
    LItem1 := TIdFTPListItem(AItem1);
    LItem2 := TIdFTPListItem(AItem2);
    LTmpPath1 := IndyGetFileName( LItem1.FileName );
    LTmpPath2 := IndyGetFileName( LItem2.FileName );
    //periods are always greater then letters in dir lists
    if (Copy(LTmpPath1,1,1)='.') and (Copy(LTmpPath2,1,1)='.') then
    begin
      if (LTmpPath1=CUR_DIR) and (LTmpPath2=PARENT_DIR) then
      begin
        Result := 1;
        Exit;
      end;
      if (LTmpPath2=CUR_DIR) and (LTmpPath1=PARENT_DIR) then
      begin
        Result := -1;
        Exit;
      end;
      if (LTmpPath2=CUR_DIR) and (LTmpPath1=CUR_DIR) then
      begin
        Result := 0;
        Exit;
      end;
      if (LTmpPath2=PARENT_DIR) and (LTmpPath1=PARENT_DIR) then
      begin
        Result := 0;
        Exit;
      end;
    end;
    if (Copy(LTmpPath2,1,1)='.') and (Copy(LTmpPath1,1,1)<>'.') then
    begin
      Result := -1;
      Exit;
    end;
    if (Copy(LTmpPath1,1,1)='.') and (Copy(LTmpPath2,1,1)<>'.') then
    begin
      Result := 1;
      Exit;
    end;
    Result := -IndyCompareStr(LTmpPath1, LTmpPath2);
end;

function RawSortDescFName(AItem1, AItem2: TObject): Integer;
begin
  Result := -RawSortAscFName(AItem1,AItem2);
end;

function RawSortAscFNameExt(AItem1, AItem2: TObject; const ASubDirs : Boolean = True): Integer;
var LItem1, LItem2 : TIdFTPListItem;
{
> 0 (positive)	Item1 is less than Item2
   0	Item1 is equal to Item2
< 0 (negative)	Item1 is greater than Item2
}
  LTmpPath1, LTmpPath2 : String;
begin
  LItem1 := TIdFTPListItem(AItem1);
  LItem2 := TIdFTPListItem(AItem2);

  LTmpPath1 := ExtractFileExt(LItem1.FileName);
  LTmpPath2 := ExtractFileExt(LItem2.FileName);
  Result := -IndyCompareStr(LTmpPath1, LTmpPath2);
  if Result = 0 then
  begin
    Result := RawSortAscFName(AItem1,AItem2);
  end;

end;

function RawSortDescFNameExt(AItem1, AItem2: TObject): Integer;
begin
    Result := -RawSortAscFNameExt(AItem1,AItem2,False);
end;

function RawSortAscMTime(AItem1, AItem2: TObject): Integer;
var LItem1, LItem2 : TIdFTPListItem;
{
> 0 (positive)	Item1 is less than Item2
   0	Item1 is equal to Item2
< 0 (negative)	Item1 is greater than Item2
}

begin

  LItem1 := TIdFTPListItem(AItem1);
  LItem2 := TIdFTPListItem(AItem2);
  if LItem1.ModifiedDate < LItem2.ModifiedDate then
  begin
    Result := -1;
  end
  else
  begin
    if LItem1.ModifiedDate > LItem2.ModifiedDate then
    begin
      Result := 1;
    end
    else
    begin
      Result := 0;
    end;
  end;
  if Result=0 then
  begin
    Result := RawSortAscFName (AItem1, AItem2);
  end;
end;

function RawSortDescMTime(AItem1, AItem2: TObject): Integer;
begin
  Result := -RawSortAscMTime(AItem1,AItem2);
end;

function RawSortAscSize(AItem1, AItem2: TObject; const ASubDirs : Boolean = True): Integer;
var LItem1, LItem2 : TIdFTPListItem;
    LSize1, LSize2 : Int64;
{
> 0 (positive)	Item1 is less than Item2
   0	Item1 is equal to Item2
< 0 (negative)	Item1 is greater than Item2
}

begin
  LItem1 := TIdFTPListItem(AItem1);
  LItem2 := TIdFTPListItem(AItem2);
  LSize1 := LItem1.Size;
  LSize2 := LItem2.Size;
  if TIdFTPListOutput(LItem1.Collection).DirFormat = doUnix then
  begin
    if LItem1.ItemType = ditDirectory then
    begin
      LSize1 := UNIX_DIR_SIZE;
    end;
    if LItem2.ItemType = ditDirectory then
    begin
      LSize2 := UNIX_DIR_SIZE;
    end;
  end;
  if LSize1 < LSize2 then
  begin
    Result := -1;
  end
  else
  begin
    if LSize1 > LSize2 then
    begin
      Result := 1;
    end
    else
    begin