' Done - 08-28-07 Private Sub lstOnlineUsers_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 2 Then PopupMenu mPop End Sub Private Sub MDIForm_Load() Randomize intSeed = Rnd(Int(100) + 1) frmDebugger.lblCurrNumUsers.Caption = idxConnection frmOptions.Hide If sckServer(0).State = 0 Then mFileStop.Enabled = False lblStatus.Caption = "Server Offline" mPopPrivmsg.Enabled = False Else mFileStart.Enabled = True lblStatus.Caption = "Server Online" mPopPrivmsg.Enabled = True End If ' We need our name from the registry strSysopNickname = GetSetting("CyParty Server", "Options", "Sysop Name") frmOptions.txtSysopName.Text = strSysopNickname Debug.Print "Retreived Sysop Nick as " & strSysopNickname End Sub Private Sub MDIForm_Unload(Cancel As Integer) Unload Me End End Sub Private Sub mFileStart_Click() ' We must begin listening for connections... sckServer(0).Close ' Close current connection sckServer(0).LocalPort = 9000 ' Port Number we will listen on. sckServer(0).Listen ' Start Listening lblStatus.Caption = "Server Online" ' Update Status mFileStop.Enabled = True ' We are running, we can stop server now mFileStart.Enabled = False ' We are running, can't start server if it's running mPopPrivmsg.Enabled = True ' We are running, allow messages lstOnlineUsers.AddItem strSysopNickname ' Add our nickname we got from registry to listbox End Sub Private Sub mFileStop_Click() sckServer(0).Close ' Close current connections lblStatus.Caption = "Server Offline" ' Update Status mFileStop.Enabled = False ' We arn't running, no need to stop server mFileStart.Enabled = True ' We arn't running, we can start server mPopPrivmsg.Enabled = False ' We arn't running, no need to message users lstOnlineUsers.RemoveItem 0 ' Remove current users (Clean up with a Array) End Sub Private Sub mPopPrivmsg_Click() frmPrivmsg.Show End Sub Private Sub mToolsOptions_Click() frmOptions.Show End Sub Private Sub mViewDebugger_Click() frmDebugger.Show End Sub Private Sub sckServer_ConnectionRequest(Index As Integer, ByVal requestID As Long) ' Allows more than one user to connect. idxConnection = idxConnection + 1 ' Increment Index frmDebugger.lblCurrNumUsers.Caption = idxConnection frmDebugger.lstData.AddItem "Session ID #" & intSeed frmDebugger.lstData.AddItem "Index #" & idxConnection Load sckServer(idxConnection) ' Load new Socket with our new Index frmDebugger.lstData.AddItem "Current Socket Index: " & idxConnection sckServer(idxConnection).Accept requestID ' Accept connection sckServer(idxConnection).SendData "LOGON" & ".:." & strSysopNickname frmDebugger.lstData.AddItem "Sending data to " & sckServer(idxConnection).RemoteHostIP & " with the data: " & strSysopNickname End Sub Private Sub sckServer_DataArrival(Index As Integer, ByVal bytesTotal As Long) Dim strInText As String, intSocket As Integer sckServer(Index).GetData strInText ' What is coming in? For intSocket = 0 To idxConnection Step 1 ' How many clients connected? If sckServer(intSocket).State = sckConnected Then ' If we are connected? sckServer(intSocket).SendData strInText ' Resend the data DoEvents End If Next intSocket strParsed() = Split(strInText, ".:.") ' Split incoming string Select Case strParsed(0) Case "LOGOFF" lstOnlineUsers.RemoveItem strParsed(1) idxConnection = idxConnection - 1 frmDebugger.lblCurrNumUsers.Caption = idxConnection Case "LOGON" lstOnlineUsers.AddItem strParsed(1) ' Add Nickname to listbox Case "PRIVMSG" frmPrivmsg.Show frmPrivmsg.txtPrivmsg.Text = _ frmPrivmsg.txtPrivmsg.Text & strParsed(1) & ": " & strParsed(2) & vbCrLf Case Else ' do a carriage return and line feed. MsgBox "Unknown Header", vbCritical, "Header Unknown" End Select End Sub