' ANSIFILE.BAS - ANSI Text File Utility
' (C)1993-1994 Shapeware Corporation.  All rights reserved.
'
' Description : Designed for writing tables to an ANSI text file.  Handles
'               special characters in fields and records with a variable
'               number of fields.
'
'               An ANSI text table file is defined as having multiple records
'               made up of multiple fields.  The number of fields per record
'               is usually constant for tables but may vary for spreasheet
'               produced tables.  Therefore most read/write procedures will
'               require a fields per record parameter.
'
'               Text that is written to these files is automatically
'               formatted to take into account any special characters which
'               may be used withing (see section below).
'
' Audit Trail
' 07/09/94 - 1.003 - tds - Fixed UnFormatANSIString bug.  It was cutting off
'                          the last character because it looped over < length
'                          instead of <= length of string.
' 10/11/93 - 1.002 - tds - Added UnFormatANSIString.
'  9/30/93 - 1.001 - tds - Added FormatANSIString, ReadField.
'  9/30/93 - 1.000 - tds - Created
'

Option Explicit
Option Base 0


Global Const ATF_ERROR = 0
Global Const ATF_OK = 1
Global Const ATF_ALREADY_OPEN = 2

Global Const ATF_EOF = 3
Global Const ATF_END_OF_RECORD = 4
Global Const ATF_END_OF_FIELD = 5

' Used to store the file number or open read and write files.  When zero (0)
' the files are not set.
'
Dim m_iReadFile As Integer
Dim m_iWriteFile As Integer

Sub CloseReadFileANSI ()
'----------------------------------------
'--- CloseReadFileANSI ------------------
'--
'--   Closes the read file if open.
'--

    If IsReadFileOpen() Then
        Close #m_iReadFile

        m_iReadFile = 0
    End If
End Sub

Function FormatStringANSI (ByVal strData As String) As String
'----------------------------------------
'--- FormatANSIString ------------------
'--
'--   Formats a string for use in ANSI table files.  The rules are:
'--
'-- 1 - If any special characters are found within a field, double quotes are
'--     placed around the field.
'--
'-- 2 - Special Characters.  CRLF - Truncated to LF
'--                          TAB  - No change
'--                          "    - Converted to ""
'--                          ,    - Comma - No change
'--

    Dim I As Integer, bSpecial As Integer
    Dim strTemp As String, strChar  As String
    
    bSpecial = False

    For I = 1 To Len(strData)
        strChar = Mid(strData, I, 1)

        Select Case strChar
            Case Chr(34)                            '-- Double Quote (")
                strTemp = strTemp + String$(2, 34)
                bSpecial = True
            Case Chr(13)                            '-- CR - Removed
            Case Chr(10)                            '-- LF
                strTemp = strTemp + strChar
                bSpecial = True
            Case Chr(ASC_TAB)                       '-- Tab
                strTemp = strTemp + strChar
                bSpecial = True
            Case Chr(ASC_COMMA)                     '-- Not removed but field
                strTemp = strTemp + strChar
                bSpecial = True                     '--   is now special.
            Case Else
                strTemp = strTemp + strChar
        End Select
    Next I

    If bSpecial Then strTemp = Chr(34) + strTemp + Chr(34)

    FormatStringANSI = strTemp
End Function

Private Function IsReadFileOpen () As Integer
'----------------------------------------
'--- IsReadFileOpen ---------------------
'--
'--   Returns boolean indicating wether or not the read file is open.
'--

    IsReadFileOpen = (m_iReadFile <> 0)
End Function

