idftplist.pas

delphi indy9.0.18组件包

{ $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:  10165: IdFTPList.pas 
{
{   Rev 1.6    2/9/2003 03:04:56 PM  JPMugaas
{ Fix for FTP Unix listings.  The time was given for a date in the current
{ year.  The proper behavior is to give the time only if the date is within 6
{ monthes of the current date.
}
{
{   Rev 1.5    1/20/2003 03:18:08 PM  JPMugaas
{ Backported fix for working with a "Axis NPS 53X FTP Printer Server V4.26".
}
{
{   Rev 1.4    1/20/2003 12:42:20 PM  JPMugaas
{ Backported workaround for Distinct FTP Server.  That does not return valid
{ Unix permissions when emulating Unix.
{ Backported patch for Unix.  If a charactor device is in a dir, it is not
{ parsed correctly.  It could not detect Unix directory format if the list
{ started with a charactor device.
}
{
{   Rev 1.3    1/8/2003 07:25:52 AM  JPMugaas
{ Backported a patch to the MS -DOS parser.  A recent patch was not handling
{ 12:00 AM properly causing it to return 12:00PM.
}
{
{   Rev 1.2    12/30/2002 9:18:16 AM  JPMugaas
{ Patch from Andrew P. Rybin for where the count column and the file size
{ column are rammed together.
}
{
{   Rev 1.1    12/12/2002 03:16:06 PM  JPMugaas
{ Backported updated MS-DOS parser from Indy 10.   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.0    2002.11.12 10:39:00 PM  czhower
}
unit IdFTPList;

{
 - 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

  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, SysUtils, IdException, IdGlobal;

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

type
  EIdInvalidFTPListingFormat = class(EIdException);

  // TFTPListFormat directory listing format.  flfNone, flfUnknown, flfCustom are not parsed
  TIdFTPListFormat = (flfNone, flfDos, flfUnix, flfVax, flfNoDetails, flfUnknown, flfCustom);
  TIdDirItemType = (ditDirectory, ditFile, ditSymbolicLink);

  TIdFTPListItems = class;

  // TIdFTPListItem stores an item in the FTP directory listing
  TIdFTPListItem = class(TCollectionItem)
  protected
    FSize: Int64;
    FItemCount: Integer;
    FData: string;
    FFileName: string;
    FGroupPermissions: string;
    FGroupName: string;
    FOwnerPermissions: string;
    FOwnerName: string;
    FUserPermissions: string;
    FModifiedDate: TDateTime;
    FLinkedItemName : string;
    FItemType: TIdDirItemType;
    //
    function DoGetCustomListFormat: string;
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create(AOwner: TCollection); override;
    function Text: string;
    //
    property Data: string read FData write FData;
    property OwnerPermissions: string read FOwnerPermissions write FOwnerPermissions;
    property GroupPermissions: string read FGroupPermissions write FGroupPermissions;
    property UserPermissions: string read FUserPermissions write FUserPermissions;
    property ItemCount: Integer read FItemCount write FItemCount;
    property OwnerName: string read FOwnerName write FOwnerName;
    property GroupName: string read FGroupName write FGroupName;
    property Size: Int64 read FSize write FSize;
    property ModifiedDate: TDateTime read FModifiedDate write FModifiedDate;
    property FileName: string read FFileName write FFileName;
    property ItemType: TIdDirItemType read FItemType write FItemType;
    property LinkedItemName: string read FLinkedItemName write FLinkedItemName;
  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);
  protected
    FOnGetCustomListFormat: TIdOnGetCustomListFormat;
    FOnParseCustomListFormat: TIdOnParseCustomListFormat;
    FListFormat: TIdFTPListFormat;
    //
    function GetItems(AIndex: Integer): TIdFTPListItem;
    procedure ParseDOS(AItem: TIdFTPListItem);
    procedure ParseUnix(AItem: TIdFTPListItem); //APR
    procedure ParseVax(AItem: TIdFTPListItem);
    procedure SetItems(AIndex: Integer; const Value: TIdFTPListItem);
  public
    function Add: TIdFTPListItem;
    function CheckListFormat(Data: string; const ADetails: Boolean = False): TIdFTPListFormat; virtual;
    constructor Create; overload;
    function IndexOf(AItem: TIdFTPListItem): Integer;
    procedure LoadList(AData: TStrings);
    procedure Parse(ListFormat: TIdFTPListFormat; AItem: TIdFTPListItem);
    procedure ParseUnknown(AItem: TIdFTPListItem);
    procedure ParseCustom(AItem: TIdFTPListItem); virtual;
    //
    property DirectoryName: string read FDirectoryName write SetDirectoryName;
    property Items[AIndex: Integer]: TIdFTPListItem read GetItems write SetItems; default;
    property ListFormat: TIdFTPListFormat read FListFormat write FListFormat;
    property OnGetCustomListFormat: TIdOnGetCustomListFormat read FOnGetCustomListFormat
     write FOnGetCustomListFormat;
    property OnParseCustomListFormat: TIdOnParseCustomListFormat read FOnParseCustomListFormat
     write FOnParseCustomListFormat;
  end;

implementation
Uses IdResourceStrings, IdStrings;

{ TFTPListItem }

constructor TIdFTPListItem.Create(AOwner: TCollection);
begin
  inherited Create(AOwner);
  Data := '';    {Do not Localize}
  FItemType := ditFile;
  OwnerPermissions := '???';    {Do not Localize}
  GroupPermissions := '???';    {Do not Localize}
  UserPermissions := '???';    {Do not Localize}
  ItemCount := 0;
  OwnerName := '????????';    {Do not Localize}
  GroupName := '????????';    {Do not Localize}
  Size := 0;
  ModifiedDate := 0.0;
  FileName := '';    {Do not Localize}
  LinkedItemName := '';    {Do not Localize}
end;

procedure TIdFTPListItem.Assign(Source: TPersistent);
Var
  Item: TIdFTPListItem;
begin
  Item := TIdFTPListItem(Source);
  Data := Item.Data;
  ItemType := Item.ItemType;
  OwnerPermissions := Item.OwnerPermissions;
  GroupPermissions := Item.GroupPermissions;
  UserPermissions := Item.UserPermissions;
  ItemCount := Item.ItemCount;
  OwnerName := Item.OwnerName;
  GroupName := Item.GroupName;
  Size := Item.Size;
  ModifiedDate := Item.ModifiedDate;
  FileName := Item.FileName;
  LinkedItemName := Item.LinkedItemName;
end;

{ TFTPList }

constructor TIdFTPListItems.Create;
begin
  inherited Create(TIdFTPListItem);
  ListFormat := flfUnix;
end;

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

procedure TIdFTPListItems.LoadList(AData: TStrings);
var
  iCtr: Integer;
  LStartLine: Integer;
  AItem: TIdFTPListItem;
begin
  Clear;
  // Some Unix ftp servers retunr 'total' in the first line of the directory listing    {Do not Localize}
  if (FListFormat = flfUnix) and (AData.Count > 0) and
    (IndyPos('TOTAL', UpperCase(AData.Strings[0])) = 1) then begin    {Do not Localize}
    LStartLine := 1;
  end
  else begin
    LStartLine := 0;
  end;
  for iCtr := LStartLine to AData.Count - 1 do begin
    if NOT IsWhiteString(AData.Strings[iCtr]) then begin
      AItem := Add;
      AItem.Data := AData.Strings[iCtr];
      try
        if (ListFormat <> flfNone) then begin
          Parse(ListFormat, AItem);
        end;
      except
        {on E: Exception do
          raise EIdException.Create('Please report this exception into Indy Bug list.' + #13 +
            E.Message + #13 + AItem.Data);}
         // When We don't know the exact listing type we will just ignore it and nothing will happen    
         Clear;
      end;
    end;
  end;//for
end;

function TIdFTPListItems.CheckListFormat(Data: string; const ADetails: Boolean = false): TIdFTPListFormat;
  function IsUnixItem(SData: string): Boolean;
  begin
    //pos 1 values
    // d - dir
    // - - file
    // l - symbolic link
    // b - block device
    // c - charactor device
    // p - pipe (FIFO)
    // s - socket
    result := (SData[1] in ['L','D', '-','B','C','P','S']) and {Do not Localize}
    (SData[2] in ['T','S','R','W','X','-']) and    {Do not Localize}
    {Distinct TCP/IP FTP Server-32 3.0 errs by reporting an 'A" here }
    (SData[3] in ['T','S','R','W','X','-','A']) and    {Do not Localize}
    (SData[4] in ['T','S','R','W','X','-']) and    {Do not Localize}
    {Distinct TCP/IP FTP Server-32 3.0 errs by reporting an 'H" here for hidden files}
    (SData[5] in ['T','S','R','W','X','-','H']) and    {Do not Localize}
    (SData[6] in ['T','S','R','W','X','-']) and    {Do not Localize}
    {Distinct's FTP Server Active X may report a "Y" by mistake, saw in manual
    FTP Server, ActiveX Control, File Transfer Protocol (RFC 959), ActiveX Control,
    for Microsoft