idftplistparseunix.pas

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

    Result := Result + ' '+LB;
  end;

Begin
  LI := AItem as TIdUnixFTPListItem;
  // Get defaults for modified date/time
  ADate := Now;
  DecodeDate(ADate, wYear, wMonth, wDay);
  DecodeTime(ADate, wHour, wMin, wSec, wMSec);
  LData := AItem.Data;
  LStep := pusinode;
  while NOT (LStep = pusDone) do begin
    case LStep of
     pusinode: begin
        //we do it this way because the column for inode is right justified
        //and we don't want to create a problem if the -i parameter was never used

         LTmp := TrimLeft(LData);
         LTmp := Fetch(LTmp);
         if IsValidUnixPerms(LTmp) then
         begin
           LStep := pusPerm;
         end
         else
         begin
         //the inode column is right justified
           LData := TrimLeft(LData);
           LTmp := Fetch(LData);
           LData := TrimLeft(LData);
           LInode := LTmp;
           LStep := pusBlocks;
         end;
      end;
    pusBlocks: begin
    //Note that there is an ambigioutity because this value could
    //be the inode if only the -i switch was used.
         LTmp := Fetch(LData,' ',False);
         if IsValidUnixPerms(LTmp)=False then
         begin
           LTmp := Fetch(LData);
           LData := TrimLeft(LData);
           LBlocks := LTmp;
         end;
         LStep := pusPerm;
      end;
    pusPerm: begin//1.-rw-rw-rw-
      LTmp := Fetch(LData);
      LData := TrimLeft(LData);
      // Copy the predictable pieces
      LDir := UpperCase(Copy(LTmp, 1, 1));
      LOPerm := Copy(LTmp, 2, 3);
      LGPerm := Copy(LTmp, 5, 3);
      LUPerm := Copy(LTmp, 8, 3);
      LStep := pusCount;
    end;
    pusCount: begin
      LData := TrimLeft(LData);
      LTmp := Fetch(LData);
      LData := TrimLeft(LData);

      //Patch for NetPresenz
      // "-------r--         326  1391972  1392298 Nov 22  1995 MegaPhone.sit" */
      // "drwxrwxr-x               folder        2 May 10  1996 network" */
      if TextIsSame(LTmp, 'folder') then begin  {do not localize}
        LStep := pusSize;
   //     LStep := pusMonth;
      end
      //APR
      //Patch for overflow -r--r--r--   0526478   128  Dec 30 2002  DE292000
      else begin
        if (Length(LTmp) > 3) and (LTmp[1] = '0') then begin
          LData := Copy(LTmp, 2, MaxInt) + ' ' + LData;
          LCount := '0';
        end
        else begin
          LCount := LTmp;
        end;
        //this check is necessary if both the owner and group were surpressed.
        if IsGOSwitches(AItem.Data) then
        begin
          LStep := pusSize;
        end
        else
        begin
          LStep := pusOwner;
        end;
      end;
      LData := TrimLeft(LData);
    end;
    pusOwner: begin
      LTmp := Fetch(LData);
      LData := TrimLeft(LData);
      LOwner := LTmp;
(*    if (SL[4] > '') and    {Do not Localize}
     //Ericsson Switch FTP returns empty owner.
     (SL[4][1] in ['A'..'Z','a'..'z']) then begin    {Do not Localize}
      SL.Insert(2, '');    {Do not Localize}
    end; *)
      LStep := pusGroup;
    end;
    pusGroup: begin
      LTmp := Fetch(LData);
      LData := TrimLeft(LData);
      LGroup := LTmp;
      LStep := pusSize;
    end;
    pusSize: begin
      //Ericsson - Switch FTP returns empty owner
      //Do not apply Ericson patch to Unitree
      if (CharIsInSet(LData, 1, ['A'..'Z','a'..'z']))
       and (GetIdent <> UNITREE) then begin
        LSize := LGroup;
        LGroup := LOwner;
        LOwner := '';
        //we do this just after the erickson patch because
        //a few servers might return additional columns.
        //
        //e.g.
        //
        //drwx------  1          BUILTIN     NT AUTHORITY          0 Dec  7  2001 System Volume Information
        if (IsNumeric(LSize)=False) then
        begin
          //undo the Ericson patch
          LOwner := LGroup;
          LGroup := '';
          repeat
            LGroup := LGroup + ' '+LSize;
            LOwner := LGroup;
            LData := TrimLeft(LData);
            LSize := Fetch(LData);
          until (IsNumeric(LSize));
          //delete the initial space we had added in the repeat loop
          IdDelete(LGroup,1,1);
        end;
      end
      else begin
        LTmp := Fetch(LData);
        //This is necessary for cases where are char device is listed
        //e.g.
        //crw-rw-rw-   1 0        1         11, 42 Aug  8  2000 tcp
        //
        //Note sure what 11, 42 is so size is not returned.
        if IndyPos(',',LTmp)>0 then
        begin
          LData := TrimLeft(LData);
          Fetch(LData);
          LData := TrimLeft(LData);
          LSize := '';
        end
        else
        begin
          LSize := LTmp;
        end;
        LData := TrimLeft(LData);
        case PosInStrArray(LSize,UnitreeStoreTypes) of
          0 :  //AR - archived to tape - migrated
          begin
            if AItem is TIdUnitreeFTPListItem then
            begin
              (LI as TIdUnitreeFTPListItem).Migrated := True;
              (LI as TIdUnitreeFTPListItem).FileFamily := Fetch(LData);
            end;
            LData := TrimLeft(LData);
            LSize := Fetch(LData);
            LData := TrimLeft(LData);
          end;
          1 : //DK - disk
          begin
            if AItem is TIdUnitreeFTPListItem then
            begin
              (LI as TIdUnitreeFTPListItem).FileFamily := Fetch(LData);
            end;
            LData := TrimLeft(LData);
            LSize := Fetch(LData);
            LData := TrimLeft(LData);
          end;
        end;
      end;
      LStep := pusMonth;
    end;
    pusMonth: begin // Scan modified MMM
      //fix up a bonked date such as:
      //-rw-r--r--   1 root     other        531 09-26 13:45 README3
      LData := FixBonkedYear(LData);
        //we do this in case there's a space
      LTmp := Fetch(LData);
      if Length(LTmp)>3 then
      begin
        //must be a year
        wYear := StrToIntDef(LTmp,wYear);
        LTmp := Fetch(LData);
      end;
      LData := TrimLeft(LData);
      if IsNumeric(LTmp) then
      begin
        wMonth := StrToIntDef(LTmp,wMonth);
        if (wMonth>12) then
        begin
          wDay := wMonth;
          LTmp := Fetch(LData);
          LData := TrimLeft(LData);
          wMonth := StrToIntDef(LTmp,wMonth);
          LStep := pusYear;
        end
        else
        begin
          LStep := pusDay;
        end;
      end
      else
      begin
        wMonth := StrToMonth(LTmp);
        LStep := pusDay;
      end;
    end;
    pusDay: begin // Scan DD
      LTmp := Fetch(LData);
      LData := TrimLeft(LData);
      wDay := StrToIntDef(LTmp, wDay);
      LStep := pusYear;
    end;
    pusYear: begin
      LTmp := Fetch(LData);
      // Not time info, scan year
      if IndyPos(':', LTmp) = 0 then begin    {Do not Localize}
        wYear := StrToIntDef(LTmp, wYear);
        // Set time info to 00:00:00.999
        wHour := 0;
        wMin := 0;
        wSec := 0;
        wMSec := 999;
        LStep := pusName;
      end//if IndyPos(':', SL[7])=0    {Do not Localize}
      else begin // Time info, scan hour, min
        LStep := pusTime;
      end;
    end;
    pusTime: begin
      // correct year and Scan hour
      wYear := AddMissingYear(wDay,wMonth);
      wHour:= StrToIntDef(Fetch(LTmp,':'), 0);    {Do not Localize}
      // Set sec and ms to 0.999 except for Serv-U or FreeBSD with the -T parameter
      //with the -T parameter, Serve-U returns something like this:
      //
      //drwxrwxrwx   1 user     group           0 Mar  3 04:49:59 2003 upload
      //
      //instead of:
      //
      //drwxrwxrwx   1 user     group           0 Mar  3 04:49 upload
      if (IndyPos(':',LTmp)>0) and (IsNumeric(Fetch(LData,' ',False))) then
      begin
        // Scan minutes
        wMin := StrToIntDef(Fetch(LTmp,':'), 0);
        wSec := StrToIntDef(Fetch(LTmp,':'), 0);
        wMSec := StrToIntDef(Fetch(LTmp,':'),999);
        LTmp := Fetch(LData);
        wYear := StrToIntDef(LTmp, wYear);
      end
      else
      begin
      // Scan minutes
        wMin := StrToIntDef(Fetch(LTmp,':'), 0);
        wSec := StrToIntDef(Fetch(LTmp,':'), 0);
        wMSec := StrToIntDef(Fetch(LTmp),999);
      end;
      LStep := pusName;
    end;
    pusName: begin
      LName := LData;
      LStep := pusDone;
    end;
    end;//case LStep
  end;//while
    AItem.ItemType := ditFile;
    if LDir<>'' then
    begin
      case LDir[1] of
        'D' : AItem.ItemType := ditDirectory;  {Do not Localize}
        'L' : AItem.ItemType := ditSymbolicLink; {Do not Localize}
        'B' : AItem.ItemType := ditBlockDev; {Do not Localize}
        'C' : AItem.ItemType := ditCharDev; {Do not Localize}
        'P' : AItem.ItemType := ditFIFO;  {Do not Localize}
        'S' : AItem.ItemType := ditSocket;   {Do not Localize}
      end;
    end;
    LI.UnixOwnerPermissions := LOPerm;
    LI.UnixGroupPermissions := LGPerm;
    LI.UnixOtherPermissions := LUPerm;
    LI.LinkCount := StrToIntDef(LCount, 0);
    LI.OwnerName := LOwner;
    LI.GroupName := LGroup;
    LI.Size := StrToInt64Def(LSize, 0);
    LI.ModifiedDate := EncodeDate(wYear, wMonth, wDay) + EncodeTime(wHour, wMin, wSec, wMSec);

    if LI.ItemType = ditSymbolicLink then begin
      i := IndyPos(UNIX_LINKTO_SYM, LName);    {Do not Localize}
      LLinkTo := Copy(LName, i + 4, Length(LName) - i - 3);
      LName := Copy(LName, 1, i - 1);
      //with ls -F (DIR -F in FTP, you will sometimes symbolic links with the linked
      //to item file name ending with a /.  That indicates that the item being pointed to
      //is a directory
      if (LLinkTo <> '') and (LLinkTo[Length(LLinkTo)]=PATH_FILENAME_SEP_UNIX) then
      begin
        LI.ItemType := ditSymbolicLinkDir;
        LLinkTo := Copy(LLinkTo,1,Length(LLinkTo)-1);
      end;
      LI.LinkedItemName := LLinkTo;
    end;
    LI.NumberBlocks := StrToIntDef(LBlocks,0);
    LI.Inode := StrToIntDef(linode,0);
    //with servers using ls -F, / is returned after the name of dir names and a *
    //will be returned at the end of a file name for an executable program.
    //Based on info at http://www.skypoint.com/help/tipgettingaround.html
    //Note that many FTP servers obtain their DIR lists by piping output from the /bin/ls -l command.
    //The -F parameter does work with ftp.netscape.com and I have also tested a NcFTP server
    //which simulates the output of the ls command.
    if (CharIsInSet(LName, Length(LName), [PATH_FILENAME_SEP_UNIX,'*'])) then
    begin
      LName := Copy(LName,1,Length(LName)-1);
    end;

  if APath<>'' then
  begin
  // a path can sometimes come into the form of:
  //  pub:
  // or
  //  ./pub
  //
  //Deal with both cases
    LI.LocalFileName := LName;
    LName := APath + PATH_FILENAME_SEP_UNIX + LName;
    if Copy(LName,1,Length(UNIX_CURDIR))=UNIX_CURDIR then
    begin
      IdDelete(LName,1,Length(PATH_FILENAME_SEP_UNIX));
      if Copy(LName,1,Length(PATH_FILENAME_SEP_UNIX))=PATH_FILENAME_SEP_UNIX then
      begin
        IdDelete(LName,1,Length(PATH_FILENAME_SEP_UNIX));
      end;
    end;
  end;
  LI.FileName := LName;
  Result := True;
