VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ftpListParser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'ftpConnection Class
'version 2.0
'(C) 2007 Tze Jian Chear.
'please credit me when you use some or all of my codes.
'You can implement this interface and set ftpConnection.ListParser to your object.
Option Explicit

Private colFiles As Collection
Private numCols As Integer
Private bParsed As Boolean

'======= START ftpparse C =============
'Adapted from C code from http://cr.yp.to/ftpparse.html (D. J. Bernstein)
Private Const FTPPARSE_SIZE_UNKNOWN = 0
Private Const FTPPARSE_SIZE_BINARY = 1 '/* size is the number of octets in TYPE I */
Private Const FTPPARSE_SIZE_ASCII = 2 '/* size is the number of octets in TYPE A */

Private Const FTPPARSE_ID_UNKNOWN = 0
Private Const FTPPARSE_ID_FULL = 1 '/* unique identifier for files on this FTP server */

Private Type FTPParseDesc
    Name As String
    flagtrycwd As Integer
    flagtryretr As Integer
    sizetype As Integer
    size As Long
    idtype As Integer
    id As String
End Type

Private Function ftpParse(ByRef fp As FTPParseDesc, Line As String) As Long
    Dim i As Long, j As Long, state As Integer
    Dim size As Long, year As Long, month As Long, mday As Long, hour As Long, minute As Long
    Dim ln As Long
    
    ln = Len(Line)
    fp.Name = ""
    fp.flagtrycwd = 0
    fp.flagtryretr = 0
    fp.sizetype = FTPPARSE_SIZE_UNKNOWN
    fp.size = 0
    fp.idtype = FTPPARSE_ID_UNKNOWN
    fp.id = ""
    
    If ln < 2 Then
        'empty name in EPLF
        ftpParse = 0
        Exit Function
    End If
    
    Select Case Left$(Line, 1)
    '/* see http://pobox.com/~djb/proto/eplf.txt */
    Case "+"
        i = 1
        For j = 1 To ln - 1
            If Asc(Char(Line, j)) = 9 Then
                fp.Name = Mid(Line, j + 2, ln - j - 1) 'buf + j + 1
                ftpParse = 1
                Exit Function
            End If
            
            If Char(Line, j) = "," Then
                Select Case Char(Line, i)
                Case "/"
                    fp.flagtrycwd = 1
                Case "r"
                    fp.flagtryretr = 1
                Case "s"
                    fp.sizetype = FTPPARSE_SIZE_BINARY
                    fp.size = Val(Mid(Line, i + 2, j - i - 1))
                Case "m"
                    'fp->mtimetype = FTPPARSE_MTIME_LOCAL;
                    'initbase();
                    'fp->mtime = base + getlong(buf + i + 1,j - i - 1);
                Case "i"
                    fp.idtype = FTPPARSE_ID_FULL
                    fp.id = Mid(Line, i + 2, j - i - 1)
                End Select
                i = j + 1
            End If
        Next j
        ftpParse = 0
        Exit Function
    '/* UNIX-style listing, without inum and without blocks */
    Case "b", "c", "d", "l", "p", "s", "-"
        If Left$(Line, 1) = "d" Then fp.flagtrycwd = 1
        If Left$(Line, 1) = "-" Then fp.flagtryretr = 1
        If Left$(Line, 1) = "l" Then
            fp.flagtrycwd = 1
            fp.flagtryretr = 1
        End If
        
        state = 1
        i = 0
        For j = 1 To ln - 1
            If Char(Line, j) = " " And Char(Line, j - 1) <> " " Then
                Select Case state
                Case 1 'skipping perm
                    state = 2
                Case 2 'skipping nlink
                    state = 3
                    If j - i = 6 And Char(Line, i) = "f" Then state = 4
                Case 3 'skip uid
                    state = 4
                Case 4 'get tentative size
                    size = Val(Mid(Line, i + 1, j - i))
                    state = 5
                Case 5 'searching for month, otherwise getting tent size
                    month = getMonth(Mid(Line, i + 1, j - i))
                    If month >= 0 Then
                        state = 6
                    Else
                        size = Val(Mid(Line, i + 1, j - i))
                    End If
                Case 6 'have size and month
                    mday = Val(Mid(Line, i + 1, j - i))
                    state = 7
                Case 7 'have size, month, mday
                    If j - i = 4 And Char(Line, i + 1) = ":" Then
                        hour = Val(Mid(Line, i + 1, 1))
                        minute = Val(Mid(Line, i + 3, 2))
                        'fp->mtimetype = FTPPARSE_MTIME_REMOTEMINUTE;
                        'initbase();
                        'fp->mtime = base + guesstai(month,mday) + hour * 3600 + minute * 60;
                    ElseIf j - i = 5 And Char(Line, i + 2) = ":" Then
                        hour = Val(Mid(Line, i + 1, 2))
                        minute = Val(Mid(Line, i + 4, 2))
                        'fp->mtimetype = FTPPARSE_MTIME_REMOTEMINUTE;
                        'initbase();
                        'fp->mtime = base + guesstai(month,mday) + hour * 3600 + minute * 60;
                    ElseIf j - i >= 4 Then
                        year = Val(Mid(Line, i + 1, j - i))
                        'fp->mtimetype = FTPPARSE_MTIME_REMOTEDAY;
                        'initbase();
                        'fp->mtime = base + totai(year,month,mday);
                    Else
                        ftpParse = 0
                        Exit Function
                    End If
                    fp.Name = Mid(Line, j + 2, ln - j - 1)
                    state = 8
                Case 8 'twiddling thumbs
                End Select
                i = j + 1
                'while ((i < len) && (buf[i] == ' ')) ++i;
                While i < ln And Char(Line, i) = " "
                    i = i + 1
                Wend
            End If
        Next j
            
        If state <> 8 Then
            ftpParse = 0
            Exit Function
        End If
        
        fp.size = size
        fp.sizetype = FTPPARSE_SIZE_BINARY
        
        If Left$(Line, 1) = "l" Then
            i = InStr(fp.Name, " -> ") 'instr returns 1 index not 0
            If i > 0 Then fp.Name = Mid(fp.Name, 1, i - 1)
