Stuff

' 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