All pastes #959335 Raw Edit

Unnamed

public text v1 · immutable
#959335 ·published 2008-03-27 10:56 UTC
rendered paste body
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
            
            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
        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")
        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
        ' 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
    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 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