VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CSVStrings"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Dim Q                   As String * 1
Dim Tstr                As String
Private lDelimeter      As String             'Specifies delimeter to be used. Default is ,

Public Property Let Delimeter(ByVal NewDelimeter As String) 'Sets desired delimeter
  lDelimeter = NewDelimeter
End Property

Public Function ConditionApostrophes(strg As String) As String 'Changes embedded ' to ''
Attribute ConditionApostrophes.VB_Description = "Changes embedded ' to ''"
Dim ans                 As String
  ans = ChangeChar(strg, "''", "'")
  ans = ChangeChar(strg, "'", "''")
  ConditionApostrophes = ans
End Function

Public Function AddString(StartingString As String, AddingString As String) As String 'Returns StartingString,AddingString
Attribute AddString.VB_Description = "Returns StartingString,AddingString"
  If StartingString = "" Then
    AddString = AddingString
  Else
    AddString = StartingString + lDelimeter + AddingString
  End If
End Function

Public Function PrefixString(StartingString As String, AddingString As String) As String 'Returns AddingString,StartingString
Attribute PrefixString.VB_Description = "Returns AddingString,StartingString"
  If StartingString = "" Then
    PrefixString = AddingString
  Else
    PrefixString = AddingString + "," + StartingString
  End If
End Function

Public Function BooleanFrom(d As String, Def As String) As Boolean 'Returns first field in d as a Boolean
Attribute BooleanFrom.VB_Description = "Returns first field in d as a Boolean"
  ' Extract the first boolean from the CSV string, d. A boolean
  ' can be defined by the values -1 or 0 for TRUE or FALSE or by
  ' matching a value supplied in Def. The default value of Def
  ' is T for TRUE. Any string may be supplied and the result will
  ' be TRUE if the input string is found within Def. If multiple
  ' values are supplied in Def, they should be separated by commas.
  ' Care must be taken with a multi-valued Def to ensure that each
  ' value is unique and not included within a FALSE indication.
Dim m                   As String
  If d = "" Then
    BooleanFrom = False
    Exit Function
  End If
  m = UCase$(Trim(Def))                           'get string representation/s of TRUE
  If m = "" Then m = "T"                          'set default representation when needed
  Tstr = StringFrom(d)                            'get first item in string
  Tstr = UCase$(Trim(Tstr))                       'all tests made in upper case
  If Tstr = "-1" Then
    BooleanFrom = True
  ElseIf Tstr = "0" Then
    BooleanFrom = False
  ElseIf InStr(m, Tstr) <> 0 Then
    BooleanFrom = True
  Else
    BooleanFrom = False
  End If
End Function

Public Function ByteFrom(d As String) As Byte     'Returns first field of d as a Byte
Attribute ByteFrom.VB_Description = "Returns first field of d as a Byte"
  On Error GoTo HandleTheError
  ByteFrom = Val(StringFrom(d))
  Exit Function
HandleTheError:
  Err.Raise Err.Number, "", "CSVStrings.ByteFrom: " + Err.Description
  ByteFrom = 0
End Function

Private Function ChangeChar(s As String, C1 As String, C2 As String) As String 'Change all occurances of C1 with C2 in the string S.
Dim ans                 As String                 'result string
Dim l                   As Long                   'position of C1 in Lcl
Dim Lcl                 As String                 'internal copy of S
  Lcl = s
  If Lcl <> "" Then
    l = InStr(Lcl, C1)
  Else
    l = 0
  End If
  While l <> 0
    ans = ans + Left$(Lcl, l - 1) + C2
    Lcl = Right$(Lcl, Len(Lcl) - (l - 1 + Len(C1)))
    l = InStr(Lcl, C1)
  Wend
  ChangeChar = ans + Lcl
End Function

Public Function CharFrom(d As String) As String   'Returns first field of d as a Char
Attribute CharFrom.VB_Description = "Returns first field of d as a Char"
  Tstr = StringFrom(d)
  If Tstr <> "" Then
    CharFrom = Left$(Tstr, 1)
  Else
    CharFrom = Chr(0)
  End If
