Parse Furcadia INI files

Character Name

Filename

Colors

Spec

Password

NewWord

Date

Make Mud

FUID

Created

Loggins

Time

Desc

hmmm

huh.ini

[--]

000

whatsit?

them's the headers for the excel sheet.

Dim CharacterName As Integer
Dim ExistsFurcadia As Integer
Dim FurcFileName As Integer
Dim Colors As Integer
Dim Spec As Integer
Dim Password As Integer
Dim NewWord As Integer
Dim LogOnDate As Integer
Dim MakeMud As Integer
Dim Desc As Integer
Dim Email As Integer
Dim FUID As Integer
Dim Created As Integer
Dim Loggins As Integer
Dim TimeOn As Integer

Which permits us to not have the column header numbers hard coded into the program for we do this:

Sub LoadVariables()
Dim iDx
For iDx = 1 To 26
If Cells(1, iDx) = "Character Name" Then CharacterName = iDx
If Cells(1, iDx) = "FF" Then ExistsFurcadia = iDx
If Cells(1, iDx) = "Filename" Then FurcFileName = iDx
If Cells(1, iDx) = "Colors" Then Colors = iDx
If Cells(1, iDx) = "Spec" Then Spec = iDx
If Cells(1, iDx) = "Password" Then Password = iDx
If Cells(1, iDx) = "NewWord" Then NewWord = iDx
If Cells(1, iDx) = "Date" Then LogOnDate = iDx
If Cells(1, iDx) = "Make Mud" Then MakeMud = iDx
If Cells(1, iDx) = "Desc" Then Desc = iDx
If Cells(1, iDx) = "Email" Then Email = iDx
If Cells(1, iDx) = "FUID" Then FUID = iDx
If Cells(1, iDx) = "Created" Then Created = iDx
If Cells(1, iDx) = "Loggins" Then Loggins = iDx
If Cells(1, iDx) = "Time" Then TimeOn = iDx
Next iDx
End Sub

Most of this does not make sense, I know, but that's because I use a mudmaster script which I run about once a month or so to refresh all my alts, just in case I forgot to use one during the past couple of months. The information is gleaned from the script doing a "info" on each alt.

The scanning routine is fixed pointing to furcadia folder And we should show the:

Private Type ply
    Player As String
    File As String
    Colors As String
    Spec As String
    Password As String
    Desc As String
End Type

... first. Notes to ponder, this depends on there being 5 valid fields in the INI file, NAME, PASSWORD, COLORS, DESC, and SPEC, if one's missing, then the silly routine will dump in the previous Furcadia.XX as the value because I don't clear the UserType beforehand.

Sub LoadCharacters()
Dim Work As String, iDx As Integer, FileIn As Integer, Filename As String, Furcadia As ply
Dim FileOb As Object, FurreDate As Date, Aquired As Integer, Token As String
LoadVariables
Set FileOb = CreateObject("Scripting.FileSystemObject")
For iDx = 2 To 999
    If Cells(iDx, CharacterName) = "" Then Exit For
    Cells(iDx, ExistsFurcadia) = ""
Next iDx
Filename = Dir(BaseDir + "*.ini")
FileIn = FreeFile
iDx = 2
Do Until Filename = ""
    Open BaseDir + Filename For Input As FileIn
    Line Input #FileIn, Work
    If InStr(LCase(Work), "v1.6 character") = 1 _
        And InStr(LCase(Filename), "dgprxy_") = 0 _
        And InStr(LCase(Filename), "tmpbot") = 0 Then
' filename
        Furcadia.File = Filename
        Aquired = 0
        Do Until EOF(FileIn)
            Line Input #FileIn, Work
            iDx = InStr(Work, "=")
            If iDx > 0 Then
                Token = LCase(Left(Work, iDx))
                Work = Mid(Work, iDx + 1)
            Else
                Token = "whoops"
            End If
            Select Case Token
' colors
                Case "colors="
                    Aquired = Aquired + 1
                    Furcadia.Colors = "[" + Work + "]"
' name
                Case "name="
                    Aquired = Aquired + 1
                    Furcadia.Player = Work
' password
                Case "password="
                    Aquired = Aquired + 1
                    Furcadia.Password = Work
' desc
                Case "desc="
                    Aquired = Aquired + 1
                    Furcadia.Desc = Work
' spec
                Case "spec="
                    Aquired = Aquired + 1
                    Furcadia.Spec = Work
            End Select
            If Aquired = 5 Then Exit Do
        Loop
        For iDx = 2 To 999
            If Cells(iDx, CharacterName) = "" Then Exit For
            If Cells(iDx, CharacterName) = Furcadia.Player Then Exit For
        Next iDx
        Cells(iDx, 1).Formula = "=IF(EXACT(LOWER(B" + Trim(Str(iDx)) + "),LOWER(B" + Trim(Str(iDx - 1)) _
            + ")),A" + Trim(Str(iDx - 1)) + ",A" + Trim(Str(iDx - 1)) + "+1)"

        Rem The first cell is nothing more than an alt counting cell.

        Cells(iDx, CharacterName).Activate
        Cells(iDx, CharacterName) = Furcadia.Player
        Cells(iDx, FurcFileName) = Furcadia.File
        Cells(iDx, Colors) = Furcadia.Colors
        Cells(iDx, Spec) = Furcadia.Spec
        Cells(iDx, Password) = Furcadia.Password
        Cells(iDx, ExistsFurcadia) = 1

        BreakDesc Furcadia.Desc, iDx
        Rem I break the description into multiple cells because that avoids the error of too much text in a cell.

        FurreDate = FileOb.getfile(BaseDir + Filename).datelastmodified
        Cells(iDx, LogOnDate) = FurreDate
        Close FileIn
    Else
        Close FileIn
    End If
    Filename = Dir
Loop
End Sub

And the final routine, I think, we parse the description based upon COMMA's

Sub BreakDesc(Work As String, iDx As Integer)
Dim pDx As Integer, cDx As Integer, mDx As Integer, hDx As Integer
    mDx = Desc
    Do
        cDx = InStr(Work, ",")
        If pDx + cDx = 0 Then Exit Do
        If cDx <> 0 And pDx <> 0 And hDx <> 0 Then
            If cDx < pDx Then
                Cells(iDx, mDx) = Trim(Left(Work, cDx))
                Work = Mid(Work, cDx + 1)
            Else
                Cells(iDx, mDx) = Trim(Left(Work, pDx))
                Work = Mid(Work, pDx + 1)
            End If
        ElseIf pDx <> 0 Then
            Cells(iDx, mDx) = Trim(Left(Work, pDx))
            Work = Mid(Work, pDx + 1)
        Else
            Cells(iDx, mDx) = Trim(Left(Work, cDx))
            Work = Mid(Work, cDx + 1)
        End If
        mDx = mDx + 1
    Loop
    Cells(iDx, mDx) = Trim(Work)
    mDx = mDx + 1
    Do
        If Cells(1, mDx) = "" Then Exit Do
        Cells(iDx, mDx) = ""
        mDx = mDx + 1
    Loop
End Sub