Attribute VB_Name = "GlobalFunctions"
'This constant tells the VB compiler to FORCE us to declare our variables... its optional
Option Explicit

Private Const m_cNAME = "GlobalFunctions"

Public Sub Main()

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".Main"


    Dim sTemp As String

    '01/15/2003 Chris Hill  The first thing we do is setup our standard paths
    g_cDNDONLINEDIR = App.Path & "\"
    g_cSYSGRAPHICSDIR = g_cDNDONLINEDIR & "Graphics\"
    g_cLOGDIR = g_cDNDONLINEDIR & "Logs\"
    g_cMAPDIR = g_cSYSGRAPHICSDIR & "Maps\"
    g_cPORTRAITSDIR = g_cSYSGRAPHICSDIR & "Portraits\"
    'g_cPORTRAITSDIR = g_cSYSGRAPHICSDIR
    g_cONLINEREFDIR = g_cSYSGRAPHICSDIR & "OnlineRef\"
    g_cSOUNDDIR = g_cDNDONLINEDIR & "Sounds\"
    g_cHELPDIR = g_cDNDONLINEDIR & "Help\"
    g_cPLAYERDIR = g_cDNDONLINEDIR & "Players\"
    g_cBACKUPDIR = g_cPLAYERDIR & "Backups\"
    g_cDATADIR = g_cDNDONLINEDIR & "Data\"
    g_cEMOTESDIR = g_cSYSGRAPHICSDIR & "Emotes\"
    'g_cEMOTESDIR = g_cSYSGRAPHICSDIR
    

    'Start the login process
    Call frmLogin.DisplayMe

    'Check to see if this thing is too big... if so then ask them if they want to delete it
    If Dir(g_cDNDONLINEDIR & "DNDOnline_Debug.out") <> "" Then
        If FileLen(g_cDNDONLINEDIR & "DNDOnline_Debug.out") > 5000000 Then
            Call Kill(g_cDNDONLINEDIR & "DNDOnline_Debug.out")
        End If
    End If
    '04/24/2002 Chris Hill  Dido for the network stuff.
    If Dir(g_cDNDONLINEDIR & "FOTANetwork_Debug.out") <> "" Then
        If FileLen(g_cDNDONLINEDIR & "FOTANetwork_Debug.out") > 5000000 Then
            Call Kill(g_cDNDONLINEDIR & "FOTANetwork_Debug.out")
        End If
    End If
    g_bDebugOn = CBool(Trim(GetRegistryValue("DNDOnline", "DebugOn", False)))
    Call WriteToDebug(0, "")
    Call WriteToDebug(0, "")
    Call WriteToDebug(0, "")
    Call WriteToDebug(0, "[STARTING DNDONLINE]")
    
    'randomize the random number buffer
    Call Randomize
    
    'Load in the options from the registry
    Call LoadOptions
    
    '08/05/2002 Chris Hill  Load in our macros!
    If Not Dir(g_cDNDONLINEDIR & "Macros.DAT") = "" Then
        Call g_oOldMacros.Load(g_cDNDONLINEDIR & "Macros.DAT")
    End If
    
    '09/03/2002 Chris Hill  Add in any fonts in the Graphics sub directory.
    If g_bChatRoom_InstallNewFonts = True Then
        Call LoadInAnyNewFonts
    End If
    
    'Set some basic variables
    g_nWhoIsDM = -1 'Their is no DM yet
    g_nRound = -1
    
    'Load in all our e-motes
    Set g_oEmotes = New clsEmotes
    
    'Ok we have done everything we can until they log in...
    'so wait here until they log in
    While IsFormOpen(Forms, "frmLogin") = True
        DoEvents
    Wend
    
    'Ok they closed the frmLogin screen... did they login successfully?
    If frmLogin.m_bLogedIn = True Then
    
        'See if they have any duplicate sessions that might cause Phantom player problems Phantom player problem was something else... but leave this in their anyway
        Call DupSessionsCheck
        'Checks to verify that DNDOnline has all the required files
        Call MissingFilesCheck
        'Check to verify that I turned on the error handling
        Call ErrorHandlingCheck
    
        'Force open the VerChange doc if its a new version
        sTemp = App.Major & "." & App.Minor & "." & App.Revision
        If g_sVerChangeLastLoaded <> sTemp Then
            'This is some clean up work for the 3.0.0 update
            If g_sVerChangeLastLoaded = "3.0.0" Then
                Call DeleteFileIfExists(g_cSYSGRAPHICSDIR & "BM_Token_Normal.BMP")
            End If
            
            g_sVerChangeLastLoaded = sTemp
            Call SaveOptions
            Call frmViewer.LoadInVersionChangesFile
        End If
            
        Call frmMain.Show(vbModeless)
        
        'Why not go ahead and start the ball rolling for them??  Basically we know they HAVE to
        'launch the connect screen.  As soon as the frmVersionChanges is closed...
        'and if they haven't opened a connection yet then show the connections screen!
        While IsFormOpen(Forms, "frmVersionChanges") = True
            DoEvents
        Wend
        If IsFormOpen(Forms, "frmTCPIP_3_23_0") = False And IsFormOpen(Forms, "frmConnectStatus") = False And _
           IsFormOpen(Forms, "frmMain") = True Then
                Call frmTCPIP_3_23_0.Show(vbModeless)
        End If
        
    End If 'end of login check

    
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    If IsFormOpen(Forms, "frmLogin") = True Then
        Call Unload(frmLogin)
    End If
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Sub ' End Main

Public Function LoadInAnyNewFonts()

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".LoadInAnyNewFonts"
    Call WriteProcStart(sRoutineName)
                      

    Dim sFileName As String

    sFileName = Dir(g_cSYSGRAPHICSDIR & "*.TTF", vbNormal)   ' Retrieve the first entry.
    'Are we out of names yet?
    Do While Len(sFileName) > 0
        Call Add32Font(g_cSYSGRAPHICSDIR & sFileName)
        'Get the next entry from the dir statement
        sFileName = Dir
    Loop

    sFileName = Dir(g_cSYSGRAPHICSDIR & "*.FON", vbNormal)   ' Retrieve the first entry.
    'Are we out of names yet?
    Do While Len(sFileName) > 0
        Call Add32Font(g_cSYSGRAPHICSDIR & sFileName)
        'Get the next entry from the dir statement
        sFileName = Dir
    Loop

        
    Call WriteProcStop(sRoutineName) ' "OBJECT")
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Function

Public Function OpenMyRecordset(dbDatabase As ADODB.Connection, sSQL As String) As ADODB.Recordset

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".OpenMyRecordset"
    Call WriteProcStart(sRoutineName) ' sSQL)
                      

    Dim oRSetReturn As New ADODB.Recordset

    oRSetReturn.CursorLocation = ADODB.adUseClient
    oRSetReturn.CursorType = ADODB.adOpenKeyset

    oRSetReturn.LockType = ADODB.adLockOptimistic
    Call oRSetReturn.Open(sSQL, dbDatabase, oRSetReturn.CursorType, ADODB.adLockUnspecified, ADODB.adCmdText)
    Set OpenMyRecordset = oRSetReturn

        
    Call WriteProcStop(sRoutineName) ' "OBJECT")
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Function
Public Sub AddPlayerToCollection(oPlayer As clsPlayer)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".AddPlayerToCollection"
    Call WriteProcStart(sRoutineName) ' "OBJECT")
                      

    Call g_oPlayers.Add(oPlayer, oPlayer.sUnique)
    
    
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Sub
Public Sub ComDlgForNewFont(ByRef oOldFont As StdFont)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".ComDlgForNewFont"
    Call WriteProcStart(sRoutineName) ' "OBJECT")
    

    'Load our current font information into the object
    frmMain.comDialog.FontBold = oOldFont.Bold
    frmMain.comDialog.FontItalic = oOldFont.Italic
    frmMain.comDialog.FontName = oOldFont.Name
    frmMain.comDialog.FontSize = oOldFont.Size
    frmMain.comDialog.FontStrikethru = oOldFont.Strikethrough
    frmMain.comDialog.FontUnderline = oOldFont.Underline

    'Display the font selection screen
    frmMain.comDialog.Flags = cdlCFScreenFonts
    Call frmMain.comDialog.ShowFont

    'Then save them in local variables for easy access
    oOldFont.Bold = frmMain.comDialog.FontBold
    oOldFont.Italic = frmMain.comDialog.FontItalic
    oOldFont.Name = frmMain.comDialog.FontName
    oOldFont.Size = frmMain.comDialog.FontSize
    oOldFont.Strikethrough = frmMain.comDialog.FontStrikethru
    oOldFont.Underline = frmMain.comDialog.FontUnderline


    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Sub
Public Function GetFileNameForNodeName(sFindNodeName As String) As String

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".GetFileNameForNodeName"
    Call WriteProcStart(sRoutineName) ' sFindNodeName)


    Dim nFreeFile As Long
    Dim nChildOf As Long
    Dim sNodeName As String
    Dim sTableName As String
    Dim sMessage As String
    Dim nKey As Long

    If Dir(g_cDATADIR & "OnlineR.DAT") <> "" Then

        nFreeFile = FreeFile
        Open g_cDATADIR & "OnlineR.DAT" For Input As #nFreeFile
        Input #nFreeFile, sMessage

            While EOF(nFreeFile) = False

                Input #nFreeFile, nKey, nChildOf, sNodeName

                'Choose the image for the new node
                If nChildOf < 0 Then
                    Input #nFreeFile, sTableName
                    If sNodeName = sFindNodeName Then
                        GetFileNameForNodeName = sTableName
                        Close #nFreeFile
                        'Exit Function
                        GoTo ExitingFunction
                    End If
                End If
            Wend

        Close #nFreeFile

    End If


ExitingFunction:
    Call WriteProcStop(sRoutineName)
    
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Function
Public Function IsDiceFormat(sStr As String, ByRef nNum As Long, ByRef nDice As Long, ByRef nPlus As Long) As Boolean
    
    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".IsDiceFormat"
    Call WriteProcStart(sRoutineName) ' sStr)


    Dim nWh As Long
    Dim sRight As String
    IsDiceFormat = False
    
    nWh = InStr(1, UCase(sStr), "D")
    If nWh > 0 Then
        If IsNumeric(Left(UCase(sStr), nWh - 1)) = True Then
            nNum = CLng(Left(UCase(sStr), nWh - 1))
            sRight = Mid(UCase(sStr), nWh + 1)
            'Check for a plus
            nWh = InStr(1, sRight, "+")
            If nWh > 0 Then
                If IsNumeric(Left(UCase(sRight), nWh - 1)) = True And _
                   IsNumeric(Mid(UCase(sRight), nWh + 1)) = True Then
                        nDice = CLng(Left(UCase(sRight), nWh - 1))
                        nPlus = CLng(Mid(UCase(sRight), nWh + 1))
                        IsDiceFormat = True
                End If
            ElseIf IsNumeric(sRight) = True Then
                nDice = sRight
                IsDiceFormat = True
            End If
        End If
    End If
    

    Call WriteProcStop(sRoutineName) ' IsDiceFormat, nNum, nDice, nPlus)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
   
End Function
Public Sub PopulateComboWithOnlineRNames(oAddMeItem As Object, sSearchText As String)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".PopulateComboWithOnlineRNames"
    Call WriteProcStart(sRoutineName) ' oAddMeItem.Name, sSearchText)


    Dim nFreeFile As Long
    Dim nChildOf As Long
    Dim sNodeName As String
    Dim sTableName As String
    Dim sMessage As String
    Dim nKey As Long

    If Dir(g_cDATADIR & "OnlineR.DAT") <> "" Then

        nFreeFile = FreeFile
        Open g_cDATADIR & "OnlineR.DAT" For Input As #nFreeFile
        Input #nFreeFile, sMessage

            While EOF(nFreeFile) = False

                Input #nFreeFile, nKey, nChildOf, sNodeName

                'Choose the image for the new node
                If nChildOf < 0 Then
                    Input #nFreeFile, sTableName
                    If InStr(1, sNodeName, sSearchText) > 0 Then
                        Call oAddMeItem.AddItem(sNodeName)
                    End If
                End If
            Wend

        Close #nFreeFile

    End If


    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Sub