End Function

Public Function DoubleFrom(d As String) As Double 'Returns first field of d as a Double
Attribute DoubleFrom.VB_Description = "Returns first field of d as a Double"
  On Error GoTo HandleTheError
  DoubleFrom = Val(StringFrom(d))
  Exit Function
HandleTheError:
  Err.Raise Err.Number, "", "CSVStrings.DoubleFrom: " + Err.Description
  DoubleFrom = 0
End Function

Public Function IntegerFrom(d As String) As Integer 'Returns first field of d as an Integer
Attribute IntegerFrom.VB_Description = "Returns first field of d as an Integer"
  On Error GoTo HandleTheError
  IntegerFrom = Val(StringFrom(d))
  Exit Function
HandleTheError:
  Err.Raise Err.Number, "", "CSVStrings.IntegerFrom: " + Err.Description
  IntegerFrom = 0
End Function

Public Function LongFrom(d As String) As Long     'Returns first field of d as an long
  On Error GoTo HandleTheError
  LongFrom = Val(StringFrom(d))
  Exit Function
HandleTheError:
  Err.Raise Err.Number, "", "CSVStrings.LongFrom: " + Err.Description
  LongFrom = 0
End Function

Public Function SingleFrom(d As String) As Single 'Returns first field of d as a Single
Attribute SingleFrom.VB_Description = "Returns first field of d as a Single"
  On Error GoTo HandleTheError
  SingleFrom = Val(StringFrom(d))
  Exit Function
HandleTheError:
  Err.Raise Err.Number, "", "CSVStrings.SingleFrom: " + Err.Description
  SingleFrom = 0
End Function

Public Function StringFrom(d As String) As String 'Returns first field of d as a String
Attribute StringFrom.VB_Description = "Returns first field of d as a String"
  ' Strip the first field from D and return it as OS as well
  ' as returning the remaining contents of d.  A field is delimited by
  ' commas or spaces.  Strings with embedded spaces are delimeted by quote
  ' or apostophe. Apostrophes are indicated by double apostrophes.
Dim Del                 As String
Dim J                   As Long
Dim OS                  As String
  d = Trim(d)
  If Len(d) = 0 Then
    OS = ""                                       'no output if no input available
  Else
    d = ChangeChar(d, "''", "@@@")                'protect any embedded apostrophes
    If InStr(Q + "'", Left$(d, 1)) <> 0 Then      'start quoted string with " or '
      Del = Left$(d, 1)                           'save what started the string
      d = Right$(d, Len(d) - 1)                   'drop the leading quote
      J = InStr(d, Del)                           'look for the End of the string as what started it
      If J = 0 Then                               'no delimeter output all that's left
        OS = d
        d = ""
      Else                                        'found the End of the quoted string
        OS = Left$(d, J - 1)                      'copy out what's between the quotes
        d = Right$(d, Len(d) - J)                 'drop the trailing quote
        If Left$(d, 1) = "," Then                 'and drop any trailing comma
          d = Right$(d, Len(d) - 1)
        End If
      End If
    Else                                          'start unquoted string
      J = InStr(d, lDelimeter)                    'look for the chosen delimeter
      If J = 0 Then                               'no delimeter, output all that's left
        OS = d
        d = ""
      Else                                        'found the delimiter
        OS = Left$(d, J - 1)                      'output what's between
        d = Right$(d, Len(d) - J)                 'delete the trailing delimeter
      End If
    End If
    OS = Trim(OS)                                 'eliminate any leading or trailing blanks
    OS = ChangeChar(OS, "@@@", "''")              'restore embedded apostrophes
    d = ChangeChar(d, "@@@", "''")                'restore embedded apostrophes
    If OS = "''" Then OS = ""
  End If
  StringFrom = OS
End Function

Private Sub Class_Initialize()
  Q = Chr$(34)
  lDelimeter = ","
End Sub