idftplistparseas400.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:  16174: IdFTPListParseAS400.pas
{
{   Rev 1.5    10/26/2004 9:36:26 PM  JPMugaas
{ Updated ref.
}
{
{   Rev 1.4    4/19/2004 5:05:28 PM  JPMugaas
{ Class rework Kudzu wanted.
}
{
{   Rev 1.3    2004.02.03 5:45:22 PM  czhower
{ Name changes
}
{
    Rev 1.2    10/19/2003 2:08:48 PM  DSiders
  Added localization comments.
}
{
{   Rev 1.1    4/7/2003 04:03:02 PM  JPMugaas
{ User can now descover what output a parser may give.
}
{
{   Rev 1.0    2/19/2003 04:18:10 AM  JPMugaas
{ More things restructured for the new list framework.
}
unit IdFTPListParseAS400;

interface
uses Classes, IdFTPList, IdFTPListParseBase, IdFTPListTypes, IdTStrings;

type
  TIdAS400FTPListItem = class(TIdOwnerFTPListItem);
  TIdFTPLPAS400 = class(TIdFTPLineOwnedList)
  protected
    class function MakeNewItem(AOwner : TIdFTPListItems)  : TIdFTPListItem; override;
    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;
  end;

implementation

uses
  IdGlobal, IdFTPCommon,  IdGlobalProtocols, SysUtils;

{ TIdFTPLPAS400 }

class function TIdFTPLPAS400.CheckListing(AListing: TIdStrings;
  const ASysDescript: String; const ADetails: Boolean): boolean;
var s : TIdStrings;
begin
  Result := False;
  if AListing.Count > 0 then
  begin
    s := TIdStringList.Create;
    try
      SplitColumns(AListing[0],s);
      if s.Count > 4 then
      begin
        Result := (s[4][1]='*') or (s[4]='DIR');  {Do not translate}
      end;
    finally
      FreeAndNil(s);
    end;
  end;
end;

class function TIdFTPLPAS400.GetIdent: String;
begin
  Result := 'AS400';  {do not localize}
end;

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

class function TIdFTPLPAS400.ParseLine(const AItem: TIdFTPListItem;
  const APath: String): Boolean;
var LBuffer : String;
    LDate : String;
    LTime : String;
    LObjType : String;
   LI : TIdOwnerFTPListItem;
begin
{  From:
http://groups.google.com/groups?q=AS400+LISTFMT+%3D+0&hl=en&lr=&ie=UTF-8&oe=utf-8&selm=9onmpt%24dhe%2402%241%40news.t-online.com&rnum=1

  ftp> dir qtemp/timestamp
  200 PORT subcommand request successful.
  125 List started.
  drwx---rwx 1 QPGMR 0 20480 Sep 24 18:16 TIMESTAMP
  -rwx---rwx 1 QPGMR 0     0 Sep 24 18:16 TIMESTAMP.TIMESTAMP
  250 List completed.
  FTP: 140 Bytes empfangen in 0.06Sekunden 2.33KB/s

  or

  ftp> dir qtemp/timestamp
  200 PORT subcommand request successful.
  125 List started.

         1         2         3         4         5
  123456789012345678901234567890123456789012345678901234567890
  QPGMR 20480 24.09.01 18:16:20 *FILE QTEMP/TIMESTAMP
  QPGMR                         *MEM  QTEMP/TIMESTAMP.TIMESTAMP
  250 List completed.
  FTP: 146 Bytes empfangen in 0.00Sekunden 146000.00KB/s

It depends qether the SITE param LISTFMT is set to "1" (1st example, *nix-
like) or "0" (2nd example, OS/400-like). I have choosen the 2nd format (I
think it's easier to parse). To get it, submit "QUOTE SITE LISTFMT 0" just
before submitting the DIR command.

From IBM Manual at:
http://publib.boulder.ibm.com/iseries/v5r2/ic2924/index.htm

Here is the original iSeries style format for the LIST subcommand
(when LISTFMT=0):

owner size date time type name
A blank space separates each field.

This is a description of each field:

owner
The 10 character string that represents the user profile which owns the subject.
This string is left justified, and includes blanks. This field is blank for
anonymous FTP sessions.

size
The 10 character number that represents the size of the object. This number is
right justified, and it includes blanks. This field is blank when an object has
no size associated with it.

date
The 8 character modification date in the format that is defined for the server
job. It uses date separators that are defined for the server job. This
modification date is left justified, and it includes blanks.

time
The 8 character modification time that uses the time separator, which the
server job defines.

type
The 10 character OS/400 object type.

name
The variable length name of the object that follows a CRLF (carriage return,
line feed pair). This name may include blanks.

Here is an example of the original iSeries style format:

         1         2         3         4         5
123456789012345678901234567890123456789012345678901234567890
BAILEYSE     5263360 06/11/97 12:27:39 *FILE     BPTFSAVF

Note on name format from (
http://groups.google.com/groups?q=AS400+FTP+LIST+format&hl=
en&lr=&ie=UTF-8&oe=utf-8&selm=3264740F.B52%40mother.com&rnum=4):

Starting in v3r1 you can access the shared folders area or libraries with FTP by using the
"NAMEFMT 1" command. For example:

SYST
215  OS/400 is the remote operating system. The TCP/IP version is "V3R1M0".
SITE NAMEFMT 1
250  Now using naming format "1".
LIST /QDLS

/QDLS/ARM          0 11/09/95 07:19:30 DIR
/QDLS/ARM-VOL1     0 06/23/95 16:39:43 DIR
/QDLS/ARMM         0 08/04/95 14:32:03 DIR

or

SYST
215  OS/400 is the remote operating system. The TCP/IP version is "V3R1M0".
SITE NAMEFMT 1
250  Now using naming format "1".
LIST /QSYS.LIB

QSYS      3584  11/15/95 16:15:33 *FILE    /QSYS.LIB/QSYS.LIB/QPRTRPYL.PRTF
QSYS      18432 11/15/95 16:15:33 *FILE      /QSYS.LIB/QSYS.LIB/QPRTSBSD.PRTF
QSYS      5632  11/15/95 16:15:33 *FILE      /QSYS.LIB/QSYS.LIB/QPRTSPLF.PRTF
QSYS      8704  11/15/95 16:15:33 *FILE      /QSYS.LIB/QSYS.LIB/QPRTSPLQ.PRTF

}
  LI := AItem as TIdOwnerFTPListItem;
  LBuffer := AItem.Data;
  LI.OwnerName := Fetch(LBuffer);

  LBuffer := TrimLeft(LBuffer);
  //we have to make sure that the size feild really exists or the
  //the parser is thrown off
  if (LBuffer<>'') and (IsNumeric(LBuffer[1])) then
  begin
    LI.Size := StrToIntDef(FetchLength(LBuffer,9),0);

    LBuffer := TrimLeft(LBuffer);
  end;
  //Sometimes the date and time feilds will not present
  if (LBuffer<>'') and (IsNumeric(LBuffer[1])) then
  begin
    LDate := Trim(StrPart(LBuffer,8));
    if (LBuffer <> '') and (LBuffer[1]<>' ') then
    begin
      LDate := LDate + Fetch(LBuffer);
    end;
    if LDate <> '' then
    begin
      LI.ModifiedDate := AS400Date(LDate);
    end;
    LTime := Trim(StrPart(LBuffer,8));
    if (LBuffer <> '') and (LBuffer[1]<>' ') then
    begin
      LTime := LTime + Fetch(LBuffer);
    end;
    if LTime <> '' then
    begin
      LI.ModifiedDate :=  LI.ModifiedDate + TimeHHMMSS(LTime);
    end;
  end;
  //most of this data is manditory so things are less sensitive to positions
  LBuffer := Trim(LBuffer);
  LObjType := FetchLength(LBuffer,11);
  //A file object is something like a file but it can contain members - treat as dir.
  //  Odd, I know.
  //There are also several types of file objects
  if (Copy(UpperCase(LObjType),1,5)) = '*FILE' then {do not localize}
  begin
    LI.ItemType := ditDirectory;
  end;
  if LObjType = 'DIR' then  {do not localize}
  begin
    LI.ItemType := ditDirectory;
  end;
  LI.FileName := TrimLeft(LBuffer);
  if LI.FileName = '' then
  begin
    LI.FileName := LI.OwnerName;
    LI.OwnerName := '';
  end;
  LI.LocalFileName := LowerCase(StripPath(AItem.FileName, '/'));
  Result := True;
end;

initialization
  RegisterFTPListParser(TIdFTPLPAS400);
finalization
  UnRegisterFTPListParser(TIdFTPLPAS400);
end.