'                i = 0
'                While i + 3 < Len(fp.Name)
'                    If Char(fp.Name, i) = " " Then
'                        If Char(fp.Name, i + 1) = "-" Then
'                            If Char(fp.Name, i + 2) = ">" Then
'                                If Char(fp.Name, i + 3) = " " Then
'                                    fp.Name = Mid(fp.Name, 1, i)
'                                    Exit For
'                                End If
'                            End If
'                        End If
'                    End If
'                    i = i + 1
'                Wend
        End If
            
        '/* eliminate extra NetWare spaces */
        'If Char(Line, 1) = " " Or Char(Line, 1) = "[" Then
        'End If
        fp.Name = Trim(fp.Name) 'yay VB
        
        ftpParse = 1
        Exit Function
    End Select
    '/* MultiNet (some spaces removed from examples) */
    i = InStr(Line, ";") - 1
    If i > -1 Then
        fp.Name = Mid(Line, 1, i)
        If i > 4 Then
            If Right$(fp.Name, 4) = ".DIR" Then
                fp.Name = Mid(fp.Name, 1, Len(fp.Name) - 4)
                fp.flagtrycwd = 1
            End If
        End If
        If fp.flagtrycwd = 0 Then fp.flagtryretr = 1
        While Char(Line, i) <> " "
            i = i + 1
            If i = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        While Char(Line, i) = " "
            i = i + 1
            If i = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        While Char(Line, i) <> " "
            i = i + 1
            If i = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        While Char(Line, i) = " "
            i = i + 1
            If i = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        j = i
        While Char(Line, j) <> "-"
            j = j + 1
            If j = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        mday = Val(Mid(Line, i + 1, j - i))
        While Char(Line, j) = "-"
            j = j + 1
            If j = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        i = j
        While Char(Line, j) <> "-"
            j = j + 1
            If j = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        month = Val(Mid(Line, i + 1, j - i))
        If month < 0 Then
            ftpParse = 0
            Exit Function
        End If
        While Char(Line, j) = "-"
            j = j + 1
            If j = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        i = j
        While Char(Line, j) <> " "
            j = j + 1
            If j = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        year = Val(Mid(Line, i + 1, j - i))
        While Char(Line, j) = " "
            j = j + 1
            If j = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        i = j
        While Char(Line, j) <> ":"
            j = j + 1
            If j = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        hour = Val(Mid(Line, i + 1, j - i))
        While Char(Line, j) = ":"
            j = j + 1
            If j = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        i = j
        While Char(Line, j) <> ":" And Char(Line, j) <> " "
            j = j + 1
            If j = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        minute = Val(Mid(Line, i + 1, j - i))
        'fp->mtimetype = FTPPARSE_MTIME_REMOTEMINUTE;
        'initbase();
        'fp->mtime = base + totai(year,month,mday) + hour * 3600 + minute * 60;
        
        ftpParse = 1
        Exit Function
    End If
    '/* MSDOS format */
    If Asc(Left$(Line, 1)) >= Asc("0") And Asc(Left$(Line, 1)) <= Asc("9") Then
        i = 0
        j = 0
        While Char(Line, j) <> "-"
            j = j + 1
            If j = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        month = Val(Mid(Line, i + 1, j - i)) - 1
        While Char(Line, j) = "-"
            j = j + 1
            If j = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        i = j
        While Char(Line, j) <> "-"
            j = j + 1
            If j = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        mday = Val(Mid(Line, i + 1, j - i))
        While Char(Line, j) = "-"
            j = j + 1
            If j = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        i = j
        While Char(Line, j) <> " "
            j = j + 1
            If j = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        year = Val(Mid(Line, i + 1, j - i))
        If year < 50 Then year = year + 2000
        If year < 1000 Then year = year + 1900
        While Char(Line, j) = " "
            j = j + 1
            If j = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        i = j
        While Char(Line, j) <> ":"
            j = j + 1
            If j = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        hour = Val(Mid(Line, i + 1, j - i))
        While Char(Line, j) = ":"
            j = j + 1
            If j = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        i = j
        While Char(Line, j) <> "A" And Char(Line, j) <> "P"
            j = j + 1
            If j = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        minute = Val(Mid(Line, i + 1, j - i))
        If hour = 12 Then hour = 0
        If Char(Line, j) = "A" Then
            j = j + 1
            If j = ln Then
                ftpParse = 0
                Exit Function
            End If
        End If
        If Char(Line, j) = "P" Then
            hour = hour + 12
            j = j + 1
            If j = ln Then
                ftpParse = 0
                Exit Function
            End If
        End If
        If Char(Line, j) = "M" Then
            j = j + 1
            If j = ln Then
                ftpParse = 0
                Exit Function
            End If
        End If
        While Char(Line, j) = " "
            j = j + 1
            If j = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        If Char(Line, j) = "<" Then
            fp.flagtrycwd = 1
            While Char(Line, j) <> " "
                j = j + 1
                If j = ln Then
                    ftpParse = 0
                    Exit Function
                End If
            Wend
        Else
            i = j
            While Char(Line, j) <> " "
                j = j + 1
                If j = ln Then
                    ftpParse = 0
                    Exit Function
                End If
            Wend
            fp.size = Val(Mid(Line, i + 1, j - i))
            fp.sizetype = FTPPARSE_SIZE_BINARY
            fp.flagtryretr = 1
        End If
        While Char(Line, j) = " "
            j = j + 1
            If j = ln Then
                ftpParse = 0
                Exit Function
            End If
        Wend
        fp.Name = Mid(Line, j + 1, ln - j)
        
        'fp->mtimetype = FTPPARSE_MTIME_REMOTEMINUTE;
        'initbase();
        'fp->mtime = base + totai(year,month,mday) + hour * 3600 + minute * 60;
        ftpParse = 1
        Exit Function
    End If
    
    ftpParse = 0
