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