Public Sub HideMe(oForm As Form, sName As String)
    
    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".HideMe"
    Call WriteProcStart(sRoutineName) ' oForm.Name, sName)


    Dim i As Long
    Dim nFound As Long
    
    nFound = -1
    For i = 0 To frmMain.mnuHiddenWindow.Count - 1
        If frmMain.mnuHiddenWindow(i).Caption = "" Then
            nFound = i
        End If
    Next i
    If nFound = -1 Then
        Call Load(frmMain.mnuHiddenWindow(frmMain.mnuHiddenWindow.Count))
        nFound = frmMain.mnuHiddenWindow.UBound
    End If
    
    frmMain.mnuHiddenWindow(nFound).Caption = sName
    frmMain.mnuHiddenWindow(nFound).Visible = True
    frmMain.mnuHiddenWindow(nFound).Tag = oForm.Name

    oForm.Visible = False
    frmMain.mnuWindows.Visible = True
    
        
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Sub
'This function unhides a form by name.  It returns weather or not it was hidden.
Public Function UnHideForm(sFormName As String) As Boolean
    
    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".UnHideForm"
    Call WriteProcStart(sRoutineName) ' sFormName)

    
    Dim i As Long

    UnHideForm = False

    If IsFormOpen(Forms, sFormName) = True Then
        For i = 2 To frmMain.mnuHiddenWindow.Count - 1
            If frmMain.mnuHiddenWindow(i).Tag = sFormName Then
                Call UnHideMe(CInt(i))
                UnHideForm = True
            End If
        Next i
    End If

        
    Call WriteProcStop(sRoutineName) ' UnHideForm)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Function
Public Sub UnHideMeIfHidden(sFormName As String)
    
    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".UnHideMe"
    Call WriteProcStart(sRoutineName) ' nIndex)

    
    Dim i As Integer
    
    If IsFormOpen(Forms, sFormName) = True Then
        'See if we hid the battlemap
        For i = 2 To frmMain.mnuHiddenWindow.Count - 1
            If frmMain.mnuHiddenWindow(i).Tag = sFormName Then
                Call UnHideMe(i)
            End If
        Next i
        
        'Now make sure its shown
        For i = 0 To Forms.Count - 1
            If Forms(i).Name = sFormName Then
                Forms(i).Visible = True
            End If
        Next i
    End If

        
    Call WriteProcStop(sRoutineName) ' UnHideForm)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Sub
Public Sub UnHideMe(nIndex As Integer)
    
    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".UnHideMe"
    Call WriteProcStart(sRoutineName) ' nIndex)

    
    Dim i As Long
    Dim bHide As Boolean

    'Add the player to the dm listing if it is open!
    For i = 0 To Forms.Count() - 1
        If Forms(i).Name = frmMain.mnuHiddenWindow(nIndex).Tag Or frmMain.mnuHiddenWindow(nIndex).Caption = "Show All" Then
            Forms(i).Visible = True
        End If
    Next i
    
    If frmMain.mnuHiddenWindow(nIndex).Caption <> "Show All" Then
        frmMain.mnuHiddenWindow(nIndex).Caption = ""
        frmMain.mnuHiddenWindow(nIndex).Visible = False
        frmMain.mnuHiddenWindow(nIndex).Tag = ""
        'All the forms visible?
        bHide = True
        For i = 2 To frmMain.mnuHiddenWindow.Count - 1
            If frmMain.mnuHiddenWindow(i).Tag <> "" Then
                bHide = False
            End If
        Next i
        If bHide = True Then frmMain.mnuWindows.Visible = False
    Else
        frmMain.mnuWindows.Visible = False
        For i = 2 To frmMain.mnuHiddenWindow.Count - 1
            frmMain.mnuHiddenWindow(i).Caption = ""
            frmMain.mnuHiddenWindow(i).Visible = False
            frmMain.mnuHiddenWindow(i).Tag = ""
        Next i
    End If
    
        
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Sub
Public Function GetPlayerForCharacter(sGUID As String) As clsPlayer
    
    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".GetPlayerForCharacter"
    Call WriteProcStart(sRoutineName) ' sGUID)


    Dim i As Long
    For i = 1 To g_oPlayers.Count
        If Not g_oPlayers(i).GetCharacter(sGUID) Is Nothing Then
            Set GetPlayerForCharacter = g_oPlayers(i)
            Exit Function
        End If
    Next i
    
    Set GetPlayerForCharacter = Nothing
    
    
    Call WriteProcStop(sRoutineName) ' "OBJECT")
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
   
End Function
Public Function GetPlayerInCol(nID As Long) As Long
    
    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".GetPlayerInCol"
    Call WriteProcStart(sRoutineName) ' nID)


    Dim i As Long
    For i = 1 To g_oPlayers.Count
        If g_oPlayers(i).nNumber = nID Then
            GetPlayerInCol = i
            GoTo ExitingFunction
            'Exit Function
        End If
    Next i
    
    GetPlayerInCol = -1
    
    
ExitingFunction:
    Call WriteProcStop(sRoutineName) ' GetPlayerInCol)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
   
End Function
Public Sub DupSessionsCheck()
    
    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".DupSessionsCheck"
    Call WriteProcStart(sRoutineName)


    Dim sTitle As String
    Dim iHwnd As Long
    Dim nRetVal As Long
    Dim sMsg As String
     
    'Save the title and set the default values
    sTitle = frmMain.Caption
    'We have to change the title so we don't close ourselves down
    frmMain.Caption = "Checking For Duplicate DNDOnline Sessions..."
    iHwnd = 100 'Anything but 0
    
    'Scan the list of all windows to see if they have any other DNDOnline windows open
    If AreTheirDuplicateSessions(sTitle) = True Then
        
        sMsg = sMsg & "Another session(s) of DNDOnline has been found.  Although this is not " & _
                      "neccesarily a problem it has a high likelyhood of creating a Phantom " & _
                      "Player if your last connection in DNDOnline shut down abnormally.  Do you " & _
                      "wish to kill all other sessions of DNDOnline?"
        
        nRetVal = MsgBox(sMsg, vbCritical + vbYesNo, "Phantom Player Check")
        
        'So close down all the windows if they said yes
        If nRetVal = vbYes Then
            Call CloseDuplicateSessions(sTitle)
            
            'Verify that our cleaning worked
            If AreTheirDuplicateSessions(sTitle) = True Then
                'The forced close down didn't work... tell them that
                sMsg = sMsg & "At least one session of DNDOnline is still open.  More than likely these are hung process and will cause Phantom Players.  Resetting your computer is highly advised."
                Call MsgBox(sMsg, vbOKOnly + vbInformation, "Phantom Player Check")
            End If
            
        End If
    End If
    
    'Fix the title
    frmMain.Caption = sTitle
    
    
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Sub

Private Sub CloseDuplicateSessions(sTitle As String)
    
    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".CloseDuplicateSessions"
    Call WriteProcStart(sRoutineName) ' sTitle)
    
    
    Dim iHwnd As Long
    iHwnd = 100 'Anything but 0
    
    'Scan the list of all windows to see if they have any other DNDOnline windows open
    While iHwnd > 0
        iHwnd = FindWindow(0&, sTitle)
        If iHwnd <> 0 Then
            Call PostMessage(iHwnd, WM_QUIT, 0&, 0&)
        End If
    Wend
    

    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Sub

Private Function AreTheirDuplicateSessions(sTitle As String) As Boolean
    
    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".AreTheirDuplicateSessions"
    Call WriteProcStart(sRoutineName) ' sTitle)
    
    
    Dim iHwnd As Long
    iHwnd = 100 'Anything but 0
    AreTheirDuplicateSessions = False
    
    'Scan the list of all windows to see if they have any other DNDOnline windows open
    While iHwnd > 0 And AreTheirDuplicateSessions = False
        iHwnd = FindWindow(0&, sTitle)
        If iHwnd <> 0 Then AreTheirDuplicateSessions = True
    Wend
    

    Call WriteProcStop(sRoutineName) ' AreTheirDuplicateSessions)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Function


'This is a special function who's purpose is to tell the user IMEDIANTLY that I forgot to turn
'on error checking.  Because of that
Public Sub ErrorHandlingCheck()

    On Error Resume Next
    On Error GoTo ErrorHandler

    Call Err.Raise(1000, "Force it to jump to the handler", "Force it to jump to the handler")

    Call g_oErrors.AddError("The developer forgot to turn on error checking" & _
                            "any errors received will crash DNDOnline.", -1, "DebuggingCheck"): Call g_oErrors.DisplayErrorCount
       
ErrorHandler:
    Call Err.Clear
    
End Sub

Public Sub MissingFilesCheck()

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".MissingFilesCheck"
    Call WriteProcStart(sRoutineName)


    Dim sMsg As String
    Dim bFound As Boolean
    
    sMsg = "You are missing the following files:" & Chr(10) & Chr(13)
    bFound = False
    If Dir(g_cPLAYERDIR & "Template.MDB") = "" Then
        sMsg = sMsg & "      " & g_cPLAYERDIR & "Template.MDB" & Chr(10) & Chr(13)
        bFound = True
    End If
    If Dir(g_cSYSGRAPHICSDIR & "DNDOnline.ico") = "" Then
        sMsg = sMsg & "      " & g_cSYSGRAPHICSDIR & "DNDOnline.ico" & Chr(10) & Chr(13)
        bFound = True
    End If
    If Dir(g_cSYSGRAPHICSDIR & "BubbleI.ico") = "" Then
        sMsg = sMsg & "      " & g_cSYSGRAPHICSDIR & "BubbleI.ico" & Chr(10) & Chr(13)
        bFound = True
    End If
    If Dir(g_cDNDONLINEDIR & "VerChg.TXT") = "" Then
        sMsg = sMsg & "      " & g_cDNDONLINEDIR & "VerChg.TXT" & Chr(10) & Chr(13)
        bFound = True
    End If
    If Dir(g_cDNDONLINEDIR & "EMotes.INI") = "" Then
        sMsg = sMsg & "      " & g_cDNDONLINEDIR & "EMotes.INI" & Chr(10) & Chr(13)
        bFound = True
    End If
    If Dir(g_cDNDONLINEDIR & "Address.BOK") = "" Then
        sMsg = sMsg & "      " & g_cDNDONLINEDIR & "Address.BOK" & Chr(10) & Chr(13)
        bFound = True
    End If
    If Dir(g_cDATADIR & "OnlineR.DAT") = "" Then
        sMsg = sMsg & "      " & g_cDATADIR & "OnlineR.DAT" & Chr(10) & Chr(13)
        bFound = True
    End If
    If Dir(g_cHELPDIR & "Index.DAT") = "" Then
        sMsg = sMsg & "      " & g_cHELPDIR & "Index.DAT" & Chr(10) & Chr(13)
        bFound = True
    End If


    'Did we find any errors
    If bFound = True Then
        sMsg = sMsg & "These missing files indicate an incomplete install and should be corrected."
        Call g_oErrors.AddError(sMsg, -1, sRoutineName): GoTo ErrorHandler
    End If

        
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Sub
'Use this when your not sure if the Character has been created yet but you know his number
Public Function GetCharacter(sGUID As String) As clsCharacter
    
    On Error GoTo DidntFindInMinions
    Set GetCharacter = g_colMinions("#" & sGUID)
    Exit Function
DidntFindInMinions:

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".GetCharacter"
    Call WriteProcStart(sRoutineName) ' sGUID)
    
    
    Dim oLoopPlayer As clsPlayer
    Dim oLoopChar As clsCharacter
    
    'Now check every player for this minion
    For Each oLoopPlayer In g_oPlayers
        For Each oLoopChar In oLoopPlayer.m_colCharacters
            If oLoopChar.sGUID = sGUID Then
                Set GetCharacter = oLoopChar
                Exit Function
            End If
        Next oLoopChar
    Next oLoopPlayer
    
    'Havn't found it yet so return nothing
    Set GetCharacter = Nothing
    

    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Function

Public Function GetCharacterByName(sName As String) As clsCharacter

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".GetCharacterByName"
    Call WriteProcStart(sRoutineName) ' sName)
    
    
    Dim oLoopMinion As clsCharacter
    Dim oLoopPlayer As clsPlayer
    Dim oLoopChar As clsCharacter
    
    'Is it a minion?
    For Each oLoopMinion In g_colMinions
        If oLoopMinion.sName = sName Then
            Set GetCharacterByName = oLoopMinion
            Exit Function
        End If
    Next oLoopMinion
    
    'Now check every player for this minion
    For Each oLoopPlayer In g_oPlayers
        For Each oLoopChar In oLoopPlayer.m_colCharacters
            If oLoopChar.sName = sName Then
                Set GetCharacterByName = oLoopChar
                Exit Function
            End If
        Next oLoopChar
    Next oLoopPlayer
    
    'Havn't found it yet so return nothing
    Set GetCharacterByName = Nothing
    

    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Function


'Use this when your not sure if the player has been created yet but you know his number
Public Function GetPlayer(nNumber As Long) As clsPlayer
    
    On Error GoTo DidntFind
    Set GetPlayer = g_oPlayers("#" & nNumber)
    Exit Function
DidntFind:

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".GetPlayer"
    Call WriteProcStart(sRoutineName) ' nNumber)
    
'Call MsgBox("-Preparing To Add Player: " & nNumber)
    Set GetPlayer = New clsPlayer
    GetPlayer.nNumber = nNumber
    GetPlayer.sUnique = "#" & nNumber
    Call AddPlayerToCollection(GetPlayer)
    

    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Function
Public Sub CreateNewCharacterFile(sNewName As String)
    
    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".CreateNewCharacterFile"
    Call WriteProcStart(sRoutineName)
    
    
    Dim rstChar As ADODB.Recordset
    Dim sTemp As String
    
    sTemp = GetFile(g_cPLAYERDIR, True, "Player (*.PLR)|*.PLR|All Files (*.*)|*.*", True)

    'Check to see... does this players DB exist?
    If Len(Trim(sTemp)) > 0 Then
        Call CopyFile(g_cPLAYERDIR & "Template.mdb", sTemp, True)
    
        'Open the DB so we can check for the correct password
        Set g_oDB = OpenCheckAndUpdateDB(sTemp)
    
        'Open the info and character recordsets(tables) in the DB
        Set rstChar = OpenMyRecordset(g_oDB, "SELECT ""Chracter Name"" FROM CharacterInfo")
        Call rstChar.MoveFirst
        rstChar![Name] = sNewName
        Call rstChar.Update
    End If

    
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Sub

Public Sub WriteToDebug(nNumTabs As Long, sMsg As String)

    On Error Resume Next
    
    Dim sTime As String
    Dim nF As Long
    nF = FreeFile
    
    If g_bDebugOn = True Then
        Open g_cDNDONLINEDIR & "DNDOnline_Debug.Out" For Append As #nF
        
            'Is the message blank?
            If Len(sMsg) = 0 Then
                Print #nF, ""
            Else
                'Calculate the time
                sTime = Date & " " & _
                        Pad(Hour(Now()), "0", 2) & ":" & _
                        Pad(Minute(Now()), "0", 2) & ":" & _
                        Pad(Second(Now()), "0", 2) & "." & _
                        CInt(Timer - (Minute(Now) * 60 + Hour(Now()) * 60 * 60)) & _
                        " " & Right(Now(), 2) & " "
                'Print out the line
                Print #nF, sTime & " " & String(nNumTabs, Chr(9)) & sMsg
            End If
    
        Close #nF
    End If
    