End Function

Private Function Char(V As String, i0 As Long) As String
    Char = Mid(V, i0 + 1, 1)
End Function

Private Function getMonth(V As String) As Integer
    Dim Mons As Variant, i As Integer
    Mons = Array("jan", "feb", "mar", "apr", "may", "jun", "jul", "aug", "sep", "oct", "nov", "dec")
    If Len(V) = 3 Then
        For i = 0 To 11
            If UCase$(V) = UCase$(Mons(i)) Then
                getMonth = i
                Exit Function
            End If
        Next i
    End If
    getMonth = -1
End Function
'======= END ftpparse C =============

Public Property Get IsParsed() As Boolean
    IsParsed = bParsed
End Property
Public Sub ClearIsParsed()
    bParsed = False
End Sub

Public Function Parse(s As String) As Boolean
    Dim lines() As String, c As Variant
    Dim Fields() As String, FpLine As FTPParseDesc
    If s <> "" Then
        lines = Split(s, vbCrLf)
        Set colFiles = Nothing
        Set colFiles = New Collection
        'assume LIST first
        ReDim Fields(0 To 2)
        numCols = 3
        For Each c In lines
            If CStr(c) <> "" Then
                'colFiles.Add ParseLine(CStr(c))
                If ftpParse(FpLine, CStr(c)) <> 0 Then
                    'Make 3 cols: d/- for directory vs file, Size, Name
                    Fields(0) = IIf(FpLine.flagtrycwd <> 0, "d", "-")
                    Fields(1) = FpLine.size
                    Fields(2) = FpLine.Name
                    colFiles.Add Fields
                End If
            End If
        Next
        'If nothing, perhaps a NLIST
        If colFiles.count = 0 Then
            ReDim Fields(0 To 0)
            numCols = 1
            For Each c In lines
                If CStr(c) <> "" Then
                    'Just column of names
                    Fields(0) = CStr(c)
                    colFiles.Add Fields
                End If
            Next
        End If
    End If
    bParsed = True
