⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 idftplistparseunix.pas

📁 photo.163.com 相册下载器 多线程下载
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{ $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:  16166: IdFTPListParseUnix.pas
{
{   Rev 1.20    10/26/2004 9:56:00 PM  JPMugaas
{ Updated refs.
}
{
{   Rev 1.19    8/5/2004 11:18:16 AM  JPMugaas
{ Should fix a parsing problem I introeduced that caused errors with Unitree
{ servers.
}
{
{   Rev 1.18    8/4/2004 12:40:12 PM  JPMugaas
{ Fix for problem with total line.
}
{
{   Rev 1.17    7/15/2004 4:02:48 AM  JPMugaas
{ Fix for some FTP servers.  In a Unix listing, a : at the end of a filename
{ was wrongly being interpretted as a subdirectory entry in a recursive
{ listing.  
}
{
{   Rev 1.16    6/14/2004 12:05:54 AM  JPMugaas
{ Added support for the following Item types that appear in some Unix listings
{ (particularly a /dev or /tmp dir):
{ 
{ FIFO, Socket, Character Device, Block Device.
}
{
{   Rev 1.15    6/13/2004 10:44:06 PM  JPMugaas
{ Fixed a problem with some servers returning additional columns in the owner
{ and group feilds.  Note that they will not be parsed correctly in all cases. 
{ That's life.
{ 
{ drwx------  1          BUILTIN     NT AUTHORITY          0 Dec  7  2001
{ System Volume Information
}
{
{   Rev 1.14    4/20/2004 4:01:18 PM  JPMugaas
{ Fix for nasty typecasting error.  The wrong create was being called.
}
{
{   Rev 1.13    4/19/2004 5:05:20 PM  JPMugaas
{ Class rework Kudzu wanted.
}
{
{   Rev 1.12    2004.02.03 5:45:18 PM  czhower
{ Name changes
}
{
{   Rev 1.11    2004.01.23 9:53:32 PM  czhower
{ REmoved unneded check because of CharIsInSet functinoalty. Also was a short
{ circuit which is not permitted.
}
{
{   Rev 1.10    1/23/2004 12:49:52 PM  SPerry
{ fixed set problems
}
{
{   Rev 1.9    1/22/2004 8:29:02 AM  JPMugaas
{ Removed Ansi*.
}
{
{   Rev 1.8    1/22/2004 7:20:48 AM  JPMugaas
{ System.Delete changed to IdDelete so the code can work in NET.
}
{
    Rev 1.7    10/19/2003 3:48:10 PM  DSiders
  Added localization comments.
}
{
{   Rev 1.6    9/28/2003 03:02:30 AM  JPMugaas
{ Now can handle a few non-standard date types.
}
{
{   Rev 1.5    9/3/2003 07:34:40 PM  JPMugaas
{ Parsing for /bin/ls with devices now should work again.
}
{
{   Rev 1.4    4/7/2003 04:04:26 PM  JPMugaas
{ User can now descover what output a parser may give.
}
{
{   Rev 1.3    4/3/2003 03:37:36 AM  JPMugaas
{ Fixed a bug in the Unix parser causing it not to work properly with Unix BSD
{ servers using the -T switch.  Note that when a -T switch s used on a FreeBSD
{ server, the server outputs the millaseconds and an extra column giving the
{ year instead of either the year or time (the regular /bin/ls standard
{ behavior).
}
{
{   Rev 1.2    3/3/2003 07:17:58 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.1    2/19/2003 05:53:14 PM  JPMugaas
{ Minor restructures to remove duplicate code and save some work with some
{ formats.  The Unix parser had a bug that caused it to give a False positive
{ for Xercom MicroRTOS.
}
{
{   Rev 1.0    2/19/2003 02:02:02 AM  JPMugaas
{ Individual parsing objects for the new framework.
}
unit IdFTPListParseUnix;

interface

uses
  Classes,
  IdFTPList, IdFTPListParseBase, IdFTPListTypes, IdTStrings;

{
Notes:

- The Unitree and Unix parsers are closely tied together and share just
about all of the same code.  The reason is that Unitee is very similar to
a Unix dir list except it has an extra column which the Unix line parser
can handle in the Unitree type.

- The Unix parser can parse MACOS - Peters server (no relationship to this
author :-) ).

- It is worth noting that the parser does handle /bin/ls -s and -i switches as
well as -g and -o.  This is important sometimes as the Unix format comes
from FTP servers that simply piped output from the Unix /bin/ls command.

- This parser also handles recursive lists which is good for mirroring software.


}
type
{Note that for this, I am violating a convention.
The violation is that I am putting parsers for two separate servers
in the same unit.  The reason is this, Unitree has two additional columns (a file family
and a file migration status.  The line parsing code is the same because I thought it
was easier to do that way in this case.
}
  TIdUnixFTPListItem = class(TIdUnixBaseFTPListItem)
  protected
    FNumberBlocks : Integer;
    FInode : Integer;
  public
    property NumberBlocks : Integer read FNumberBlocks write FNumberBlocks;
    property Inode : Integer read FInode write FInode;
  end;
  TIdUnitreeFTPListItem = class(TIdUnixFTPListItem)
  protected
    FMigrated : Boolean;
    FFileFamily : String;
  public
    property Migrated : Boolean read FMigrated write FMigrated;
    property FileFamily : String read FFileFamily write FFileFamily;
  end;
  TIdFTPLPUnix = class(TIdFTPListBase)
  protected
    class function MakeNewItem(AOwner : TIdFTPListItems)  : TIdFTPListItem; override;
    class function InternelChkUnix(const AData : String) : Boolean; virtual;
    class function IsUnitree(AData:string): Boolean;  virtual;
    class function IsUnitreeBanner(const AData: String): Boolean; virtual;
    class function ParseLine(const AItem : TIdFTPListItem; const APath : String=''): Boolean; override;
  public
    class function GetIdent : String; override;
    class function CheckListing(AListing : TIdStrings; const ASysDescript : String =''; const ADetails : Boolean = True): boolean; override;
    class function ParseListing(AListing : TIdStrings; ADir : TIdFTPListItems) : boolean; override;
  end;
  TIdFTPLPUnitree = class(TIdFTPLPUnix)
  protected
    class function MakeNewItem(AOwner : TIdFTPListItems)  : TIdFTPListItem; override;
  public
    class function GetIdent : String; override;
  end;

const
  UNIX = 'Unix';  {do not localize}
  UNITREE = 'Unitree';  {do not localize}

implementation

uses
  IdGlobal, IdFTPCommon, IdGlobalProtocols,
  SysUtils;

{ TIdFTPLPUnix }

class function TIdFTPLPUnix.CheckListing(AListing: TIdStrings;
  const ASysDescript: String; const ADetails: Boolean): boolean;
var
  i : Integer;
begin
  Result := False;
  for i := 0 to AListing.Count - 1 do
  begin
    if (AListing[i]<>'') then
    begin
      //workaround for the XBox MediaCenter FTP Server
      //which returns something like this:
      //
      //dr-xr-xr-x    1 ftp      ftp            1 Feb 23 00:00 D:
      //and the trailing : is falsely assuming that a ":" means
      //a subdirectory entry in a recursive list.
      if InternelChkUnix(AListing[i]) then
      begin
        if GetIdent= UNITREE then
        begin
          Result := IsUnitree(AListing[i]);
        end
        else
        begin
          Result := not IsUnitree(AListing[i]);
        end;
        Break;
      end;
      if IsTotalLine(AListing[i]) or
        IsSubDirContentsBanner(AListing[i]) then
      begin
        Continue;
      end
      else
      begin
        break;
      end;
    end;
  end;
end;

class function TIdFTPLPUnix.GetIdent: String;
begin
  Result := UNIX;
end;

class function TIdFTPLPUnix.InternelChkUnix(const AData: String): Boolean;
  var s : TIdStrings;
      LCData : String;
  begin
      //pos 1 values
    // d - dir
    // - - file
    // l - symbolic link
    // b - block device
    // c - charactor device
    // p - pipe (FIFO)
    // s - socket
    LCData := UpperCase(AData);
    Result := IsValidUnixPerms(AData);
    if Result then
    begin
      //Do NOT attempt to do Novell Netware Print Services for Unix FTPD in NFS
      //namespace if we have a block device.
      if CharIsInSet(LCData, 1, ['C','B']) then
      begin
        Exit;
      end;
      //This extra complexity is required to distinguish Unix from
      //a Novell Netware server in NFS namespace which is somewhat similar
      //to a Unix listing.  Beware.
      s := TIdStringList.Create;
      try
        SplitColumns(LCData,s);
        if (s.Count > 9) then
        begin
          Result :=  (s[9] <> 'AM') and (s[9] <> 'PM'); {do not localize}
          if Result then
          begin
            //we test the month with a copy because Netware Print Services may return a 4 char month such as Sept
            Result := ((IndyPos(':', s[8]) = 0) and (StrToMonth(Copy(s[6], 1, 3)) > 0)) = False;
          end;
        end;
      finally
        FreeAndNil(s);
      end;
    end
    else
    begin
      //we make an additional check for two additional rows before the
      //the permissions.  These are the inode and block count for the item.
      //These are specified with the -i and -s parameters.
      s := TIdStringList.Create;
      try
        SplitColumns(LCData,s);
        if s.Count > 3 then
        begin
          if IsNumeric(s[0]) then
          begin
            Result :=  IsValidUnixPerms(S[1]);
            if Result=False then
            begin
              Result := IsNumeric(s[1]) and IsValidUnixPerms(S[2]);
            end;
          end;
        end;
      finally
        FreeAndNil(s);
      end;
    end;
end;

class function TIdFTPLPUnix.IsUnitree(AData: string): Boolean;
var s : TIdStrings;
  begin
    s := TIdStringList.Create;
    try
      SplitColumns(AData,s);
      Result := (s.Count >4) and (PosInStrArray(s[4],UnitreeStoreTypes)<>-1);
      if Result=False then
      begin
        Result := IsUnitreeBanner(AData);
      end;
    finally
      FreeAndNil(s);
    end;
end;

class function TIdFTPLPUnix.IsUnitreeBanner(const AData: String): Boolean;
begin
  Result := (IndyPos('/',AData)=1) and (Copy(AData,Length(AData)-1,2)=').')
    and (IndyPos('(',AData)>0);
end;

class function TIdFTPLPUnix.MakeNewItem(
  AOwner: TIdFTPListItems): TIdFTPListItem;
begin
  Result := TIdUnixFTPListItem.Create(AOwner);
end;

class function TIdFTPLPUnix.ParseLine(const AItem: TIdFTPListItem;
  const APath: String): Boolean;
{Note that we also use this parser for Unitree FTP Servers because that server
is like Unix except that in Unitree, there's two additional columns before the size.

Those are:

Storage Type - AR - archived or migrated to tape and DK
File family -
}
type
  TParseUnixSteps = (pusinode, pusBlocks, pusPerm,pusCount,pusOwner,pusGroup,pusSize,pusMonth,pusDay,pusYear,pusTime,pusName,pusDone);
var
  LStep: TParseUnixSteps;
  LData, LTmp: String;
  LInode, LBlocks, LDir, LGPerm, LOPerm, LUPerm, LCount, LOwner, LGroup: String;
  LName, LSize, LLinkTo: String;
  wYear, wMonth, wDay: Word;
 // wYear, LCurrentMonth, wMonth, wDay: Word;
  wHour, wMin, wSec, wMSec: Word;
  ADate: TDateTime;
  i: Integer;
  LI : TIdUnixFTPListItem;

  function IsGOSwitches(const AString : String) : Boolean;
  var s : TIdStrings;
  //check to see if both the -g and -o switches were used.  Both
  //owner and group are surpressed in that case.  We have to check that
  //so our interpretation does not cause an error.
  begin
    Result := False;
    s := TIdStringList.Create;
    try
      SplitColumns(AString,s);
      if s.Count >2 then
      begin
        //if either inode or block count were given
        if  IsNumeric(s[0]) then
        begin
          s.Delete(0);
        end;
        //if both inode and block count were given
        if  IsNumeric(s[0]) then
        begin
          s.Delete(0);
        end;
        if s.Count > 5 then
        begin
          if StrToMonth(s[3])>0 then
          begin
            Result := IsNumeric(s[4]) and
              (IsNumeric(s[5]) or (IndyPos(':',s[5])>0));
          end;
        end;
      end;
    finally
      FreeAndNil(s);
    end;
  end;

  function FixBonkedYear(const AStrPart : String) : String;
  var LB : String;
  begin
    LB := AStrPart;
    Result := Fetch(LB);
    Result := StringReplace(Result,'-',' ',[rfReplaceAll]);
    Result := StringReplace(Result,'/',' ',[rfReplaceAll]);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -