Chip 2001 September/Chip_2001-09_cd1.bin/zkuste/delphi/nastroje/d5/MFTP.ZIP/src/ftpparse.pas

Pascal/Delphi Source File | 2001-03-17 | 7.3 KB | 293 lines

unit FtpParse;

interface

uses SysUtils, FtpMisc;

{$I mftp.inc}

const mfile: Array[1..8] of String = ('.gz', '.exe', '.txt', '.tar', 'copying',
                                      'readme', '.tar', '.diff');

type
   TMFtpServerType = (ftpstAutoDetect, ftpstDefault,
                      ftpstUNIX, ftpstULTRIX, ftpstClix, ftpstChameleon,
                      ftpstNCSA, ftpstQVT, ftpstBSD, ftpstSunOS,
                      ftpstVmsMultinet, ftpstVmsUcx, ftpstMVS, ftpstVM, ftpstVMVPS,
                      ftpstMSFTP, ftpstNetTerm, ftpstServU, ftpstWFTPD, ftpWarFTPD,
                      ftpstNetware, ftpstNetPresenz);

function ParseEPLFLine(line: String; var name, size, date, ident, attrib: String; var IsDir: Boolean): Boolean;
function ParseListingLine(ServerType: TMFtpServerType; line: String; var name, size, date, symlink, attrib, owner, group: String; var IsDir: Boolean): Boolean;
function FTPExtractDate(line: String; n: Integer; VM: Boolean): String;
function FTPExtractName(line: String; n: Integer): String;
function FTPExtractSymLink(line: String): String;
function CheckSymLink(SymLink: String): Boolean;
function ExtractField(line: String; n: Integer): String;

implementation

function FTPExtractDate;
begin
   if VM then
      Result := ExtractField(line, n) + ' ' + ExtractField(line, n + 1)
   else
      Result := ExtractField(line, n) + ' ' + ExtractField(line, n + 1) + ' ' + ExtractField(line, n + 2);

   Result := FormatNTime(Result);
end;

function FTPExtractName;
var i, j: Integer;
begin
   j := 0; {make compiler happy :-)}
   i := Pos('->', line);
   if i <> 0 then Delete(line, i, 999);

   for i := n downto 1 do
   begin
      try
         repeat
            j := Pos(' ', line);
            if j = 0 then
            begin
               Result := '';
               Exit;
            end;
            line[j] := 'A';
         until line[j + 1] <> ' ';
      except
         Result := '';
         Exit;
      end;
      Delete(line, 1, j);
   end;

   Result := Trim(Copy(line, Pos(' ', line), 999));
end;

function FTPExtractSymLink;
var p: Integer;
begin
   p := Pos('->', line);
   if p = 0 then
      Result := ''
   else
   begin
      delete(line, 1, p - 1);
      Result := line;
   end;
end;

function CheckSymLink;
var i: Integer;
begin
   for i := 1 to 8 do
      if Pos(mfile[i], SymLink) > 0 then
      begin
         Result := False;
         Exit;
      end;
  Result := True;
end;

function ExtractField; {n is 0 based}
var i, j: Integer;
begin
   i := Pos('  ', line);
   while i <> 0 do
   begin
      Delete(line, i, 1);
      i := Pos('  ', line);
   end;
   for i := n downto 1 do
   begin
      j := Pos(' ', line);
      if j = 0 then
      begin
         Result := '';
         Exit;
      end;
      Delete(line, 1, j);
   end;

   j := Pos(' ', line);
   if j = 0 then
      Result := ''
   else
      Result := Copy(line, 1, j - 1);
end;

function ParseEPLFLine; {EPLF: Easily Parsed List Format}
var P: String;
    i: Integer;
begin
   Delete(line, 1, 1);
   i := Pos(',', line);

   {fill in default value}
   size := '0';
   date := DefaultDateTime;

   while i <> 0 do
   begin
      P := Copy(line, 1, i - 1);
      Delete(line, 1, i);

      if P <> '' then
      begin
         case P[1] of
            'i': ident := Copy(P, 2, 999);
            'm':
            begin
               Delete(P, 1, 1);
               date := FormatMTime(P);
            end;
            's': size := Copy(P, 2, 999);
            'r': IsDir := False;
            '/': IsDir := True;
          end;
      end;

      i := Pos(',', line);
   end;

   name := Trim(line);

   if name = '' then
      Result := False
   else
      Result := True;
end;

function ParseListingLine;
var temp: String;
    based: Integer;
begin
   Result := False;

   if line = '' then Exit;

   if line[1] = '+' then {EPLF}
   begin
      Result := ParseEPLFLine(line, name, size, date, symlink, attrib, IsDir);
      Exit;
   end;

   case ServerType of
      ftpstVM:
      begin
         name := ExtractField(line, 0) + '.' + ExtractField(line, 1);
         size := ExtractField(line, 3);
         date := FTPExtractDate(line, 6, True);
         IsDir := False;
      end;

      ftpstVMVPS:
      begin
         if (Pos('=', line) <> 0) or (Pos('totals:', line) <> 0) or
         (Pos(' rf trks', line) <> 0) or (Pos('track limit', line) <> 0) then
         begin
            Exit;
         end;
         name := '.' + ExtractField(line, 1);
         size := ExtractField(line, 2);
         date := ExtractField(line, 7) + ' ' + ExtractField(line, 6);
         date := FormatNTime(date);
         IsDIr := False;
      end;

      ftpstVMSMultinet, ftpstVMSUcx:
      begin
         if temp <> '' then
         begin
            line := temp + line;
            temp := '';
         end;
         if Pos(';', line) = 0 then
         begin
            temp := '';
            Exit;
         end;
         name := ExtractField(line, 0);
         if name = '' then
         begin
            temp := line;
            Exit;
         end
         else
         begin
            name := Copy(name, 1, Pos(';', name) - 1);
            IsDIr := Pos('.DIR', name) <> 0;
            if IsDIr then Name := Copy(name, 1, Pos('.DIR', name) - 1);
            size := ExtractField(line, 1);
            date := FTPExtractDate(line, 2, True);
         end;
      end;

      {otherwise}
      else
      begin
         case line[1] of
            'd', 'l': IsDir := True;
            '-', 'f': IsDir := False;
            '0', '1',
            '2', '3',
            '4', '5',
            '6', '7',
            '8', '9':
            begin
               size := ExtractField(line, 2);
               if size = '<DIR>' then
               begin
                  IsDir := True;
                  size := '0';
               end
               else
               begin
                  IsDir := False;
               end;

               date := FormatNTTime(ExtractField(line, 0), ExtractField(line, 1));
               name := line;
               delete(name, 1, 39);
               Result := True;
               Exit;
            end;
            else Exit;
         end;

         attrib := ExtractField(line, 0);
         owner := ExtractField(line, 2);
         group := ExtractField(line, 3);

         case ServerType of
            ftpstNetPresenz: if IsDir then based := 2 else based := 3;
            ftpstNetTerm: based := 2;
            ftpstNetWare: based := 3;
            else
            begin
               temp := ExtractField(line, 1);
               if temp = '' then Exit;

               if (temp[1] = '[') or (Length(attrib) > 10) or (ExtractField(line, 4) > '9') {or (Length(ExtractField(line, 2)) > 8)} then
                  based := 3
               else
                  based := 4;
            end;
         end;

         size := ExtractField(line, based);
         date := FTPExtractDate(line, based + 1, False);
         name := FTPExtractName(line, based + 3);
      end;
   end;

   SymLink := FTPExtractSymLink(line);
   if SymLink <> '' then IsDir := CheckSymLink(LowerCase(symlink));

   Result := True;
end;

end.