Miscellany

Option Explicit

Private Sub MDIForm_Load()
    frmConfig.Hide
    Select Case sckBO(0).State
        Case 0 ' Closed
            mToolsSocket.Caption = "Start Server"
        Case 1 ' Open
            mToolsSocket.Caption = "Stop Server"
        Case 2 ' Listening
            mToolsSocket.Caption = "Stop Server"
        Case Else
    End Select
    
    ' Database Setup
    
    Set adoConn = New ADODB.Connection   ' We must make a connection reference
    
    adoConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\" & "Main.mdb"
    adoConn.Open
        
    Set adoRcds = New Recordset          ' We must make a recordset reference
    
    ' Table: Server
    adoRcds.Open "Server", adoConn, adOpenKeyset, adLockOptimistic, adCmdTable
    
    If adoRcds.RecordCount = 0 Then
        Dim strServerName As String
        Dim strServerAdmin As String
        Dim intServerPort As Integer
        Dim strAdminNick As String
            
        ' We can't start the server unless we have configuration
        mToolsSocket.Enabled = False
            
        strServerName = InputBox("Please enter the name of the server", "First Time Initalization", "MyServer")
            
        With adoRcds
            .AddNew                             ' New Record
            .Fields(1) = strServerName          ' Set "Server Name" field
            .Update                             ' Update Record
        End With
              
        strServerAdmin = InputBox("Enter your Name for Administrative purposes.", "First Time Initalization", "Sysop Admin")
            
        With adoRcds
            .Fields(2) = strServerAdmin
            .Update
        End With
            
        intServerPort = InputBox("Enter the port number people will use to connect to here. (Example: HTTP uses 80)", "First Time Initalization", "9001")
            
        With adoRcds
            .Fields(3) = intServerPort
            .Update
        End With
            
        strAdminNick = InputBox("Enter your nickname you will use for chats and interactivity:", "First Time Initalization", "MyNick")
            
        With adoRcds
            .Fields(4) = strAdminNick
            .Update
        End With
    Else
        ' We can start the server since we have configuration
        mToolsSocket.Enabled = True
            
        adoRcds.MoveFirst
        Do Until adoRcds.EOF = True
            frmConfig.txtOwnerRName = adoRcds.Fields("ServerAdmin")
            frmConfig.txtServerName = adoRcds.Fields("ServerName")
            frmConfig.txtServerPort = adoRcds.Fields("ServerPort")
            frmConfig.txtOwnerNName = adoRcds.Fields("AdminNick")
            adoRcds.MoveNext
        Loop
    End If
        
        adoRcds.MoveFirst

End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
    ' Destroy the objects before closing server application.
    Set adoConn = Nothing
    Set adoRcds = Nothing
    Set adoCmd = Nothing
End Sub

Private Sub mToolsSocket_Click()
    If mToolsSocket.Caption = "Start Server" Then
        sckBO(0).Close
        sckBO(0).LocalPort = 9001
        sckBO(0).Listen
        mToolsSocket.Caption = "Stop Server"
        ' First we must check to see if the port and server information is entered.
        ' If not, we will abort with a notice to the user.
    Else
        ' We will stop the server since it's already running.
        sckBO(0).Close
        mToolsSocket.Caption = "Start Server"
    End If
End Sub

Private Sub mToolsSvrConfig_Click()
    frmConfig.Show
End Sub

Private Sub sckBO_ConnectionRequest(Index As Integer, ByVal requestID As Long)
    sckBO(0).Close
    sckBO(0).Accept requestID
End Sub

Private Sub sckBO_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    Dim strLocalData As String, strDelimiter As String
    Dim strTempData() As String
    
    sckBO(0).GetData strLocalData
    strTempData() = Split(strLocalData, ":")
  
    Select Case strTempData(0)
        Case "NICK"
            sckBO(0).SendData "HELLO!"
            lstUsersOnline.AddItem strTempData(1)
        Case Else
            MsgBox "Invalid Header Received!", vbCritical, "Huh?"
            Exit Sub
    End Select
    
    Debug.Print "Incoming Raw Data from " & sckBO(0).RemoteHost & ": & strLocalData"
    
End Sub

Private Sub tmrConnStatus_Timer()
    Select Case sckBO(0).State
        Case 0: objStatus.Panels(1).Text = "Server Offline"
        Case 1: objStatus.Panels(1).Text = "Server Online"
        Case 2: objStatus.Panels(1).Text = "Server Waiting for Connections"
        Case 3: objStatus.Panels(1).Text = "Server Connection Pending"
        Case 4: objStatus.Panels(1).Text = "Resolving Host of New User"
        Case 5: objStatus.Panels(1).Text = "Resolved Host of New User to " & sckBO(0).RemoteHost
        Case 6: objStatus.Panels(1).Text = "Server Connecting Remotely"
        Case 7: objStatus.Panels(1).Text = "Server Connected"
        Case 8: objStatus.Panels(1).Text = "Server Disconnecting Remote User"
        Case 9: objStatus.Panels(1).Text = "Socket Error -- " & Err.Number
    End Select
End Sub

Private Sub tmrDate_Timer()
    objStatus.Panels(5).Text = Format(Date, "MMMM, DDDD DD, YYYY")
End Sub

Private Sub tmrTime_Timer()
    objStatus.Panels(6).Text = Format(Time, "HH:MM:SS AM/PM")
End Sub