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

📄 idftplistparsempeix.pas

📁 photo.163.com 相册下载器 多线程下载
💻 PAS
字号:
{ $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:  16207: IdFTPListParseMPEiX.pas
{
{   Rev 1.5    10/26/2004 9:46:34 PM  JPMugaas
{ Updated refs.
}
{
{   Rev 1.4    4/19/2004 5:05:48 PM  JPMugaas
{ Class rework Kudzu wanted.
}
{
{   Rev 1.3    2004.02.03 5:45:28 PM  czhower
{ Name changes
}
{
    Rev 1.2    10/19/2003 2:27:22 PM  DSiders
  Added localization comments.
}
{
{   Rev 1.1    4/7/2003 04:03:52 PM  JPMugaas
{ User can now descover what output a parser may give.
}
{
{   Rev 1.0    2/19/2003 05:51:24 PM  JPMugaas
{ Parsers ported from old framework.
}
unit IdFTPListParseMPEiX;

interface
uses classes, IdFTPList, IdFTPListParseBase, IdFTPListTypes, IdTStrings;
type
  TIdMPiXFTPListItem = class(TIdRecFTPListItem)
  protected
    FLimit : Cardinal;
  public
    constructor Create(AOwner: TCollection); override;
    property RecLength;
    property RecFormat;
    property NumberRecs;
    property Limit : Cardinal read FLimit write FLimit;
  end;
  //Anscestor for the MPE/iX Parsers
  //This is necessary because they both have a second line a function parses
  //Do not register this one
  TIdFTPLPMPiXBase = class(TIdFTPListBaseHeader)
  protected
    class function MakeNewItem(AOwner : TIdFTPListItems)  : TIdFTPListItem; override;
    class function IsSecondHeader(ACols: TIdStrings): Boolean; virtual;
  public
    class function GetIdent : String; override;
  end;
  TIdFTPLPMPiX = class(TIdFTPLPMPiXBase)
  protected
    class function ParseLine(const AItem : TIdFTPListItem; const APath : String=''): Boolean; override;
    class function IsHeader(const AData: String): Boolean;  override;
  public
    class function GetIdent : String; override;
  end;
  TIdFTPLPMPiXWithPOSIX = class(TIdFTPLPMPiXBase)
  protected
    class function ParseLine(const AItem : TIdFTPListItem; const APath : String=''): Boolean; override;
    class function IsHeader(const AData: String): Boolean;  override;
  public
    class function GetIdent : String; override;
  end;

implementation

uses
  IdGlobal, IdFTPCommon, IdGlobalProtocols, IdStrings, SysUtils;

{ TIdFTPLPMPiXBase }

class function TIdFTPLPMPiXBase.GetIdent: String;
begin
  Result := 'MPE/iX:  ';  {do not localize}
end;

class function TIdFTPLPMPiXBase.IsSecondHeader(
  ACols: TIdStrings): Boolean;
begin
  Result := (ACols.Count > 3) and
            (ACols[0] = 'SIZE') and     {do not localize}
            (ACols[1] = 'TYP') and      {do not localize}
            (ACols[2] = 'EOF') and      {do not localize}
            (ACols[3] = 'LIMIT');       {do not localize}
  if Result and (ACols.Count =8) then
  begin
    Result := (ACols[4] = 'R/B') and    {do not localize}
            (ACols[5] = 'SECTORS') and  {do not localize}
            (ACols[6] = '#X') and       {do not localize}
            (ACols[7] = 'MX')           {do not localize}
  end;
  {
This is for a Not Found banner such as:

"@ not found"
"./@ not found"

  }
  if (Result = False) and (ACols.Count = 3) then
  begin
    Result := (IndyPos('@', ACols[0])>0) and
              (ACols[1] = 'not') and    {do not localize}
              (ACols[2] = 'found');     {do not localize}
  end;
end;

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

{ TIdFTPLPMPiX }

class function TIdFTPLPMPiX.GetIdent: String;
begin
  Result := inherited GetIdent + 'LISTF'; {do not localize}
end;

class function TIdFTPLPMPiX.IsHeader(const AData: String): Boolean;
var LCols : TIdStrings;
    LAccP, LGrpP : Integer;
begin
  LAccP := IndyPos('ACCOUNT=', AData);  {do not localize}
  if (LAccP = 0) then
  begin
    LAccP := IndyPos('ACCOUNT =', AData); {do not localize}
  end;
  LGrpP := IndyPos('GROUP=', AData);  {do not localize}
  if (LGrpP = 0) then
  begin
    LGrpP := IndyPos('GROUP =', AData); {do not localize}
  end;
  Result := (LAccP > 0) and (LGrpP > LAccP);
  if Result = False then
  begin
    LCols := TIdStringList.Create;
    try
      SplitColumns(Trim(StringReplace(AData,'-',' ',[rfReplaceAll])),LCols);
      if Result = False then
      begin
        Result := (LCols.Count > 3) and
                  (LCols[0] = 'FILENAME') and   {do not localize}
                  (LCols[1] = 'CODE') and       {do not localize}
                  (LCols[2] = 'LOGICAL') and    {do not localize}
                  (LCols[3] = 'RECORD');        {do not localize}
        if Result and (LCols.Count = 5) then
        begin
          Result := (LCols[4] = 'SPACE');       {do not localize}
        end;
      end;
      if (Result = False) then
      begin
        Result := IsSecondHeader(LCols);
      end;
    finally
      FreeAndNil(LCols);
    end;
  end;
end;

class function TIdFTPLPMPiX.ParseLine(const AItem: TIdFTPListItem;
  const APath: String): Boolean;
var
  LCols : TIdStrings;
  LBuf : String;
  LI : TIdMPiXFTPListItem;
begin
  LI := AItem as TIdMPiXFTPListItem;
  LCols := TIdStringList.Create;
  try
    //According to "HP ARPA File Transfer Protocol, User抯 Guide, HP 3000 MPE/iX Computer Systems,Edition 6"
    //the filename here can be 8 chars long
    LI.FileName := Trim(Copy(AItem.Data, 1, 8));
    LBuf := Copy(AItem.Data, 8, Length(AItem.Data));
    if (Length(LBuf) > 0) and (LBuf[1] <> ' ') then
    begin
      Fetch(LBuf);
    end;
    SplitColumns(Trim(LBuf),LCols);

    if LCols.Count > 1 then
    begin
      LI.Size := ExtractNumber(LCols[1]);
    end;
    //Type
    if LCols.Count > 2 then
    begin
      LI.RecFormat := LCols[2];
    end;
    //record COunt - EOF
    if LCols.Count > 3 then
    begin
      LI.NumberRecs := StrToIntDef(LCols[3], 0);
    end;
    //Limit
    if LCols.Count > 4 then
    begin
      LI.Limit := StrToIntDef(LCols[4], 0);
    end;
    {
    HP3000 is a flat file system where there are no
    subdirs.  There is a file group created by the user
    but that is mroe logical than anything.  There might
    be a command for obtaining file groups but I have not
    seen one.  Note that file groups can not obtain other groups.
    }
    LI.ItemType := ditFile;
    {
    Note that HP3000 does not give you the date at all.
    }
    LI.ModifiedAvail := False;
  finally
    FreeAndNil(LCols);
  end;
  Result := True;
end;

{ TIdFTPLPMPiXWithPOSIX }

class function TIdFTPLPMPiXWithPOSIX.GetIdent: String;
begin
  Result := inherited GetIdent + 'With POSIX';  {do not localize}
end;

class function TIdFTPLPMPiXWithPOSIX.IsHeader(
  const AData: String): Boolean;
{
Often is something like this (spacing may very):
==

 PATH= /PH/SAPHP/

 CODE  ------------LOGICAL RECORD-----------  ----SPACE----  FILENAME
         SIZE  TYP        EOF      LIMIT R/B  SECTORS #X MX

==
or maybe this:
===
ACCOUNT=  SYS         GROUP=  WORK
FILENAME  CODE  ------------LOGICAL RECORD-----------  ----SPACE----
===
}
var LCols : TIdStrings;
begin
  Result := (IndyPos('PATH=', AData) > 0);  {do not localize}
  if Result = False then
  begin
    LCols := TIdStringList.Create;
    try
      SplitColumns(Trim(StringReplace(AData,'-',' ',[rfReplaceAll])),LCols);
      Result := (LCols.Count = 5) and
                (LCols[0] = 'CODE') and       {do not localize}
                (LCols[1] = 'LOGICAL') and    {do not localize}
                (LCols[2] = 'RECORD') and     {do not localize}
                (LCols[3] = 'SPACE') and      {do not localize}
                (LCols[4] = 'FILENAME');      {do not localize}
      if (Result = False) then
      begin
        Result := IsSecondHeader(LCols);
      end;
    finally
      FreeAndNil(LCols);
    end;
  end;
end;

class function TIdFTPLPMPiXWithPOSIX.ParseLine(const AItem: TIdFTPListItem;
  const APath: String): Boolean;
var
  LCols : TIdStrings;
  LI : TIdMPiXFTPListItem;
begin
  LI := AItem as TIdMPiXFTPListItem;
  LCols := TIdStringList.Create;
  try
    SplitColumns(Trim(AItem.Data),LCols);
    if LCols.Count > 0 then
    begin
      LI.Size := ExtractNumber(LCols[0]);
    end;
    if (LCols.Count > 1) then
    begin
      LI.RecFormat := LCols[1];
    end;
    if (LCols.Count > 2) then
    begin
      LI.NumberRecs := StrToIntDef(LCols[2],0);
    end;
    if (LCols.Count > 3) then
    begin
      LI.Limit := StrToIntDef(LCols[3],0);
    end;
    if (LCols.Count > 8) then
    begin
      LI.FileName := LCols[8];
    end;
    {
    The original HP3000 is a flat file system where there are no
    subdirs.  There is a file group created by the user
    but that is mroe logical than anything.  There might
    be a command for obtaining file groups but I have not
    seen one.  Note that file groups can not obtain other groups.

    More recent versions of HP3000 have Posix support including a
    hierarchical file system.  Verified with test at:

    jazz.external.hp.com
    }
    if (LI.FileName <> '') and (LI.FileName[Length(AItem.FileName)] = '/') then
    begin
      LI.ItemType := ditDirectory;
      LI.FileName := Copy(AItem.FileName, 1, Length(AItem.FileName) - 1);
    end
    else
    begin
      LI.ItemType := ditFile;
    end;
    {
    Note that HP3000 does not give you the date at all.
    }
  finally
    FreeAndNil(LCols);
  end;
  Result := True;
end;

{ TIdMPiXFTPListItem }

constructor TIdMPiXFTPListItem.Create(AOwner: TCollection);
begin
  inherited;
  //MP/iX or HP3000 will not give you a modified date at all
  ModifiedAvail := False;
end;

initialization
  RegisterFTPListParser(TIdFTPLPMPiX);
  RegisterFTPListParser(TIdFTPLPMPiXWithPOSIX);
finalization
  UnRegisterFTPListParser(TIdFTPLPMPiX);
  UnRegisterFTPListParser(TIdFTPLPMPiXWithPOSIX);
end.

⌨️ 快捷键说明

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