End Sub
Public Sub WriteProcStart(sRoutName As String, Optional vParam1 As Variant = "cBull", _
                                                Optional vParam2 As Variant = "cBull", _
                                                Optional vParam3 As Variant = "cBull", _
                                                Optional vParam4 As Variant = "cBull", _
                                                Optional vParam5 As Variant = "cBull", _
                                                Optional vParam6 As Variant = "cBull", _
                                                Optional vParam7 As Variant = "cBull", _
                                                Optional vParam8 As Variant = "cBull")

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".WriteProcStart"
    
        
    If g_bDebugOn = True Then
    
        Dim sOut As String
        sOut = "EnteringProc[" & sRoutName & "]: "
    
        If vParam1 <> "cBull" Then sOut = sOut & " P1(" & vParam1 & ")"
        If vParam2 <> "cBull" Then sOut = sOut & " P2(" & vParam2 & ")"
        If vParam3 <> "cBull" Then sOut = sOut & " P3(" & vParam3 & ")"
        If vParam4 <> "cBull" Then sOut = sOut & " P4(" & vParam4 & ")"
        If vParam5 <> "cBull" Then sOut = sOut & " P5(" & vParam5 & ")"
        If vParam6 <> "cBull" Then sOut = sOut & " P6(" & vParam6 & ")"
        If vParam7 <> "cBull" Then sOut = sOut & " P7(" & vParam7 & ")"
        If vParam8 <> "cBull" Then sOut = sOut & " P8(" & vParam8 & ")"
    
        'Call WriteToDebug(0, "")
        Call WriteToDebug(0, sOut)
        
    End If
    
    
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Sub
Public Sub WriteProcStop(sRoutName As String, Optional vParam1 As Variant = "cBull", _
                                                Optional vParam2 As Variant = "cBull", _
                                                Optional vParam3 As Variant = "cBull", _
                                                Optional vParam4 As Variant = "cBull", _
                                                Optional vParam5 As Variant = "cBull", _
                                                Optional vParam6 As Variant = "cBull")

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".WriteProcStop"
    
        
    If g_bDebugOn = True Then
    
        Dim sOut As String
        sOut = "ExitingProc[" & sRoutName & "]: "
    
        If vParam1 <> "cBull" Then sOut = sOut & " P1(" & vParam1 & ")"
        If vParam2 <> "cBull" Then sOut = sOut & " P2(" & vParam2 & ")"
        If vParam3 <> "cBull" Then sOut = sOut & " P3(" & vParam3 & ")"
        If vParam4 <> "cBull" Then sOut = sOut & " P4(" & vParam4 & ")"
        If vParam5 <> "cBull" Then sOut = sOut & " P5(" & vParam5 & ")"
        If vParam6 <> "cBull" Then sOut = sOut & " P6(" & vParam6 & ")"
    
        Call WriteToDebug(1, sOut)
        
    End If
    
    
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Sub
Public Function GetFile(sDefault As String, _
                        Optional bShowSave As Boolean = True, _
                        Optional sFilters As String = "All Files (*.*)|*.*", _
                        Optional bLockIn As Boolean = False) As String

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".GetFile"
    Call WriteProcStart(sRoutineName) ' sDefault)
    
        
    Dim sPath As String
    Dim sTemp As String
    Dim sFileName As String
    Dim nWhere As Long
    
    nWhere = InStrRev(sDefault, "\")
    If nWhere > 0 Then
        sPath = Left(sDefault, nWhere - 1)
        sFileName = Mid(sDefault, nWhere + 1)
    Else
        sPath = ""
        sFileName = sDefault
    End If
    
    frmMain.comDialog.Filter = sFilters
    frmMain.comDialog.FileName = sFileName
    frmMain.comDialog.FilterIndex = 1
    frmMain.comDialog.InitDir = sPath
    If bLockIn = True Then
        frmMain.comDialog.Flags = cdlOFNNoChangeDir Or cdlOFNPathMustExist Or cdlOFNFileMustExist
    Else
        frmMain.comDialog.Flags = 0
    End If
    
    If bShowSave = True Then
        Call frmMain.comDialog.ShowSave
    Else
        Call frmMain.comDialog.ShowOpen
    End If
    
    If Len(frmMain.comDialog.FileName) > 0 Then
        'If they locked the file, check the directory
        If bLockIn = True Then
            'First isolate the directory
            nWhere = InStrRev(frmMain.comDialog.FileName, "\")
            If nWhere > 0 Then
                sTemp = Left(frmMain.comDialog.FileName, nWhere - 1)
                GetFile = Mid(frmMain.comDialog.FileName, nWhere + 1)
                
                'Does the path match the one passed in?  No?  Complain and try again.
                If Not sPath = sTemp Then
                    Call MsgBox("Only files in the selected directory can be choosen", vbCritical + vbOKOnly, "File Error")
                    GetFile = GetFile(sDefault, bShowSave, sFilters, bLockIn)
                End If
            'No directory info found, just return the file name
            Else
                GetFile = frmMain.comDialog.FileName
            End If
        ElseIf InStr(1, frmMain.comDialog.FileName, Dir(frmMain.comDialog.FileName)) > 0 Then
            GetFile = frmMain.comDialog.FileName
        Else
            GetFile = ""
        End If
    Else
        GetFile = ""
    End If
                    
    
    Call WriteProcStop(sRoutineName) ' GetFile)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Function
'Get a new random consanit
Public Sub ReloadEmotes()

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".ReloadEmotes"
    Call WriteProcStart(sRoutineName)
    
    
    Dim i As Long
    Dim sTemp As String

    Call g_oEmotes.LoadEmotes
    sTemp = TextToRTF("<Player " & GetPlayer(g_nMyNumber).sName & " Has Re-Loaded Emotes>", _
                        g_nFontAnnouncementColor, g_oFontAnnouncement, False)
                        
    For i = 0 To Forms.Count() - 1
        If Forms(i).Name = "frmChatRoom_3_0_0" Then
            'Send the message to be processed
            Call MakeProcessSendMsg(g_cSendChatMsgCode, Forms(i).m_oCharTalking.sGUID, Forms(i).ChatRoomName, sTemp)
            'Reload the combo box's in chat rooms
            Call Forms(i).LoadEmotes
        End If
    Next i
   
                    
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
            
End Sub
Public Function ValidateTxtNum(txtBox As Object, bTellThem As Boolean) As Boolean

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".ValidateTxtNum"
    Call WriteProcStart(sRoutineName) ' txtBox.Name, bTellThem)


    ValidateTxtNum = IsNumeric(txtBox.Text)
    If ValidateTxtNum = False Then
        If bTellThem = True Then
            Call MsgBox("I'm sorry this field can only contain a number.", vbOKOnly + vbInformation)
        End If
        txtBox.Text = "0"
    End If


    Call WriteProcStop(sRoutineName) ' ValidateTxtNum)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Function
Public Function GetMinion(sGUID As String) As clsCharacter

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".GetMinion"
    Call WriteProcStart(sRoutineName) ' sGUID)


    Dim oLoopMinion As clsCharacter
        
    For Each oLoopMinion In g_colMinions
        If sGUID = oLoopMinion.sGUID Then
            Set GetMinion = oLoopMinion
            Exit Function
        End If
    Next oLoopMinion
    
    Set GetMinion = Nothing
    

    Call WriteProcStop(sRoutineName) ' "OBJECT")
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Function
Public Function GetMinionByName(sName As String) As clsCharacter

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".GetMinionByName"
    Call WriteProcStart(sRoutineName) ' sGUID)


    Dim oLoopMinion As clsCharacter
        
    For Each oLoopMinion In g_colMinions
        If sName = oLoopMinion.sName Then
            Set GetMinionByName = oLoopMinion
            Exit Function
        End If
    Next oLoopMinion
    
    Set GetMinionByName = Nothing
    

    Call WriteProcStop(sRoutineName) ' "OBJECT")
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Function
Public Sub AddMinion(oNewMinion As clsCharacter, Optional bShowMinionsForm As Boolean = True)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".AddMinion"
    Call WriteProcStart(sRoutineName) ' "OBJECT")

    
    Static nMinionID As Long
    nMinionID = nMinionID - 1

    oNewMinion.nCharID = nMinionID
    
    '08/03/2002 Chris Hill  Trying to track the minion problem.
    Call WriteToDebug(2, "Preparing to Add Minon to Global collection ")
    
    Call g_colMinions.Add(oNewMinion, "#" & oNewMinion.sGUID)

    If IsFormOpen(Forms, "frmMinions_3_27_0") = False Then
        '05/10/2002 Chris Hill  As it turns out we don't always want to do this.  So its now optional.
        If bShowMinionsForm = True And oNewMinion.nOwnerNumber = g_nMyNumber Then
            '08/03/2002 Chris Hill  Trying to track the minion problem.
            Call WriteToDebug(2, "Preparing to Open minons form")
            '03/31/2003 Chris Hill  I find it frustrating when this pops up.
            'Call frmMinions_3_27_0.Show
        End If
    Else
        '08/03/2002 Chris Hill  Trying to track the minion problem.
        Call WriteToDebug(2, "Update Minons")
        
        Call frmMinions_3_27_0.UpdateMinions
    End If
    
    '08/03/2002 Chris Hill  Trying to track the minion problem.
    Call WriteToDebug(2, "Add the character")
    
    If oNewMinion.bShowToUsers = True Then
        Call AddCharacter(Nothing, oNewMinion)
    End If
        

    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Sub
Public Sub RemoveCharacter(sGUID As String)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".RemoveCharacter"
    Call WriteProcStart(sRoutineName) ' sGUID)

    
    Dim i As Long
    Dim oPlayer As clsPlayer
    Dim oChar As clsCharacter
    Dim sTemp As String
    Dim oDot As Shape
    
    Set oPlayer = GetPlayerForCharacter(sGUID)
    Set oChar = GetCharacter(sGUID)
    'This may be a minion...
    If oPlayer Is Nothing Then
        Call g_colMinions.Remove("#" & sGUID)
    Else
        Call oPlayer.RemoveCharacter(oChar)
    End If
    
    'Remove the reference on the character sheet
    sTemp = frmCharacter_3_37_0.cboCharacter.GetCurrentSelectedItemsKey()
    Call frmCharacter_3_37_0.cboCharacter.RemoveItemByKeyIfFound(oChar.sGUID)
    '04/18/2002 Chris Hill  A bug here... wasn't checking to see if their was anyone else to pick.
    If sTemp = oChar.sGUID And frmCharacter_3_37_0.cboCharacter.ListCount > 0 Then
        frmCharacter_3_37_0.cboCharacter.ListIndex = 0
    End If
    
    'remove the Character from the listing
    If IsFormOpen(Forms, "frmDMControl") = True Then
        Call frmDMControl.lstCharacters.RemoveItemByKeyIfFound(sGUID)
    End If
    
    'remove the Character from the listing
    If IsFormOpen(Forms, "frmGiveItemToPlayer") = True Then
        Call frmGiveItemToPlayer.lstCharacters.RemoveItemByKeyIfFound(sGUID)
    End If
    
    If IsFormOpen(Forms, "frmBattleMap") = True Then
        Call frmBattleMap.KillCharacter(sGUID)
        Call frmBattleMap.ArrangeUnUsedTokens
    End If
    
    '09/06/2002 Chris Hill  Add our new player to the DMItems screen if its open.
    If IsFormOpen(Forms, "frmDMItems_3_22_0") = True Then
        'Add the player to the list box
        Call frmDMItems_3_22_0.lstCharacters.RemoveItemByKeyIfFound(sGUID)
    End If
    
    'Step through all the chat rooms and remove the Character
    For i = 0 To Forms.Count() - 1
        If Forms(i).Name = "frmChatRoom_3_0_0" Then
            'Set oDot = Forms(i).m_oMapDots.GetControlForKey(sGUID)
            'oDot.Visible = False
            'Forms(i).m_oMapDots.IsInUse(oDot.Index) = False
            'Remove the sending from char as well
            sTemp = Forms(i).cboCharacters.GetCurrentSelectedItemsKey()
            Call Forms(i).cboCharacters.RemoveItemByKeyIfFound(oChar.sGUID)
            If sTemp = oChar.sGUID Then
                Forms(i).cboCharacters.ListIndex = 0
            End If
        End If
    Next 'Move to the next chat room
    
    'Step through all the casting windows and add to the list of targets
    For i = 0 To Forms.Count() - 1
        If Forms(i).Name = "frmSpellCasting" Then
            Call Forms(i).lstTarget.RemoveItemByKeyIfFound(sGUID)
        End If
    Next 'Move to the next chat room
    

    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
        
End Sub
Public Sub RemoveMinion(sGUID As String)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".RemoveMinion"
    Call WriteProcStart(sRoutineName) ' sGUID)


    Call RemoveCharacter(sGUID)

    If IsFormOpen(Forms, "frmMinions_3_27_0") = True Then
        Call frmMinions_3_27_0.UpdateMinions
    End If
    

    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
        
End Sub
Public Sub AddCharacter(oPlayer As clsPlayer, oNewChar As clsCharacter)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".AddCharacter"
    Call WriteProcStart(sRoutineName) ' "OBJECT", "OBJECT")


    Dim i As Long
    
    If Not oPlayer Is Nothing Then
        Call oPlayer.AddCharacter(oNewChar)
        
        'Add the character to the character sheet
        If oPlayer.nNumber = g_nMyNumber Then
            Call frmCharacter_3_37_0.cboCharacter.AddItemWithKey(oNewChar.sName, oNewChar.sGUID)
            
            'Add the new char to the chat room if its your char
            For i = 0 To Forms.Count() - 1
                If Forms(i).Name = "frmChatRoom_3_0_0" Then
                    Call Forms(i).cboCharacters.AddItemWithKey(oNewChar.sName, oNewChar.sGUID)
                End If
            Next i
        End If
    Else
        If oNewChar.nOwnerNumber = g_nMyNumber Then
            'Add the new char to the chat room if its your char
            For i = 0 To Forms.Count() - 1
                If Forms(i).Name = "frmChatRoom_3_0_0" Then
                    Call Forms(i).cboCharacters.AddItemWithKey(oNewChar.sName, oNewChar.sGUID)
                End If
            Next i
        End If
    End If
    
    
    '08/03/2002 Chris Hill  Trying to track the minion problem.
    Call WriteToDebug(3, "Add Minion to the message window invites")
    
    'Step through all the message windows and add to the invites
    For i = 0 To Forms.Count() - 1
        If Forms(i).Name = "frmMessage_3_2_0" Then
            '08/27/2002 Chris Hill  Hazaa!!  Fixed the minion adding problem.  It was using a
            'player here to get the ID when it should have been using the new char's owner id.
            If oNewChar.nOwnerNumber = g_nMyNumber Then
                Call Forms(i).cboMyChars.AddItemWithKey(oNewChar.sName(), oNewChar.sGUID)
            Else
                Call Forms(i).cboTheirCharacters.AddItemWithKey(oNewChar.sName(), oNewChar.sGUID)
            End If
        End If
    Next 'Move to the next chat room
        
    'Add the player to the dm listing
    If IsFormOpen(Forms, "frmDMControl") = True Then
        Call frmDMControl.lstCharacters.AddItemWithKey(oNewChar.sName(), oNewChar.sGUID())
    End If
    
    'Is the battlemap open?
    If IsFormOpen(Forms, "frmBattleMap") = True Then
        '05/10/2002 Chris Hill  We don't want to add a token if its the DM's token.
        If oNewChar.sGUID <> g_cDMMINIONGUID Then
            Call MakeProcessSendMsg(g_cUpdateBMPeiceCode, oNewChar.sGUID, _
                    oNewChar.sCondition, oNewChar.nDirection, oNewChar.nX, oNewChar.nY, "UnUsed")
        End If
    End If
    
    '09/06/2002 Chris Hill  Add our new player to the DMItems screen if its open.
    If IsFormOpen(Forms, "frmDMItems_3_22_0") = True Then
        'Add the player to the list box
        Call frmDMItems_3_22_0.lstCharacters.AddItemWithKey(oNewChar.sName, oNewChar.sGUID)
    End If
    
    '09/06/2002 Chris Hill  Add our new player to the DMItems screen if its open.
    If IsFormOpen(Forms, "frmGiveItemToPlayer") = True Then
        'Add the player to the list box
        Call frmGiveItemToPlayer.lstCharacters.AddItemWithKey(oNewChar.sName, oNewChar.sGUID)
    End If
    
    'Step through all the chat windows and add to the list of targets
    For i = 0 To Forms.Count() - 1
        If Forms(i).Name = "frmSpellCasting" Then
            Call Forms(i).lstTarget.AddItemWithKey(oNewChar.sName, oNewChar.sGUID)
        End If
    Next 'Move to the next chat room
    

    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Sub
Public Sub LoadWithAllChars_OLD(oControl As Object, _
                    Optional bMyStuff As Boolean = False, _
                    Optional bMinionsToo As Boolean = True)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".LoadWithAllChars_OLD"
    Call WriteProcStart(sRoutineName)


    Dim i As Long
    Dim oLoopChar As clsCharacter
    
''Chris
'Dim r As Long
'r = FreeFile
'Open App.Path & "\MattDebug3.out" For Append As #r
'    Print #r, "-----Starting Load Of All Chars-----  MyStuff(" & bMyStuff & ")"
'Close #r
    
    For i = 1 To g_oPlayers.Count
    
''Chris
'r = FreeFile
'Open App.Path & "\MattDebug3.out" For Append As #r
'    Print #r, "     Found Player(" & g_oPlayers(i).nNumber & "," & g_nMyNumber & ") With Name(" & g_oPlayers(i).sName & ")"
'Close #r
    
        'Don't add myself
        If (bMyStuff = False And g_oPlayers(i).nNumber <> g_nMyNumber) Or _
           (bMyStuff = True And g_oPlayers(i).nNumber = g_nMyNumber) Then
                'Walk through all the characters for this player
                For Each oLoopChar In g_oPlayers(i).m_colCharacters
                
''Chris
'r = FreeFile
'Open App.Path & "\MattDebug3.out" For Append As #r
'    Print #r, "          Found Char(" & oLoopChar.sName & ")"
'Close #r

                    'Add the player to the list and store their ID
                    Call oControl.AddItemWithKey(oLoopChar.sName, oLoopChar.sGUID)
                Next oLoopChar
        Else
''Chris
'r = FreeFile
'Open App.Path & "\MattDebug3.out" For Append As #r
'    Print #r, "          Choose not to go into the character loop(" & g_oPlayers(i).m_colCharacters.Count & ")"
'Close #r
        End If
    Next i
    
''Chris
'r = FreeFile
'Open App.Path & "\MattDebug3.out" For Append As #r
'    Print #r, "-----Done-----"
'Close #r
    
    'Load in all our minions
    If bMinionsToo = True Then
        For Each oLoopChar In g_colMinions
            If ( _
                    (oLoopChar.nOwnerNumber = g_nMyNumber And bMyStuff = True) Or _
                    (oLoopChar.nOwnerNumber <> g_nMyNumber And bMyStuff = False) _
                ) _
                And oLoopChar.bShowToUsers = True Then
                        Call oControl.AddItemWithKey(oLoopChar.sName(), oLoopChar.sGUID)
            End If
        Next oLoopChar
    End If


    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Sub

Public Sub LoadWithAllChars(oControl As Object, _
                    Optional bLoadThisPlayersStuff As Boolean = False, Optional bLoadOtherPlayersStuff As Boolean = False, _
                    Optional bLoadCharacters As Boolean = True, Optional bLoadMinions As Boolean = True, Optional bLoadHiddenMinons As Boolean = False)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".LoadWithAllChars"
    Call WriteProcStart(sRoutineName)


    Dim i As Long
    Dim oLoopChar As clsCharacter
    
   
    If bLoadCharacters = True Then
        For i = 1 To g_oPlayers.Count
            If (bLoadOtherPlayersStuff = True And g_oPlayers(i).nNumber <> g_nMyNumber) Or _
            (bLoadThisPlayersStuff = True And g_oPlayers(i).nNumber = g_nMyNumber) Then
                    'Walk through all the characters for this player
                    For Each oLoopChar In g_oPlayers(i).m_colCharacters
                        'Add the player to the list and store their ID
                        Call oControl.AddItemWithKey(oLoopChar.sName, oLoopChar.sGUID)
                    Next oLoopChar
            End If
        Next i
    End If
    
    'Load in all our minions
    If bLoadMinions = True Or bLoadHiddenMinons = True Then
        For Each oLoopChar In g_colMinions
            If ( _
                    (oLoopChar.nOwnerNumber = g_nMyNumber And bLoadThisPlayersStuff = True) Or _
                    (oLoopChar.nOwnerNumber <> g_nMyNumber And bLoadOtherPlayersStuff = True) _
               ) _
               And _
               ( _
                    (oLoopChar.bShowToUsers = True And bLoadMinions = True) Or _
                    (oLoopChar.bShowToUsers = False And bLoadHiddenMinons = True) _
               ) _
                Then
                        Call oControl.AddItemWithKey(oLoopChar.sName(), oLoopChar.sGUID)
            End If
        Next oLoopChar
    End If


    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Sub

Public Sub LoadWithAllPlayers(oListBox As FOTAListControl)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".LoadWithAllPlayers"
    Call WriteProcStart(sRoutineName) ' "OBJECT")


    Dim i As Long

    Call oListBox.Clear
    
    'Step through all links, 0 is the Host
    For i = 1 To g_oPlayers.Count
        'Don't add me... I'm already in the chat room!
        If g_oPlayers(i).nNumber <> g_nMyNumber Then
            'Add the player to the list and store their ID
            Call oListBox.AddItemWithKey(g_oPlayers(i).PlayerName, CStr(g_oPlayers(i).nNumber))
        End If
    Next i 'Next active patient


    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Sub
Public Sub MinionsTakeTurn()

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".MinionsTakeTurn"
    Call WriteProcStart(sRoutineName)
    
    
    Dim oLoopMinion As clsCharacter
    Dim oLoopPlayer As clsPlayer
    Dim oChar As clsCharacter
    Dim colAllChars As New Collection
    
    'Gather a list of all characters
    For Each oLoopPlayer In g_oPlayers
        For Each oLoopMinion In oLoopPlayer.m_colCharacters
            Call colAllChars.Add(oLoopMinion)
        Next oLoopMinion
    Next oLoopPlayer
    For Each oLoopMinion In g_colMinions
        Call colAllChars.Add(oLoopMinion)
    Next oLoopMinion
    
    'Now step through all minions and take their turn...
    For Each oLoopMinion In g_colMinions
        'Is this minion ready to attack?
        If oLoopMinion.bCombatAIOn = True And oLoopMinion.sState = "Normal" Then
            'Find a target
            Set oChar = oLoopMinion.AI_SelectCombatTarget(colAllChars)
            'Did they find a target?
            If Not oChar Is Nothing Then
                'Attack!  Incidently this call officially breaks the independence
                'of the character class.  It is now iremoviably tied to FOTATools.
                Call oLoopMinion.AI_Attack(oChar, frmBattleMap.m_nPixelsEqualingAFoot, g_nRound)
            End If
        End If
    Next oLoopMinion
    
    
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Sub
'Save all our options back to the registry
Public Sub SaveOptions()

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".SaveOptions"
    Call WriteProcStart(sRoutineName)
    
    
    Dim oINIFile As New clsFOTAINIHandler
    
    Call oINIFile.OpenINIFile(g_cDNDONLINEDIR & "DNDOnline.INI")
    'Save the sound settings
    Call oINIFile.AddValue("Sound", CStr(g_bSound_Sound))
    Call oINIFile.AddValue("SendSound", g_sSound_SendSound)
    Call oINIFile.AddValue("ReceiveSound", g_sSound_ReceiveSound)
    Call oINIFile.AddValue("EnterSound", g_sSound_EnterSound)
    Call oINIFile.AddValue("ExitSound", g_sSound_ExitSound)
    
    'Turned off debugging... its suddenly VERY slow.
    Call oINIFile.AddValue("DebugOn", CStr(g_bDebugOn))
    
    Call oINIFile.AddValue("AlwaysLoadChar", CStr(g_bAlwaysLoadChar))
    Call oINIFile.AddValue("LastLoadedChar", g_sLastLoadedChar)
    Call oINIFile.AddValue("SupressFonts", CStr(g_bSupressFonts))
    Call oINIFile.AddValue("SupressColors", CStr(g_bSupressColors))
    Call oINIFile.AddValue("YouTypeDelay", CStr(g_nYouTypeDelay))
    Call oINIFile.AddValue("TheyListenDelay", CStr(g_nTheyListenDelay))
    Call oINIFile.AddValue("BroadcastTyping", CStr(g_bBroadcastTyping))
    Call oINIFile.AddValue("AutoAttackIM", CStr(g_bAutoAttackIM))
    Call oINIFile.AddValue("AutoAttackAutoDamage", CStr(g_bAutoAttackAutoDamage))
    Call oINIFile.AddValue("StartWithHiddenCharSheet", CStr(g_bStartWithHiddenCharSheet))
    
    'Save the saving data
    Call oINIFile.AddValue("Save", CStr(g_bSave))
    'Call oINIFile.AddValue("WhereToSave", g_sWhereToSave)
    Call oINIFile.AddValue("ReplayXLines", CStr(g_nReplayXLines))
    Call oINIFile.AddValue("BackupDB", CStr(g_bBackupDB))
    
    'Save the settings they just entered
    Call oINIFile.AddValue("NameFontBold", CStr(g_oFontName.Bold))
    Call oINIFile.AddValue("NameFontItalic", CStr(g_oFontName.Italic))
    Call oINIFile.AddValue("NameFontName", g_oFontName.Name)
    Call oINIFile.AddValue("NameFontSize", CStr(g_oFontName.Size))
    Call oINIFile.AddValue("NameFontStrikeThru", CStr(g_oFontName.Strikethrough))
    Call oINIFile.AddValue("NameFontUnderline", CStr(g_oFontName.Underline))
    Call oINIFile.AddValue("NameFontColor", CStr(g_nFontNameColor))
    
    'Save the settings they just entered
    Call oINIFile.AddValue("SuppressFontBold", CStr(g_oFontSuppress.Bold))
    Call oINIFile.AddValue("SuppressFontItalic", CStr(g_oFontSuppress.Italic))
    Call oINIFile.AddValue("SuppressFontName", g_oFontSuppress.Name)
    Call oINIFile.AddValue("SuppressFontSize", CStr(g_oFontSuppress.Size))
    Call oINIFile.AddValue("SuppressFontStrikeThru", CStr(g_oFontSuppress.Strikethrough))
    Call oINIFile.AddValue("SuppressFontUnderline", CStr(g_oFontSuppress.Underline))
    Call oINIFile.AddValue("SuppressFontColor", CStr(g_nFontSuppressColor))
    
    'Chat room options
    Call oINIFile.AddValue("MyLinesInChat", CStr(g_nChatRoom_LinesInChat))
    '06/10/2002 Chris Hill  This option will help new players learn which char belongs to who.
    Call oINIFile.AddValue("ShowCharNamesInChat", CStr(g_bChatRoom_ShowCharNames))
    '06/26/2002 Chris Hill  This option is to address Dustin's bug... I hope.
    Call oINIFile.AddValue("ChatRoom_ForceScroll", CStr(g_bChatRoom_BugFixForceScroll))
    '09/03/2002 Chris Hill  This option controls when we do and don't load in new fonts
    Call oINIFile.AddValue("ChatRoom_InstallNewFonts", CStr(g_bChatRoom_InstallNewFonts))
    '10/16/2002 Chris Hill  Damn it Dustin, sometimes your a pain in the ass.
    Call oINIFile.AddValue("ChatRoom_MinimumMacroButtonSize", CStr(g_bChatRoom_MinimumMacroButtonSize))
    
    'VerChange options
    Call oINIFile.AddValue("VerChgLastLoaded", g_sVerChangeLastLoaded)
    
    'Overland Map Options
    Call oINIFile.AddValue("ShowAllLabels", CStr(g_bShowAllLabels))
    
    'Spellcasting options
    Call oINIFile.AddValue("Cast_Filter", CStr(g_nCast_FilterDefault))
    Call oINIFile.AddValue("Cast_Level", g_sCast_LevelDefault)
    Call oINIFile.AddValue("Cast_Mage", CStr(g_bCast_Mage))
    Call oINIFile.AddValue("Cast_Priest", CStr(g_bCast_Priest))
    Call oINIFile.AddValue("Cast_AutoSend", CStr(g_bCast_AutoSend))
    Call oINIFile.AddValue("Cast_MarkOff", CStr(g_bCast_MarkOff))
    Call oINIFile.AddValue("Cast_SortColumn", CStr(g_nCast_SortColumn))
        
    'DMItems Options
    Call oINIFile.AddValue("DMItems_AutomaticallyUpdate", CStr(g_bDMItems_AutomaticallyUpdate))
        
    'BM Options
    Call oINIFile.AddValue("BM_HideLabelInformation", CStr(g_bBM_HideLabelInformation))
        
    'CM Options
    Call oINIFile.AddValue("bCM_ShowMiniNames", CStr(g_bCM_ShowMiniNames))
    Call oINIFile.AddValue("bCM_KeepAspectRatios", CStr(g_bCM_KeepAspectRatios))
    Call oINIFile.AddValue("nCM_FOWBrushSize", CStr(g_nCM_FOWBrushSize))
    Call oINIFile.AddValue("bCM_FOWTransparent", CStr(g_bCM_FOWTransparent))
    Call oINIFile.AddValue("bCM_FOWShowTerrain", CStr(g_bCM_FOWShowTerrain))
       
        
    Call oINIFile.SaveINIFile(g_cDNDONLINEDIR & "DNDOnline.INI")
        
        
    'Exit the Function... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Sub ' End of SaveOptions
'Load in all your settings
Public Sub LoadOptions()

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".LoadOptions"
    Call WriteProcStart(sRoutineName)
    
    
    Dim oINIFile As New clsFOTAINIHandler
    Dim i As Long
    
    'Ok fine this isn't a registry option... but its still important
    Set g_oFontDefault = GetFont("Times New Roman", "10", False, False, False, False)
    '03/18/2003 Chris Hill  This is a check to hopefully determine why Matt's minions are created so wierdly.
    If Not g_oFontDefault.Name = "Times New Roman" Then
        'Chris
        'i = FreeFile
        'Open App.Path & "\MattDebug3.out" For Append As #i
        '    Print #i, "Default font <Times new Roman> was not found, setting to " & g_oFontDefault.Name
        'Close #i
    End If
    
    g_nFontDefaultColor = 0
    Set g_oFontAnnouncement = GetFont("Times New Roman", "10", True, False, False, False)
    g_nFontAnnouncementColor = 0
    
        
    If Dir(g_cDNDONLINEDIR & "DNDOnline.INI") = "" Then
        Call oINIFile.SaveINIFile(g_cDNDONLINEDIR & "DNDOnline.INI")
    End If
        
    Call oINIFile.OpenINIFile(g_cDNDONLINEDIR & "DNDOnline.INI")
    
    'Load in the sound settings
    g_bSound_Sound = CBool(Trim(oINIFile.GetValueForKey("Sound", True)))
    g_sSound_SendSound = oINIFile.GetValueForKey("SendSound", "")
    g_sSound_ReceiveSound = oINIFile.GetValueForKey("ReceiveSound", "")
    g_sSound_EnterSound = oINIFile.GetValueForKey("EnterSound", "")
    g_sSound_ExitSound = oINIFile.GetValueForKey("ExitSound", "")
    
    'Load the settings from the registry
    g_bDebugOn = CBool(Trim(oINIFile.GetValueForKey("DebugOn", False)))

    g_bAlwaysLoadChar = CBool(Trim(oINIFile.GetValueForKey("AlwaysLoadChar", False)))
    g_sLastLoadedChar = oINIFile.GetValueForKey("LastLoadedChar", "")
    g_bSupressFonts = CBool(Trim(oINIFile.GetValueForKey("SupressFonts", False)))
    g_bSupressColors = CBool(Trim(oINIFile.GetValueForKey("SupressColors", False)))
    g_nYouTypeDelay = oINIFile.GetValueForKey("YouTypeDelay", "2000")
    g_nTheyListenDelay = CLng(oINIFile.GetValueForKey("TheyListenDelay", "3000"))
    g_bBroadcastTyping = CBool(Trim(oINIFile.GetValueForKey("BroadcastTyping", True)))
    g_bAutoAttackIM = CBool(Trim(oINIFile.GetValueForKey("AutoAttackIM", False)))
    g_bAutoAttackAutoDamage = CBool(Trim(oINIFile.GetValueForKey("AutoAttackAutoDamage", True)))
    
    'Load options
    g_bSave = CBool(Trim(oINIFile.GetValueForKey("Save", True)))
    
    'Chris  Don't forget to turn this back on again
    'g_sWhereToSave = Trim(oINIFile.GetValueForKey("WhereToSave", "\Logs\"))
    'g_sWhereToSave = "\Logs\"
    
    g_nReplayXLines = Trim(oINIFile.GetValueForKey("ReplayXLines", "50"))
    g_bBackupDB = CBool(Trim(oINIFile.GetValueForKey("BackupDB", True)))
    
    g_bStartWithHiddenCharSheet = CBool(Trim(oINIFile.GetValueForKey("StartWithHiddenCharSheet", False)))
    
    'Load in your font settings for names
    Set g_oFontName = GetFont( _
                oINIFile.GetValueForKey("NameFontName", "Times New Roman"), _
                oINIFile.GetValueForKey("NameFontSize", "8"), _
                CBool(Trim(oINIFile.GetValueForKey("NameFontBold", False))), _
                CBool(Trim(oINIFile.GetValueForKey("NameFontItalic", False))), _
                CBool(Trim(oINIFile.GetValueForKey("NameFontStrikeThru", False))), _
                CBool(Trim(oINIFile.GetValueForKey("NameFontUnderline", False))))
    g_nFontNameColor = oINIFile.GetValueForKey("NameFontColor", "0")
     
    'Load in your font settings for suppress
    Set g_oFontSuppress = GetFont( _
                oINIFile.GetValueForKey("SuppressFontName", "Times New Roman"), _
                oINIFile.GetValueForKey("SuppressFontSize", "8"), _
                CBool(Trim(oINIFile.GetValueForKey("SuppressFontBold", False))), _
                CBool(Trim(oINIFile.GetValueForKey("SuppressFontItalic", False))), _
                CBool(Trim(oINIFile.GetValueForKey("SuppressFontStrikeThru", False))), _
                CBool(Trim(oINIFile.GetValueForKey("SuppressFontUnderline", False))))
    g_nFontSuppressColor = oINIFile.GetValueForKey("SuppressFontColor", "0")
    
    'Chat Options
    g_nChatRoom_LinesInChat = oINIFile.GetValueForKey("MyLinesInChat", "75")
    '06/26/2002 Chris Hill  This option was a disaster... disable it for now.
    g_bChatRoom_ShowCharNames = False
    '06/26/2002 Chris Hill  This option is to address Dustin's bug... I hope.
    g_bChatRoom_BugFixForceScroll = CBool(Trim(oINIFile.GetValueForKey("ChatRoom_ForceScroll", "False")))
    '09/03/2002 Chris Hill  This option controls when we do and don't load in new fonts
    g_bChatRoom_InstallNewFonts = CBool(Trim(oINIFile.GetValueForKey("ChatRoom_InstallNewFonts", "TRUE")))
    '10/16/2002 Chris Hill  Damn it Dustin, sometimes your a pain in the ass.
    g_bChatRoom_MinimumMacroButtonSize = CBool(Trim(oINIFile.GetValueForKey("ChatRoom_MinimumMacroButtonSize", "FALSE")))
        
    'VerChange options
    g_sVerChangeLastLoaded = oINIFile.GetValueForKey("VerChgLastLoaded", "0.0.0")
    
    'Spellcasting options
    g_nCast_FilterDefault = oINIFile.GetValueForKey("Cast_Filter", 1)
    g_sCast_LevelDefault = oINIFile.GetValueForKey("Cast_Level", "All")
    g_bCast_Mage = CBool(Trim(oINIFile.GetValueForKey("Cast_Mage", "True")))
    g_bCast_Priest = CBool(Trim(oINIFile.GetValueForKey("Cast_Priest", "True")))
    g_bCast_AutoSend = CBool(Trim(oINIFile.GetValueForKey("Cast_AutoSend", "True")))
    g_bCast_MarkOff = CBool(Trim(oINIFile.GetValueForKey("Cast_MarkOff", "True")))
    g_nCast_SortColumn = Trim(oINIFile.GetValueForKey("Cast_SortColumn", "3"))
    
    'DMItem Options
    g_bDMItems_AutomaticallyUpdate = CBool(Trim(oINIFile.GetValueForKey("DMItems_AutomaticallyUpdate", True)))
            
    'BM Options
    g_bBM_HideLabelInformation = CBool(Trim(oINIFile.GetValueForKey("BM_HideLabelInformation", False)))
    g_bShowAllLabels = CBool(Trim(oINIFile.GetValueForKey("ShowAllLabels", "False")))
    
    'CM Options
    g_bCM_ShowMiniNames = CBool(Trim(oINIFile.GetValueForKey("bCM_ShowMiniNames", True)))
    g_bCM_KeepAspectRatios = CBool(Trim(oINIFile.GetValueForKey("bCM_KeepAspectRatios", False)))
    g_nCM_FOWBrushSize = CLng(Trim(oINIFile.GetValueForKey("nCM_FOWBrushSize", 1)))
    g_bCM_FOWTransparent = CBool(Trim(oINIFile.GetValueForKey("bCM_FOWTransparent", True)))
    g_bCM_FOWShowTerrain = CBool(Trim(oINIFile.GetValueForKey("bCM_FOWShowTerrain", True)))
    
    
    'Exit the Function... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Set oINIFile = Nothing
    If Right(Err.Description, Len("was not a valid FOTA INI file, it was empty")) = "was not a valid FOTA INI file, it was empty" Then
        Call Kill(g_cDNDONLINEDIR & "DNDOnline.INI")
    End If
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Sub ' End of LoadOptions

Public Function GetCombatMap(sGUID As String) As frmCombatMap

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".GetCombatMap"
    Call WriteProcStart(sRoutineName) ' nID)


    Dim i As Long
    Set GetCombatMap = Nothing

    'First thing first, see if we have this CM already open
    For i = 0 To Forms.Count() - 1
        If Forms(i).Name = "frmCombatMap" Then
            If Forms(i).GUID = sGUID Then
                Set GetCombatMap = Forms(i)
                i = Forms.Count()
            End If
        End If
    Next i

    
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Function

Public Function GetControlsIndex(oControl As Object) As String

    On Error Resume Next
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".GetControlsIndex"
    Call WriteProcStart(sRoutineName) ' "OBJECT")


    GetControlsIndex = ""
    GetControlsIndex = oControl.Index
    
    
    Call WriteProcStop(sRoutineName)
            
End Function
'By passing this function the ID of the person your removing, it will remove
'them from the listing and blank their name
Public Sub RemovePlayer(nID As Long)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".RemovePlayer"
    Call WriteProcStart(sRoutineName) ' nID)


    Dim i As Long
    Dim nWhereIn As Long
    Dim sPlayName As String
    Dim sPlayNameVer As String
    Dim oChar As clsCharacter
   
    'Step through all the characters for this player and remove them
    For Each oChar In GetPlayer(nID).m_colCharacters
        Call RemoveCharacter(oChar.sGUID())
    Next oChar
   
    If g_nWhoIsDM = nID Then
        Call SetAttributes(frmConnectStatus.chkIAmTheDM, True)
    End If
   
    'Store the location of the begginging of the name
    sPlayName = GetPlayer(nID).PlayerName
    sPlayNameVer = GetPlayer(nID).PlayerName(True)
    'sPlayName = Pad(nID, " ", 2) & ".)   " & g_saPlayerName(nID) & "          " & g_saPlayerVer(nID)

    'Is their name italisized?  Is their name in their!?!?
    Call frmConnectStatus.rtbPlayers.SetProperties(sPlayNameVer, 0, False)
     
    'Remove the player from the listing
    Call frmConnectStatus.rtbPlayers.RemoveMessage(GetPlayer(nID).PlayerName(True), True)
    
    'Turn off his type timer if it was on
    '04/18/2002 Chris Hill  This was causing a 'Control Element X Not Found' because you don't create
    'a timer for yourself.  But now with the new FOTANetwork control you do remove yourself.
    If Not nID = g_nMyNumber Then
        frmConnectStatus.TypeTimer(nID).Enabled = False
    End If
         
    'Step through all the chat rooms and remove the player
    For i = 0 To Forms.Count() - 1
        If Forms(i).Name = "frmChatRoom_3_0_0" Then
            'Remove the player from the list box
            Call Forms(i).lstInvites.RemoveItemByKeyIfFound(CStr(nID))
            Call Forms(i).rtbPlayers.RemoveMessage(sPlayName, True)
                 
            'Inform everyone
            Call Forms(i).rtbChat.AddTextMessage("<Player " & GetPlayer(nID).sName & " Has Left DNDOnline>", g_nFontAnnouncementColor, g_oFontAnnouncement)
        End If
    Next i
     
    '09/06/2002 Chris Hill  If the DMItems screen is open remove all our chars.
    If IsFormOpen(Forms, "frmDMControl") = True Then
        For i = 0 To frmDMControl.lstCharacters.ListCount - 1
            If i > frmDMControl.lstCharacters.ListCount - 1 Then Exit For
            
            Set oChar = GetCharacter(frmDMControl.lstCharacters.KeyForIndex(i))
            If Not oChar Is Nothing Then
                If oChar.nOwnerNumber = nID Then
                    Call frmDMControl.lstCharacters.RemoveItem(i)
                End If
            End If
        Next i
    End If
     
    'Step through all the message windows and add to the invites
    For i = 0 To Forms.Count() - 1
        If Forms(i).Name = "frmMessage_3_2_0" Then
            'Remove the player to the list box
            Call Forms(i).cboTheirCharacters.RemoveItemByKeyIfFound(CStr(nID))
        End If
    Next 'Move to the next chat room
        
    'Step through all the message windows and add remove from the invites
    For i = 0 To Forms.Count() - 1
        If Forms(i).Name = "frmFileTransfer_3_11_0" Then
            'Remove the player to the list box
            Call Forms(i).lstWhoToSendTo.RemoveItemByKeyIfFound(CStr(nID))
        End If
    Next 'Move to the next chat room
    
    'Blank their name
    Call g_oPlayers.Remove("#" & Trim(CStr(nID)))
    
    'Play the sound to anounce their leaving
    Call frmConnectStatus.PlayWavFile(g_sSound_ExitSound)
    
    
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
            
End Sub ' End of RemovePlayer

'If you pass in a name and a valid ID, this player will be added.  Passing in
'the same player twice can be bad.
Public Sub AddPlayer(sName As String, nID As Long, sVer As String)
            
    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".AddPlayer"
    Call WriteProcStart(sRoutineName)
    

    Dim sNewPlayName As String
    Dim oPlayer As clsPlayer
    Dim sTemp As String
    Dim i As Long, n As Long
    Dim oLoopMinion As clsCharacter
    Dim oLoopChar As clsCharacter
    
    'Assign to this player his name!
    Set oPlayer = GetPlayer(nID)
    oPlayer.sName = sName
    oPlayer.sVersion = sVer
    oPlayer.nNumber = nID
    oPlayer.sUnique = "#" & Trim(CStr(nID))
    
    'Open up a type check timer control.... Do we have to load it first?
    Call frmConnectStatus.CheckAndCreateTimer(nID)
    
    sNewPlayName = oPlayer.PlayerName
                        
    'Add the name to the listing, store the location of the begginging of the name
    '06/10/2002 Chris Hill  This option will help new players learn which char belongs to who.
    sTemp = oPlayer.PlayerName(True)
    'If g_bChatRoom_ShowCharNames = True Then
    '    sTemp = sTemp & "   ("
    '    For Each oLoopChar In oPlayer.m_colCharacters
    '        sTemp = sTemp & oLoopChar.sName & ","
    '    Next oLoopChar
    '    sTemp = Left(sTemp, Len(sTemp) - 1) 'Strip off the last ,
    '    sTemp = sTemp & ")"
    'End If
    Call frmConnectStatus.rtbPlayers.AddTextMessage(sTemp, 0)
            
    If Not nID = g_nMyNumber Then
        'We also have to send the new guy our characters
        For Each oLoopChar In GetPlayer(g_nMyNumber).m_colCharacters
            'Now send the character out.
            
''Chris
'i = FreeFile
'Open App.Path & "\MattDebug3.out" For Append As #i
'    Print #i, "Sending Inital Char(" & oLoopChar.sName & "," & oPlayer.nNumber & ") because Player(" & oPlayer.sName & ") joined"
'Close #i
            Call MakeProcessSendMsg(g_cSerizlizedCharacterCode, _
                g_nMyNumber, oLoopChar.sGUID, oLoopChar.Serialize(), "True")
        Next oLoopChar
    End If
            
            
''Chris
'i = FreeFile
'Open App.Path & "\MattDebug3.out" For Append As #i
'    Print #i, "Stepping through Chat Rooms To Add Player"
'Close #i
    'Step through all the chat rooms and add to the invites
    For i = 0 To Forms.Count() - 1
    
''Chris
'n = FreeFile
'Open App.Path & "\MattDebug3.out" For Append As #n
'    Print #n, "     Found Form(" & Forms(i).Name & ")"
'Close #n
        If Forms(i).Name = "frmChatRoom_3_0_0" Then
        
''Chris
'n = FreeFile
'Open App.Path & "\MattDebug3.out" For Append As #n
'    Print #n, "          Adding player(" & sNewPlayName & ") To Chat Room"
'Close #n
            'Add the player to the list box
            Call Forms(i).lstInvites.AddItemWithKey(sNewPlayName, CStr(nID))
            'Inform the chat room
            '04/24/2002 Chris Hill  Fixed it so that emotes don't fire on system messages.
            Call Forms(i).rtbChat.AddTextMessage("<Player " & GetPlayer(CLng(nID)).sName & " Has Joined DNDOnline>", g_nFontAnnouncementColor, g_oFontAnnouncement)
            'Do we auto-invite to the chatroom?
            If Forms(i).chkAutoInviteIn.Value = vbChecked Then
                Call MakeProcessSendMsg(g_cInviteToChatCode, nID, Forms(i).ChatRoomName)
            End If
        End If
    Next 'Move to the next chat room
                
    'Step through all the message windows and add to the invites
    For i = 0 To Forms.Count() - 1
        If Forms(i).Name = "frmMessage_3_2_0" Then
            'Add the player to the list box
            Call Forms(i).cboTheirCharacters.AddItemWithKey(sName, CStr(nID))
        End If
    Next 'Move to the next chat room
    
    'Step through all the file transfer windows and add to the invites
    For i = 0 To Forms.Count - 1
        If Forms(i).Name = "frmFileTransfer_3_11_0" Then
            'Add the player to the list box
            Call Forms(i).lstWhoToSendTo.AddItemWithKey(sName, CStr(nID))
        End If
    Next 'Move to the next chat room
    
    'Also pass down that we think we are the DM
    If frmConnectStatus.chkIAmTheDM.Value = vbChecked Then
        'Pass to the network that I think I am the DM
        Call MakeProcessSendMsg(g_cIAmTheDMCode, Pad(g_nMyNumber, " ", 2))
    End If

    'I have to tell the player about all my minions
    For Each oLoopMinion In g_colMinions
        '06/06/2002 Chris Hill  We also need to send the minion if its the DM minion and we are the host.
        If oLoopMinion.nOwnerNumber = g_nMyNumber Or (oLoopMinion.sGUID = g_cDMMINIONGUID And g_bAmIHost = True) Then
            If Len(oLoopMinion.sName()) = 0 Then
                sName = "[No Name]"
            Else
                sName = oLoopMinion.sName()
            End If
''Chris
'i = FreeFile
'Open App.Path & "\MattDebug3.out" For Append As #i
'    Print #i, "Sending Inital Minion(" & oLoopMinion.sName & ") because Player(" & oPlayer.sName & ") joined"
'Close #i
            
            Call MakeProcessSendMsg(g_cSerizlizedMinionCode, oLoopMinion.sGUID, oLoopMinion.Serialize())
        End If
    Next oLoopMinion
    
    'Give him a BattleMap update if we are host and the map is open
    If IsFormOpen(Forms, "frmBattleMap") = True And g_bAmIHost = True Then
        Call MakeProcessSendMsg(g_cLoadBMCode, frmBattleMap.sMapName)
    End If
    
    'Give him a Combat Map update if we are host and the map is open
    If IsFormOpen(Forms, "frmCombatMap") = True And g_bAmIHost = True Then
        For i = 0 To Forms.Count - 1
            If Forms(i).Name = "frmCombatMap" Then
                Call MakeProcessSendMsg(g_cStartCMCode, Forms(i).GUID())
                Call MakeProcessSendMsg(g_cCMUpdateCode, Forms(i).GUID(), Forms(i).SerializeCombatMap())
            End If
        Next i
    End If
        
    'Play the sound to anounce their arrival
    Call frmConnectStatus.PlayWavFile(g_sSound_EnterSound)
            
            
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
            
End Sub
'08/27/2002 Chris Hill  Make picture loading standardized.
Public Function LoadAPicture(Optional sPath As String = "", Optional sFileName As String = "", Optional bLoadPictureNotFoundPicture As Boolean = True) As Object

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".LoadAPicture"
    Call WriteProcStart(sRoutineName) ' "OBJECT")
       
            
    If Len(Trim(sFileName)) = 0 Then
        Set LoadAPicture = LoadPicture()
    ElseIf Dir(sPath & sFileName) <> vbNullString Then
        Set LoadAPicture = LoadPicture(sPath & sFileName)
    ElseIf Not Dir(g_cSYSGRAPHICSDIR & "PictureNotFoundPicture.bmp") = "" And bLoadPictureNotFoundPicture = True Then
        Set LoadAPicture = LoadPicture(g_cSYSGRAPHICSDIR & "PictureNotFoundPicture.bmp")
    Else
        Set LoadAPicture = LoadPicture()
    End If
            
            
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
            
End Function
Public Sub ChangeCharacterPicture(oChar As clsCharacter)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".ChangeCharacterPicture"
    Call WriteProcStart(sRoutineName) ' "OBJECT")
       

    Dim i As Long
    Dim nTemp As Long
    Dim sGUID As String
    
    'Step through all the message windows and add to the invites
    For i = 0 To Forms.Count() - 1
        If Forms(i).Name = "frmMessage_3_2_0" Then
            'Check the sending to picture to see if it needs to be updated
            sGUID = Forms(i).cboTheirCharacters.GetCurrentSelectedItemsKey()
            If sGUID = oChar.sGUID Then
                Set Forms(i).imgTo.Picture = LoadAPicture(g_cPORTRAITSDIR, frmMessage_3_2_0.m_oCharTalking.sPicture)
            End If
            'Check the receiving from picture to see if it needs to be updated
            sGUID = Forms(i).cboMyChars.GetCurrentSelectedItemsKey()
            If sGUID = oChar.sGUID Then
                Set Forms(i).imgFrom.Picture = LoadAPicture(g_cPORTRAITSDIR, frmMessage_3_2_0.m_oCharTalking)
            End If
        End If
    Next
    
    'Update the character sheet
    If oChar.sGUID() = frmCharacter_3_37_0.m_oChar.sGUID() Then
        Set frmCharacter_3_37_0.picCharPicture.Picture = LoadAPicture(g_cPORTRAITSDIR, frmCharacter_3_37_0.m_oChar.sPicture)
    End If

    'Now update the battlemap if its open
    If IsFormOpen(Forms, "frmBattleMap") = True Then
        Call frmBattleMap.MoveBMPeice(oChar.sGUID, oChar.nX, oChar.nY, oChar.nDirection, oChar.sCondition, oChar.sState)
    End If
        
       
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Sub

Public Sub ChangeCharacterName(oChar As clsCharacter)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".ChangeCharacterName"
    Call WriteProcStart(sRoutineName) ' "OBJECT")
       

    Dim i As Long
    Dim nTemp As Long
    Dim sGUID As String
    
    'Step through all the chat rooms and remove the player
    For i = 0 To Forms.Count() - 1
        If Forms(i).Name = "frmChatRoom_3_0_0" Then
            'Remove the player from the list box
            sGUID = Forms(i).cboCharacters.GetCurrentSelectedItemsKey()
            Call Forms(i).cboCharacters.RemoveItemByKeyIfFound(oChar.sGUID)
            Call Forms(i).cboCharacters.AddItemWithKey(oChar.sName, oChar.sGUID)
            If sGUID = oChar.sGUID Then
                Call Forms(i).cboCharacters.SelItemByKey(oChar.sGUID)
            End If
        End If
    Next 'Move to the next chat room
        
    'Step through all the message windows and add to the invites
    For i = 0 To Forms.Count() - 1
        If Forms(i).Name = "frmMessage_3_2_0" Then
            'Remove the player to the list box
            sGUID = Forms(i).cboTheirCharacters.GetCurrentSelectedItemsKey()
            Call Forms(i).cboTheirCharacters.RemoveItemByKeyIfFound(oChar.sGUID)
            Call Forms(i).cboTheirCharacters.AddItemWithKey(oChar.sName, oChar.sGUID)
            If sGUID = oChar.sGUID Then
                Call Forms(i).cboTheirCharacters.SelItemByKey(sGUID)
            End If
        End If
    Next 'Move to the next chat room

    'Now update the battlemap if its open
    If IsFormOpen(Forms, "frmBattleMap") = True Then
        Call frmBattleMap.MoveBMPeice(oChar.sGUID, oChar.nX, oChar.nY, oChar.nDirection, oChar.sCondition, oChar.sState)
    End If
    
    'Update the character sheets
    If IsFormOpen(Forms, "frmCharacter_3_37_0") = True Then
        sGUID = frmCharacter_3_37_0.cboCharacter.GetCurrentSelectedItemsKey()
        frmCharacter_3_37_0.cboCharacter.ListByKey(oChar.sGUID) = oChar.sName
        If sGUID = oChar.sGUID Then
            Call frmCharacter_3_37_0.cboCharacter.SelItemByKey(sGUID)
        End If
    End If
        
       
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Sub
Public Sub ReceivedMessageForPlayer(nPlayerID As Long, Optional sMessage As String = "")

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".ReceivedMessageForPlayer"
    Call WriteProcStart(sRoutineName) ' nPlayerID)


    Dim i As Long
    Dim oToPlayer As clsPlayer, oFromPlayer As clsPlayer
    
    Set oToPlayer = GetPlayer(nPlayerID)
    Set oFromPlayer = GetPlayer(g_nMyNumber)
    
    Call ReceivedIM(oFromPlayer.LastCharToTalk.sGUID, _
                    oToPlayer.LastCharToTalk.sGUID, sMessage)


    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Sub
'I have received (for me) a message for a message window.  Find if you can a
'message window that is talking to this player... else open it
Public Sub ReceivedIM(sToGUID As String, sFromGUID As String, Optional sTextRTFMsg As String = "")

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".ReceivedIM"
    Call WriteProcStart(sRoutineName)


    Dim i As Long
    Dim oChar As clsCharacter
    Dim objTempMsgWnd As frmMessage_3_2_0
    Dim bFound As Boolean
    bFound = False
    
    Call WriteToDebug(2, "Search For A Viable IM Window Already Open To(" & sToGUID & ") From(" & sFromGUID & ")")
    
    'Step through each window and see whats going on
    For i = 0 To Forms.Count() - 1
        If Forms(i).Name = "frmMessage_3_2_0" Then
            Call WriteToDebug(3, "Found To(" & Forms(i).cboTheirCharacters.GetCurrentSelectedItemsKey() & ") From(" & Forms(i).cboMyChars.GetCurrentSelectedItemsKey() & ")")
            
            'If this window is for all players or to the player that sent the message...
            If Forms(i).cboTheirCharacters.GetCurrentSelectedItemsKey() = "" Or _
               ( _
                    Forms(i).cboTheirCharacters.GetCurrentSelectedItemsKey() = sFromGUID And _
                    Forms(i).cboMyChars.GetCurrentSelectedItemsKey() = sToGUID _
                ) Then
                    Call WriteToDebug(4, "Yea!!  Found it")
                    'Then display what was sent to us
                    Set objTempMsgWnd = Forms(i)
                    bFound = True
                    Exit For
            End If
        End If
    Next i
    
    'Nope... didn't find our window!
    If bFound = False Then
        Call WriteToDebug(2, "Welp, didn't find it, create a new one")
        'If we got this far we didn't find the window
        'Create a new chat window
        Set objTempMsgWnd = New frmMessage_3_2_0
        Call objTempMsgWnd.Show(vbModeless)
        'Now select the sending player
        Call objTempMsgWnd.cboMyChars.SelItemByKey(sToGUID)
        Call objTempMsgWnd.cboTheirCharacters.SelItemByKey(sFromGUID)
    End If
    
    'Find the character who sent this so we can show his name
    Set oChar = GetCharacter(sFromGUID)
    
    'Add the message to our window
    If Len(Trim(sTextRTFMsg)) > 0 Then
        Call objTempMsgWnd.AddMessage(oChar.sName, sTextRTFMsg)
        Call objTempMsgWnd.Blinky
    End If
    

    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Sub
Public Function IsValidSaveToPath(sSaveToPath As String) As Boolean

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".IsValidSaveToPath"
    Call WriteProcStart(sRoutineName)


    If Len(Trim(sSaveToPath)) > 0 Then
        IsValidSaveToPath = (Right(sSaveToPath, 1) = "\")
    Else
        IsValidSaveToPath = False
    End If
    

    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Function
Public Function TestPathIntegrity(sPath As String, Optional sTestFileName As String = "_DNDOTemp.TMP") As Boolean

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".TestPathIntegrity"
    Call WriteProcStart(sRoutineName)


    Dim nFreeFile As Long
    
    'Test the path integrity
    If Len(Trim(sPath)) = 0 Or IsValidSaveToPath(sPath) = False Then
        TestPathIntegrity = False
    Else
        nFreeFile = FreeFile
        TestPathIntegrity = True
    
        On Error GoTo InvalidFileLocation
        Open App.Path & sPath & sTestFileName For Output As #nFreeFile
        Close #nFreeFile
    
        Call DeleteFileIfExists(sPath & sTestFileName)
        On Error GoTo 0
    End If
         
    
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
InvalidFileLocation:
    Call Err.Clear
    TestPathIntegrity = False
    Resume Next

End Function
Public Function MakeValidSaveToPath(sSaveToPath As String) As String

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".MakeValidSaveToPath"
    Call WriteProcStart(sRoutineName)


    Dim nWhere As Long
    
    If IsValidSaveToPath(sSaveToPath) = True Then
        MakeValidSaveToPath = sSaveToPath
    ElseIf Len(Trim(sSaveToPath)) > 0 Then
        nWhere = InStrRev(sSaveToPath, "\")
        If nWhere > 0 Then
            MakeValidSaveToPath = Left(sSaveToPath, nWhere)
        Else
            MakeValidSaveToPath = ""
        End If
    Else
        MakeValidSaveToPath = ""
    End If
    

    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Function
Public Sub BackupDB(bCompress As Boolean)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".MakeValidSaveToPath"
    Call WriteProcStart(sRoutineName)


    Dim i As Integer
    Dim nWhere As Long
    Dim sTemp As String
    
    If g_bBackupDB = True Then
        'If an error occurs its because the dir already exists
        On Error GoTo DirAlreadyExists
        Call MkDir(g_cBACKUPDIR)
DirAlreadyExists:
        On Error GoTo ErrorHandler
    
        'Extract the player's file name
        nWhere = InStrRev(g_sBackupFileName, "\")
        If nWhere > 0 Then
            sTemp = Mid(g_sBackupFileName, nWhere + 1)
            nWhere = InStr(1, sTemp, ".")
            If nWhere > 0 Then
                sTemp = Left(sTemp, nWhere - 1)
            End If
            
            Call Shell(g_cDNDONLINEDIR & "PKZip25.EXE -add -Maximum " & _
                       g_cBACKUPDIR & sTemp & "_" & Format(Now, "yyyymmdd") & ".Zip " & _
                       g_sBackupFileName, vbHide)
        Else
            Call Err.Raise(-1, "DNDOnline.MakeValidSaveToPath", "Unable to process backup file name, no \ found in <" & g_sBackupFileName & ">")
        End If

    End If
    

    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Sub
Public Function RollIt(nNumDice As Long, nDiceSize As Long, nMin As Long, _
                   nPlus As Long, bDropLowest As Boolean, _
                   Optional oListBoxForResults As Object = Nothing) As Long
    
    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".RollIt"
    Call WriteProcStart(sRoutineName)
    

    Dim nn As Long, nD As Long
    Dim nTotal As Long
    Dim nRolled As Long
    Dim naRolls() As Long
    Dim nLowestIndex As Long
    
    If nNumDice > 0 Then
        ReDim naRolls(1 To nNumDice) As Long
    
        '03/24/2003 Chris Hill  They'd rather not auto-clear it.
        'If Not oListBoxForResults Is Nothing Then
        '    Call oListBoxForResults.Clear
        'End If
    
        nTotal = 0
        
        For nn = 1 To nNumDice
            'Roll what we rolled
            nRolled = Random(nMin, nDiceSize) + nPlus
            naRolls(nn) = nRolled
            
            'Is this the lowest
            If nLowestIndex = 0 Then
                nLowestIndex = nn
            Else
                If nRolled < naRolls(nLowestIndex) Then
                    nLowestIndex = nn
                End If
            End If
        Next nn
            
        For nn = 1 To nNumDice
            If bDropLowest = True And nLowestIndex = nn Then
                If Not oListBoxForResults Is Nothing Then
                    If nPlus = 0 Then
                        Call oListBoxForResults.AddItem("     Roll " & nn & ": " & naRolls(nn) & " on a D" & nDiceSize & "  (Dropped)", 0)
                    Else
                        Call oListBoxForResults.AddItem("     Roll " & nn & ": " & naRolls(nn) - nPlus & " on a D" & nDiceSize & " + " & nPlus & " = " & naRolls(nn) & "  (Dropped)", 0)
                    End If
                End If
            Else
                If Not oListBoxForResults Is Nothing Then
                    If nPlus = 0 Then
                        Call oListBoxForResults.AddItem("     Roll " & nn & ": " & naRolls(nn) & " on a D" & nDiceSize, 0)
                    Else
                        Call oListBoxForResults.AddItem("     Roll " & nn & ": " & naRolls(nn) - nPlus & " on a D" & nDiceSize & " + " & nPlus & " = " & naRolls(nn), 0)
                    End If
                End If
                nTotal = nTotal + naRolls(nn)
            End If
        Next nn
        
        If Not oListBoxForResults Is Nothing Then
            Call oListBoxForResults.AddItem(nNumDice & "D" & nDiceSize, 0)
        End If
        
        RollIt = nTotal
    End If
                    
    
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Function
Public Sub GetWeapSpecializedBonuses(nLevel As Long, _
                                     Optional ByRef nDamageBonus As Long, _
                                     Optional ByRef nAttackBonus As Long, _
                                     Optional ByRef nInitBonus As Long)
    
    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".GetWeapSpecializedBonuses"
    Call WriteProcStart(sRoutineName)
    

    Dim oTableSpec As clsTable
    Dim nRow As Long
    Dim i As Long
    
    nDamageBonus = 0
    nAttackBonus = 0
    nInitBonus = 0

    Set oTableSpec = g_oTables.GetTableByFile("SpecialistBonuses.DAT")
    nRow = oTableSpec.FindRow(nLevel)
    
    If nRow = -1 Then
        Call Err.Raise(-1, sRoutineName, "Unable to find a specialization bonow for <" & nLevel & "> level of specilization.")
    ElseIf nRow >= 2 Then
        For i = 2 To nRow
            nDamageBonus = nDamageBonus + oTableSpec.Data(3, i)
            nAttackBonus = nAttackBonus + oTableSpec.Data(4, i)
            nInitBonus = nInitBonus - oTableSpec.Data(5, i)
        Next i
    End If

    
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Sub
Public Sub ResetFontToCharacterDefault(rtbRTB As FOTARichTextBox, oChar As clsCharacter)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".ResetFontToCharacterDefault"
    Call WriteProcStart(sRoutineName)
    
    
    Dim nStart As Long
    Dim nLen As Long
        
    'This is experamental code.  Its intended to fix your font when you char characters
    nStart = rtbRTB.SelStart
    nLen = rtbRTB.SelLength
    rtbRTB.SelStart = 0
    rtbRTB.SelLength = Len(rtbRTB.Text)
        
    '08/01/2002 Chris Hill  If they have added formating to the line we don't want to overwrite it.
    If IsNull(rtbRTB.SelColor) = False And _
       IsNull(rtbRTB.SelBold) = False And _
       IsNull(rtbRTB.SelItalic) = False And _
       IsNull(rtbRTB.SelFontSize) = False And _
       IsNull(rtbRTB.SelFontName) = False And _
       IsNull(rtbRTB.SelUnderline) = False And _
       IsNull(rtbRTB.SelStrikeThru) = False Then
            Set rtbRTB.Font = oChar.m_oFont
            rtbRTB.SelColor = oChar.m_nFontColor
            rtbRTB.SelBold = oChar.m_oFont.Bold
            rtbRTB.SelItalic = oChar.m_oFont.Italic
            rtbRTB.SelFontSize = oChar.m_oFont.Size
            rtbRTB.SelFontName = oChar.m_oFont.Name
            rtbRTB.SelUnderline = oChar.m_oFont.Underline
            rtbRTB.SelStrikeThru = oChar.m_oFont.Strikethrough
    End If
    
    rtbRTB.SelStart = nStart
    rtbRTB.SelLength = nLen
    

    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Sub
Public Function CreateMonsterousMinion(sDBName As String, Optional sNewName As String = "", Optional bSilantly As Boolean = False) As clsCharacter
    
    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".CreateMonsterousMinion"
    Call WriteProcStart(sRoutineName)


    Dim i As Long
    Dim oTable As clsTable
    Dim oMinion As clsCharacter
    Dim nRow As Long
    Dim sDice As String, nNum As Long, nDice As Long, nPlus As Long
    Dim nNameIndex As Long
    Dim sTemp As String
    
    'Find our table
    Set oTable = g_oTables.GetTableByNode("Monster Manual")
    Set oMinion = New clsCharacter

    'Make sure this minion is set as ours
    oMinion.nOwnerNumber = g_nMyNumber

    'Go through and find the creature by name
    nNameIndex = oTable.FindColumn("Creature")
    nRow = -1
    For i = 1 To oTable.Rows
        If oTable.Data(nNameIndex, i) = sDBName Then
            nRow = i
            Exit For
        End If
    Next i
    If nRow = -1 Then
        Call Err.Raise(-1, sRoutineName, "Unable to find monster with name <" & sDBName & ">")
    End If

    'Make our monster object!
    'Creature,AC,HD,THAC0,Terrain,Climate,Att.,Damage,# App,SA,SD,MR,Size,Move,XP,Activity,Align,Treasure,INT,Page,Type,Remarks,Notes,Frequency,Comments,Organization,Diet,Morale,Campaign,Plane
    '"Elf, High","5 (10)","1+1","19","Forests","Temp/SubTrop","1","1d10","20-200","TRUE","TRUE","special","M","12","420","Any","CG","N (G, S, T)","14-20","Monstrous Manual 108","Humanoid","speak:own, goblin, orc, hobgoblin, gnoll, gnome & halfling, move through forests silent & invisible (-4 opp surp)","90% MR to charm & sleep, +1 w/sword & bow, can be of higher lvl & multi-lvl, use magic items, value freedom,","UC","camps hidden, enjoy music, poetry & nature, close families, -1 CON & +1 DEX, infravision 60', also see PHB 21","Band","Omnivore","13","General","Prime Material"
    If Len(Trim(sNewName)) = 0 Then
        oMinion.sName = oTable.Data(1, nRow)
    Else
        oMinion.sName = sNewName
    End If
    oMinion.nLevel1 = 1
    oMinion.nLevel2 = 1

    If IsNumeric(oTable.Data(4, nRow)) = True Then
        oMinion.nCombatTHACOBonus1 = 20 - CLng(oTable.Data(4, nRow))
    Else
        oMinion.nCombatTHACOBonus1 = 100
    End If
    If IsNumeric(oTable.Data(2, nRow)) = True Then
        oMinion.nCombatACBonus = 10 - CLng(oTable.Data(2, nRow))
    Else
        oMinion.nCombatACBonus = 0
    End If
    If IsNumeric(oTable.Data(3, nRow)) = True Then
        oMinion.nHP = CLng(oTable.Data(3, nRow)) * 8
    Else
        oMinion.nHP = 100
    End If
    oMinion.nMaxHP = oMinion.nHP
    oMinion.bCombatAIOn = True
    oMinion.bRangedCombat = False
    oMinion.bWillAttackParty = True
    
    'Setup our MR
    If IsNumeric(oTable.Data(12, nRow)) = True Then
        oMinion.nMR = oTable.Data(12, nRow)
    Else
        oMinion.nMR = 0
    End If
    
    'Isolate our numerics for attacking
    sDice = oTable.Data(8, nRow)
    If Len(Trim(sDice)) = 0 Then sDice = "?"
    
    If bSilantly = True And (IsDiceFormat(sDice, nNum, nDice, nPlus) = False And Len(Trim(sDice)) > 0) Then
        nNum = 1
        nDice = 6
        nPlus = 1
    Else
        While IsDiceFormat(sDice, nNum, nDice, nPlus) = False And Len(Trim(sDice)) > 0
            sDice = InputBox("The damage specified for this monster is unreadable.  The monsters manual specifies [" & sDice & "], please put it in XDX + X format.", _
                    "Dice for attack", sDice)
        Wend
    End If
    oMinion.nCombatNumDice1 = nNum
    oMinion.nCombatDice1 = nDice
    oMinion.nCombatDamagePlus1 = nPlus
    
    If IsNumeric(oTable.Data(7, nRow)) = False Then
        oMinion.nCombatNumOfAttacks1 = 1
    Else
        oMinion.nCombatNumOfAttacks1 = oTable.Data(7, nRow)
    End If
    oMinion.nCombatNumOfAttacksEvery1 = 1

    '03/03/2003 Chris Hill  Add all the data to the notes section
    sTemp = ""
    For i = 4 To oTable.Cols()
        If i = 7 Or i = 12 Then
        Else
            sTemp = sTemp & Trim(oTable.Data(i, 1)) & ": " & Trim(oTable.Data(i, nRow)) & vbCrLf
        End If
    Next i
    oMinion.sNotes = sTemp

    Call AddMinion(oMinion)
    
    Set CreateMonsterousMinion = oMinion


    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Function

Public Function FindSpell(sKey As String, ByRef oTable As clsTable, ByRef nRow As Long) As Boolean
    
    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".FindSpell"
    Call WriteProcStart(sRoutineName)

    
    Dim nLevelIndex As Long
    Dim nNameIndex As Long
    Dim nLevel As Long
    Dim sType As String
    Dim sName As String
    
    nLevel = ParseString(sKey, ";", 1)
    sType = ParseString(sKey, ";", 2)
    sName = ParseString(sKey, ";", 3)
    
    If sType = "Priest" Then
        Set oTable = g_oTables.GetTableByFile("PriestSpells.DAT")
    Else
        Set oTable = g_oTables.GetTableByFile("MageSpells.DAT")
    End If
    
    nLevelIndex = oTable.FindColumn("Level")
    nNameIndex = oTable.FindColumn("Spell")

    'Search for the spell in the table
    For nRow = 2 To oTable.Rows()
        If oTable.Data(nLevelIndex, nRow) = nLevel And oTable.Data(nNameIndex, nRow) = sName Then
            FindSpell = True
            Exit Function
        End If
    Next nRow
    
    FindSpell = False
    
    
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
        
End Function

Public Sub LogErrorToFile(sError As String)

    Dim nFreeFile As Long
    
    nFreeFile = FreeFile
    
    Open App.Path & "\Error.OUT" For Append As #nFreeFile
        Print #nFreeFile, Now() & " - " & sError
    Close #nFreeFile

End Sub