End Function

Public Function OLDParse(s As String) As Boolean
    Dim lines() As String, c As Variant
    If s <> "" Then
        lines = Split(s, vbCrLf)
        Set colFiles = Nothing
        Set colFiles = New Collection
        numCols = UBound(ParseLine(lines(0))) + 1
        For Each c In lines
            If CStr(c) <> "" Then
                colFiles.Add ParseLine(CStr(c))
            End If
        Next
    End If
    bParsed = True
End Function

Public Property Get fileList(Index As Long, column As Integer) As String
    Dim c() As String
    If Index < FileCount Then
        c = colFiles(Index + 1)
        If column < ColumnCount Then
            fileList = c(column)
        End If
    End If
End Property

Public Property Get FileCount() As Long
    FileCount = 0
    If Not (colFiles Is Nothing) Then
        FileCount = colFiles.count
    End If
End Property

Public Property Get ColumnCount() As Integer
    ColumnCount = numCols
End Property

Private Function ParseLine(s As String) As String()
    Dim iPos As Integer, inSpace As Boolean
    Dim iStart As Integer, Col() As String
    ReDim Col(0)
    inSpace = True
    iStart = 1
    For iPos = 1 To Len(s)
        Select Case Mid$(s, iPos, 1)
            Case vbTab
            Case " "
                If Not inSpace Then
                    If iStart > 0 Then
                        Col(UBound(Col)) = Mid$(s, iStart, iPos - iStart)
                        ReDim Preserve Col(UBound(Col) + 1)
                    End If
                    inSpace = True
                End If
            Case Else
                If inSpace Then
                    inSpace = False
                    iStart = iPos
                End If
        End Select
    Next
    If Not inSpace Then
        If iStart < Len(s) Then
            Col(UBound(Col)) = Mid$(s, iStart, Len(s) - iStart + 1)
        End If
    End If
    ParseLine = Col
End Function