Private Function ReadField (strField As String) As Integer
'----------------------------------------
'--- ReadField --------------------------
'--
'--   Reads a field from standard text file.  Assumes the file is pointing to
'-- the first character of a field.
'--
'--   Uses either ATF_DELIM_COMMA or ATF_DELIM_TAB as the field delimiter and
'-- CRLF as the end of field.
'--
'-- Return Value : Returns the reason that it returned.
'--
'--                ATF_ERROR            Error occurred.
'--                ATF_EOF              Reached the end of the file.
'--                                     No more records to read.
'--                ATF_END_OF_RECORD    Reached the end of a record.  File
'--                                     is pointing to start of next record
'--                                     or EOF.
'--                ATF_END_OF_FIELD     Reached the end of a field.  Another
'--                                     is waiting to be read.
'--

    On Error GoTo lblReadFieldErr

    Dim strChar As String
    Dim iQuotes As Integer, iQuoteInc As Integer
    Dim bSpecial As Integer, iChar As Integer, iRetVal As Integer
    
    ' bSpecial indicates if the field contains special formatting characters.
    ' This is determined by a leading double quote (").  If so we must count
    ' the number of quotes.  We assume embedded quotes are doubled.
    '
    ' iQuotes is our state variable.  iQuotes = 1 means we are still inside the
    ' field, iQuotes = 2 means we might be at the end of the field.
    ' Special characters are considered embedded when iQuotes = 1.
    
    iChar = 0                                   '-- Character Position in File.
    bSpecial = False                            '-- Special Characters in Field
    iQuoteInc = 1
    strField = ""                               '-- Clear any old data.

    Do
        strChar = Input(1, #m_iReadFile)        '-- Get Next Character
        iChar = iChar + 1

        ' Special case check for leading quote.
        '
        If (iChar = 1) And strChar = Chr$(34) Then bSpecial = True
        
        If bSpecial Then
            Select Case strChar
                Case Chr$(34)
                    iQuotes = iQuotes + iQuoteInc
                    iQuoteInc = iQuoteInc * -1

                    If (iChar <> 1) And iQuotes = 1 Then    '-- Quote Embedded
                        strField = strField + Chr$(34)
                    End If
                Case Chr$(13), Chr$(ASC_TAB), Chr$(ASC_COMMA)
                    If iQuotes = 1 Then
                        strField = strField + strChar
                    Else
                        If strChar = Chr$(13) Then
                            strChar = Input$(1, #m_iReadFile)
                            iRetVal = ATF_END_OF_RECORD
                        Else
                            iRetVal = ATF_END_OF_FIELD
                        End If

                        Exit Do
                    End If
                Case Else
                    strField = strField + strChar
            End Select
        Else
            Select Case strChar
                Case Chr$(13)                       '-- End Of Record
                    strChar = Input(1, #m_iReadFile)
                    iRetVal = ATF_END_OF_RECORD
                    Exit Do
                Case Chr$(ASC_TAB), Chr$(ASC_COMMA)
                    iRetVal = ATF_END_OF_FIELD
                    Exit Do
                Case Else
                    strField = strField + strChar
            End Select
        End If
    Loop

    ' If we reached the end of a record we may also be at the end of the
    ' file.  Therefore we do a quick check.
    '
    If iRetVal = ATF_END_OF_RECORD Then
        If EOF(m_iReadFile) Then iRetVal = ATF_EOF
    End If

    ReadField = iRetVal
    Exit Function

lblReadFieldErr:
    ReadField = ATF_ERROR
    Exit Function

    Resume Next
End Function

Function ReadRecordANSI (strFields() As String, iFields As Integer) As Integer
'----------------------------------------
'--- ReadRecord -------------------------
'--
'--   Reads an entire record from the file that was specified using
'-- SetReadFileANSI.
'--
'--   Will read until the end of the record regardless of how many records you
'-- specify in iFields.  This guarantees that you always start on the next
'-- record.
'--
'-- Parameters : strFields      Array of strings to contain the field data from
'--                             the file.
'--              iFields        Number of fields to be read.
'--
'-- Return Value : ATF_ERROR
'--                ATF_OK       Returned for all records, including last.
'--                ATF_EOF      Fields returned are empty and file is closed.
'--
'-- Notes: iFields =0 should read ALL fields in a record.
'--
    
    Dim iRetVal As Integer, iField As Integer
    Dim strTemp As String

    If Not IsReadFileOpen() Then
        ReadRecordANSI = ATF_ERROR
        Exit Function
    End If

    ' First we initialize our fields array.
    '
    ReDim strFields(0 To iFields - 1)

    iField = 0
    
    ' If the file is open but we are at the end of the file we either already
    ' read all the records or it is an empty file.  Either way we return
    ' the EOF notice and close the file.
    '
    If EOF(m_iReadFile) Then
        CloseReadFileANSI       '-- Could also reset to start of file
        ReadRecordANSI = ATF_EOF
        Exit Function
    End If

    Do
        iRetVal = ReadField(strTemp)

        If iField <= UBound(strFields) Then
            strFields(iField) = strTemp
            iField = iField + 1
        End If

        Select Case iRetVal
            Case ATF_ERROR
                CloseReadFileANSI
                Exit Do
            Case ATF_EOF
                iRetVal = ATF_OK
                Exit Do
            Case ATF_END_OF_RECORD
                iRetVal = ATF_OK
                Exit Do
            Case ATF_END_OF_FIELD
        End Select
    Loop

    ReadRecordANSI = iRetVal
End Function

Function SetReadFileANSI (strFileName As String) As Integer
'----------------------------------------
'--- SetReadFileANSI --------------------
'--
'--   Sets the file to be used during record reads.  If one is already set
'-- ATF_ALREADY_OPEN is returned
'--

    On Error GoTo lblOpenFileANSIErr

    ' First we verify that a file isn't already open for reading.
    '
    If IsReadFileOpen() Then
        SetReadFileANSI = ATF_ALREADY_OPEN
        Exit Function
    End If

    ' OK - We can attempt to open the file now.
    '
    m_iReadFile = FreeFile

    Open strFileName For Input As m_iReadFile

    ' No error occurred so we set a successful return code and exit.
    '
    SetReadFileANSI = ATF_OK
    Exit Function

lblOpenFileANSIErr:
    ' An error occurred for some reason.  We don't take much care to say what
    ' it was so only ATF_ERROR is returned.
    '
    m_iReadFile = 0
    SetReadFileANSI = ATF_ERROR
    Exit Function

    Resume Next
End Function

Function UnFormatStringANSI (ByVal strData As String) As String
'----------------------------------------
'--- UnFormatStringANSI -----------------
'--
'--   UnFormats a string for use in ANSI table files.  Therefore it acts as
'-- the inverse of FormatANSIString.  Leading and ending spaces are stripped
'-- off the result.
'--
'--      string == UnFormatStringANSI( FormatStringANSI(string) )
'--
'--   Parameters : strData  -   String to be translated from ANSI text format.
'--
'-- Return Value : String containing unformatted version of strData.
'--

    Dim iChar As Integer
    Dim strNew As String, strCopy As String, strChar As String
    
    iChar = 1
    strCopy = Trim(strData)

    ' First we make sure we have a valid string.  After trimming, if there are
    ' less than 2 characters it's definately not special so we get out.
    ' Otherwise, if no leading double quote appears then we still dont have
    ' a special.
    
    If Len(strCopy) < 2 Then Exit Function
    
    If Asc(Left(strCopy, 1)) <> ASC_DBL_QUOTE Then
        UnFormatStringANSI = strCopy
        Exit Function
    End If
    
    ' Time to unformat.  We start by removing the surrounding quotations.  We
    ' should actually test that both are but we live in a ideal world, no?
    
    strCopy = Left(strCopy, Len(strCopy) - 1)
    strCopy = Right(strCopy, Len(strCopy) - 1)

    Do
        strChar = Mid(strCopy, iChar, 1)

        Select Case strChar
            Case Chr(ASC_DBL_QUOTE)
                ' Just skip the next embedded quote (there should be one)
                '
                iChar = iChar + 1
            Case Chr(ASC_LF)
                ' Insert a CR before the line feed.
                '
                strChar = Chr(ASC_CR) + strChar
        End Select

        strNew = strNew + strChar
        iChar = iChar + 1
    Loop While iChar <= Len(strCopy)

    UnFormatStringANSI = strNew
End Function

Function WriteRecordANSI (strFields() As String, iFields)
'--
'-- not implemented yet
'--
End Function