end;

class function TIdFTPLPUnix.ParseListing(AListing: TIdStrings;
  ADir: TIdFTPListItems): boolean;
var i : Integer;
  LPathSpec : String;
  LItem : TIdFTPListItem;
begin
  for i := 0 to AListing.Count -1 do
  begin
    if (AListing[i] ='') or IsTotalLine(AListing[i]) or IsUnixLsErr(AListing[i])
    or (IsUnitreeBanner(AListing[i])) then
    begin
    end
    else
    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 (not InternelChkUnix(AListing[i])) and IsSubDirContentsBanner(AListing[i]) then
      begin
        LPathSpec := Copy(AListing[i],1,Length(AListing[i])-1);
      end
      else
      begin
        LItem := MakeNewItem(ADir);
        LItem.Data := AListing[i];
        ParseLine(LItem, LPathSpec);
      end;
    end;
  end;
  Result := True;
end;

{ TIdFTPLPUnitree }

class function TIdFTPLPUnitree.GetIdent: String;
begin
  Result := UNITREE;
end;

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

initialization
  RegisterFTPListParser(TIdFTPLPUnix);
  RegisterFTPListParser(TIdFTPLPUnitree);
finalization
  UnRegisterFTPListParser(TIdFTPLPUnix);
  UnRegisterFTPListParser(TIdFTPLPUnitree);
end.