Option Explicit
' -------------------------------------------------------------------------------------
' Author:       Markus Diersbock
' Description:  Little safer to use than FileSystemObject on text files. This
'               class relies on settings from ASPFileIO.INI for security:
'
'               ASPFileIO.INI
'                   [ASPFileIO]
'                   AllowAbsolutePaths = 1
'                   HomeDirPath=C:\INetPub\Docs
'
'               INI file should be located in the same directory as DLL.
'
' Created:      06/06/2001
' -------------------------------------------------------------------------------------
Private m_AllowAbsolutePaths As Boolean     ' Retrieves value from INI
Private m_HomeDirPath As String             ' Used for Relative Paths
Private m_ErrorDescription As String        ' If errors occur
Private m_IsFileOpenFlag As Boolean         ' Only one open file per instance
Private m_lNextFile As Long                 ' File handle
Private m_CurAccMode As FileAccess          ' File open for Read or Write?
Private m_CurLineNum As Long                ' Current read line number
Private m_BOFFlag As Boolean                ' Beginning of file?
Private m_EOFFlag As Boolean                ' End of file?

Public Enum PathType                        ' Enum for path type
    PATH_ABSOLUTE = 1
    PATH_RELATIVE = 2
End Enum

Public Enum FileAccess                      ' Enum for FileAccess mode
    FILE_WRITE = 1
    FILE_READ = 2
    FILE_APPEND = 3
End Enum

Public Property Get CurLineNum() As Long
    CurLineNum = m_CurLineNum
End Property

Public Property Get IsBOF() As Boolean
    IsBOF = m_BOFFlag
End Property

Public Property Get IsEOF() As Boolean
    IsEOF = m_EOFFlag
End Property

Public Property Get ErrorDescription() As String
Attribute ErrorDescription.VB_Description = "Returns the description of the current error (if applicable)"
    ErrorDescription = m_ErrorDescription
End Property

Public Property Get Version() As String
    Version = App.Major & "." & App.Minor & "." & App.Revision
End Property

Public Property Get AllowAbsolutePaths() As Boolean
    AllowAbsolutePaths = m_AllowAbsolutePaths
End Property

Private Function AddError(ByVal sError As String)
    If Len(m_ErrorDescription) > 0 Then
        m_ErrorDescription = m_ErrorDescription & " \\ " & sError & vbCrLf
    Else
        m_ErrorDescription = sError & vbCrLf
    End If
End Function

' -------------------------------------------------------------------------------------
' Function name: OpenFile
' Description:   Opens file for input/output using an Absolute or Relative Path
'                and verifies rights in ASPFileIO.INI. Sets m_IsFileOpenFlag = TRUE
' Inputs:        sFileName - Path and File to read/write to.
' Outputs:       None
' Return:        Boolean - Success/Fail
' -------------------------------------------------------------------------------------
Public Function OpenFile(ByVal sFileName As String, _
                         ByVal eFileAccess As FileAccess, _
                         ByVal ePathType As PathType) As Boolean
    Dim bAllowOpen As Boolean
    On Error GoTo Catch
        
    bAllowOpen = False
    m_lNextFile = FreeFile
        
    If Not m_IsFileOpenFlag = True Then
    
        Select Case ePathType
            Case PATH_ABSOLUTE
                If m_AllowAbsolutePaths = True Then
                    bAllowOpen = True
                Else
                    AddError ("You do NOT have rights to Absolute Paths.")
                End If
            Case PATH_RELATIVE
                If Len(m_HomeDirPath) > 0 And InStr(m_HomeDirPath, "\") > 0 Then
                    If InStr(sFileName, "..") > 0 Then Err.Raise 5000, , "Double periods not allowed in path"
                    sFileName = m_HomeDirPath & "\" & sFileName
                    bAllowOpen = True
                Else
                    AddError ("Home Path is empty or invalid in INI.")
                End If
            Case Else
                AddError ("PathType Enum must be used")
        End Select
    
        If bAllowOpen = True Then
            Select Case eFileAccess
                Case FILE_READ
                    Open sFileName For Input Shared As #m_lNextFile
                    OpenFile = True
                    m_IsFileOpenFlag = True
                    m_CurAccMode = FILE_READ
                Case FILE_WRITE
                    Open sFileName For Output Shared As #m_lNextFile
                    OpenFile = True
                    m_IsFileOpenFlag = True
                    m_CurAccMode = FILE_WRITE
                Case FILE_APPEND
                    Open sFileName For Append Shared As #m_lNextFile
                    OpenFile = True
                    m_IsFileOpenFlag = True
                    m_CurAccMode = FILE_APPEND
                Case Else
                    AddError ("AccessType Enum must be used")
            End Select
        Else
            OpenFile = False
            m_IsFileOpenFlag = False
        End If
    Else
        OpenFile = False
        AddError ("File is already Open.")
    End If
    
    Exit Function
Catch:
    OpenFile = False
    m_IsFileOpenFlag = False
    AddError ("OpenFile: " & Err.Description)
End Function

' -------------------------------------------------------------------------------------
' Function name: CloseFile
' Description:   Closes file for output and sets m_IsFileOpenFlag to FALSE
' Inputs:        None
' Outputs:       None
' Return:        None
' -------------------------------------------------------------------------------------
Public Function CloseFile()
Attribute CloseFile.VB_Description = "Close file."
    On Error GoTo Catch
        
    If m_IsFileOpenFlag = True Then
        Close #m_lNextFile
        m_IsFileOpenFlag = False
        m_BOFFlag = True
        m_EOFFlag = False
        m_CurLineNum = 1
    End If
    Exit Function
Catch:
    AddError ("CloseFile: " & Err.Description)
End Function

' -------------------------------------------------------------------------------------
' Function name: ReadLine
' Description:   Reads each line into a 512 char buffer.
' Inputs:        sFileName - Path and File to read/write to.
' Outputs:       None
' Return:        String - Line of data from file
' -------------------------------------------------------------------------------------
Public Function ReadLine() As String
Attribute ReadLine.VB_Description = "Read line of text from file (512 max)."
    Dim sLineData As String * 512
    On Error GoTo Catch
    
    If m_IsFileOpenFlag = True Then
        If m_CurAccMode = FILE_READ Then
            If Not EOF(m_lNextFile) Then
                m_BOFFlag = False
                Line Input #m_lNextFile, sLineData
                ReadLine = RTrim(sLineData)
                m_CurLineNum = m_CurLineNum + 1
            Else
                m_EOFFlag = True
                ReadLine = ""
            End If
        Else
            m_EOFFlag = True
            Err.Raise 2000, , "ReadLine: Wrong FileAccess Mode"
        End If
    End If
    
    Exit Function
Catch:
    ReadLine = ""
    AddError ("ReadLine: " & Err.Description)
End Function

' -------------------------------------------------------------------------------------
' Function name: WriteLine
' Description:   Writes a line of data.
' Inputs:        sData - Data to write.
' Outputs:       None
' Return:        Boolean - Success/Fail
' -------------------------------------------------------------------------------------
Public Function WriteLine(ByVal sData As String) As Boolean
Attribute WriteLine.VB_Description = "Write line of text to file."
    On Error GoTo Catch
    
    If m_IsFileOpenFlag = True Then
        If m_CurAccMode = FILE_APPEND Or FILE_WRITE Then
            m_BOFFlag = False
            m_EOFFlag = True
            Print #m_lNextFile, sData
            WriteLine = True
        Else
            WriteLine = False
            Err.Raise 2000, , "WriteLine: Wrong FileAccess Mode"
        End If
    Else
        WriteLine = False
    End If
        
    Exit Function
Catch:
    WriteLine = False
    AddError ("WriteLine: " & Err.Description)
End Function

Private Sub Class_Initialize()
    Dim sRtnValue As String

    sRtnValue = ReadINI("ASPFileIO", "AllowAbsolutePaths", App.Path & "\ASPFileIO.INI")
    
    If Len(sRtnValue) > 0 And Val(sRtnValue) = 1 Then
        m_AllowAbsolutePaths = True
    Else
        m_AllowAbsolutePaths = False
    End If


    sRtnValue = ReadINI("ASPFileIO", "HomeDirPath", App.Path & "\ASPFileIO.INI")
    
    If Len(sRtnValue) > 0 Then
        m_HomeDirPath = sRtnValue
    Else
        m_HomeDirPath = ""
    End If

    m_BOFFlag = True
    m_EOFFlag = False
    m_CurLineNum = 1
End Sub

Private Sub Class_Terminate()
    If m_IsFileOpenFlag = True Then     ' If user didn't issue close then clean up
        Close #m_lNextFile
        m_BOFFlag = True
        m_EOFFlag = False
        m_CurLineNum = 1
    End If
End Sub