VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1 
   Caption         =   "WinSock"
   ClientHeight    =   3555
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6015
   Icon            =   "Form1.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   ScaleHeight     =   3555
   ScaleWidth      =   6015
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton Command1 
      Caption         =   "?"
      Height          =   375
      Left            =   1920
      TabIndex        =   4
      Top             =   120
      Width           =   255
   End
   Begin VB.Timer Timer1 
      Interval        =   100
      Left            =   4320
      Top             =   600
   End
   Begin VB.CommandButton Command3 
      Caption         =   "Start Server"
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   1695
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Connect to Server"
      Height          =   375
      Left            =   2280
      TabIndex        =   1
      Top             =   120
      Width           =   1695
   End
   Begin VB.TextBox Text4 
      BackColor       =   &H00000000&
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FF00&
      Height          =   2205
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   3
      TabStop         =   0   'False
      Top             =   960
      Width           =   3735
   End
   Begin VB.TextBox Text3 
      BackColor       =   &H00000000&
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FF00&
      Height          =   285
      Left            =   120
      TabIndex        =   2
      Text            =   "Enter message-text here and press return."
      Top             =   600
      Width           =   3615
   End
   Begin MSWinsockLib.Winsock Winsock1 
      Index           =   0
      Left            =   4320
      Top             =   1440
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
 
Const CLIENT = 0
Const ROOTSOCKET = 0
Public winSockPort As Long
Public nickName As String
Public maxClients As Long
Public rHostIP As String
Private rHostName As String
Private iAmServer As Boolean
Private serverIsFull As Boolean
Private clientCount As Long
Private timer1oldState() As Long
Private serverStartNow As Variant
Private exitMutex As Boolean
Private doExit As Boolean
Private timeOut As Long
 
 
Private Sub Command1_Click()
    ' print about this exe
    Dim clcnt As Long
    addLine ""
    addLine "------------------------------------------------"
    addLine "WinSock - Version " & App.Major & "." & App.Minor & "." & App.Revision
    addLine "------------------------------------------------"
    addLine "Multi client chat via TCP/IP"
    addLine "------------------------------------------------"
    addLine "Quick test:"
    addLine "1. Run WinSock.exe and start a Server"
    addLine "2. Run WinSock.exe and start a Client"
    addLine "3. Enter 127.0.0.1 in the Popup-Dialog"
    addLine "4. Chat with yourself"
    addLine "------------------------------------------------"
    If (iAmServer) Then
        addLine "Server Info:"
        addLine "Running port = " & winSockPort
        addLine "Online since = " & serverStartNow
        addLine "Maximum clients = " & maxClients
        clcnt = getOnlineClientCount
        addLine "Connected clients = " & clcnt
        If (clcnt = 0) Then
            addLine "(none)"
        Else
            addLine createClientNameList
        End If
        addLine "------------------------------------------------"
        addLine "Enter 'kickName=nnn' /where nnn is the "
        addLine "Client-Nick-Name to kick from this Server."
        addLine "------------------------------------------------"
    Else
        addLine "List of Commands:"
        addLine "1. nickName=nnn /where nnn is your new nick name"
        addLine "2. listNames    /list all online clients"
        addLine "------------------------------------------------"
    End If
End Sub
 
Private Function getOnlineClientCount() As Long
    Dim res As Long
    Dim i As Long
    For i = 1 To clientCount
        If (Winsock1(i).Tag <> "__FREE__") Then
            res = res + 1
        End If
    Next i
    getOnlineClientCount = res
End Function
 
Private Sub Command2_Click()
    ' connect to server
    On Error GoTo Hell
    Dim t1 As Single
    Dim oldState As Long
    Dim t1Dot As Long
    Dim i As Long
    If (Winsock1(CLIENT).state <> sckClosed) Then
        If (iAmServer) Then
            MsgBox "Cannot connect. Server is running."
            Exit Sub
        End If
        Dim res As VbMsgBoxResult
        res = MsgBox("You are already connected to Server:" _
                      & vbNewLine _
                      & rHostName _
                      & vbNewLine & vbNewLine _
                      & "Close current connection?", _
                      vbYesNo, "WinSock")
        If (res = vbYes) Then
            Winsock1(CLIENT).Close
            addLine "Connection closed."
            DoEvents
        Else
            Exit Sub
        End If
    End If
    oldState = Winsock1(CLIENT).state
    serverIsFull = False
    rHostIP = ""
    Winsock1(CLIENT).LocalPort = 0
    frmLogin.Show vbModal, Me
    If Not (frmLogin.settingsValid) Then Exit Sub
    If (Len(rHostIP) > 0) Then
        addLine "searching Server..."
        DoEvents
        rHostName = getHostName(rHostIP)
        DoEvents
        addLine ">>> WinSock Server is: " & rHostName & " <<<"
        Winsock1(CLIENT).Connect rHostIP, winSockPort
        t1 = Timer
        exitMutex = True
        Do
            If (oldState <> Winsock1(CLIENT).state) Then
                oldState = Winsock1(CLIENT).state
                addLine ""
                addText stateToString(oldState)
            End If
            If (Winsock1(CLIENT).state = sckConnected) Then Exit Do
            If (Timer > t1 + timeOut) Then Exit Do
            If (Timer > t1 + t1Dot) Then
                t1Dot = t1Dot + 1
                addText "."
            End If
            For i = 1 To 500
                DoEvents
                If (Winsock1(CLIENT).state = sckClosed) Then Exit Do
            Next i
        Loop
        exitMutex = False
        addLine ""
        If (doExit) Then
            Unload Me
            Exit Sub
        End If
        If (Winsock1(CLIENT).state <> sckConnected) Then
            If (Winsock1(CLIENT).state <> sckClosed) Then
                addLine "ERROR: Connect timeout (" & timeOut & " sec)."
                Winsock1(CLIENT).Close
                addLine "Connection closed."
            End If
        Else
            DoEvents
            If Not (serverIsFull) Then
                addLine "Connect OK to server " & Winsock1(CLIENT).RemoteHostIP
                DoEvents
                Winsock1(CLIENT).SendData "nickName=" & nickName
                DoEvents
                Winsock1(CLIENT).Tag = nickName
                Text3.SetFocus
                Text3.SelStart = 0
                Text3.SelLength = Len(Text3.text)
            End If
        End If
    End If
    Exit Sub
Hell:
    errorHandler "Error while connecting to server " & _
                  Winsock1(CLIENT).RemoteHostIP
End Sub
 
Private Sub Command3_Click()
    ' start server
    On Error GoTo Hell
    If (Winsock1(ROOTSOCKET).state <> sckClosed) Then
        If Not (iAmServer) Then
            MsgBox "Cannot start Server. You are connected as Client."
            Exit Sub
        End If
        Dim res As VbMsgBoxResult
        Dim cl As Long
        cl = getOnlineClientCount
        res = MsgBox("Server is already running." _
                      & vbNewLine _
                      & "Info: " & cl & " Clients are connected right now." _
                      & vbNewLine & vbNewLine _
                      & "Close running Server and start a new one?", _
                      vbYesNo, "WinSock")
        If (res = vbYes) Then
            closeAllConnections
            Winsock1(ROOTSOCKET).Close
            addLine "Server stop OK."
        Else
            Exit Sub
        End If
    End If
    Dialog.Show vbModal, Me
    If Not (Dialog.settingsValid) Then Exit Sub
    ReDim timer1oldState(maxClients)
    Winsock1(ROOTSOCKET).Bind winSockPort
    Winsock1(ROOTSOCKET).Listen
    addLine "Server start OK on port " & winSockPort & "."
    Text3.SetFocus
    Text3.SelStart = 0
    Text3.SelLength = Len(Text3.text)
    iAmServer = True
    serverStartNow = Now
    Exit Sub
Hell:
    errorHandler "Error while starting server at port " & _
                  Winsock1(ROOTSOCKET).LocalPort
End Sub
 
Private Function getFreeSocketIndex() As Integer
    Dim i As Integer
    Dim res As Integer
    For i = 1 To clientCount
        If (Winsock1(i).Tag = "__FREE__") Then
                If (Winsock1(i).state <> sckClosed) Then
                    Winsock1(i).Close
                End If
            getFreeSocketIndex = i
            Exit Function
        End If
    Next i
    If (clientCount < maxClients) Then
        clientCount = clientCount + 1
        Load Winsock1(clientCount)
        getFreeSocketIndex = clientCount
    Else
        getFreeSocketIndex = maxClients + 1
    End If
End Function
 
Private Sub Winsock1_ConnectionRequest(index As Integer, _
                                       ByVal requestID As Long)
    On Error GoTo Hell
    Dim socketIndex As Integer
    If (iAmServer) Then
        ' only accept requests to ROOTSOCKET
        If (index = ROOTSOCKET) Then
            ' delegate request to next instance
            socketIndex = getFreeSocketIndex
            If (socketIndex <= maxClients) Then
                Winsock1(socketIndex).Accept requestID
                addLine "Connection accepted with:"
                addLine " IP=" & Winsock1(socketIndex).RemoteHostIP
                addLine " Name=" & getHostName(Winsock1(socketIndex).RemoteHostIP)
                addLine " Port=" & Winsock1(socketIndex).RemotePort
                Exit Sub
            Else
                ' make temp-instance and say goodbye
                Load Winsock1(clientCount + 1)
                Winsock1(clientCount + 1).Accept requestID
                Winsock1(clientCount + 1).SendData vbNewLine & _
                    ">>> No more Clients allowed. Goodbey <<<"
                DoEvents
                Winsock1(clientCount + 1).Close
                DoEvents
                Unload Winsock1(clientCount + 1)
            End If
        End If
    End If
    DoEvents
    Exit Sub
Hell:
    errorHandler "Error while establishing connection to " & _
                  Winsock1(clientCount).RemoteHostIP
End Sub
 
Private Sub kickByName(name As String)
    Dim i As Long
    Dim ok As Boolean
    For i = 1 To clientCount
        If (name = Winsock1(i).Tag) Then
            Winsock1(i).SendData ">>> You are kicked by SERVER <<<"
            sendToAll ">>> " & name & " was kicked by SERVER <<<", i
            DoEvents
            Winsock1_Close CInt(i)
            ok = True
        End If
    Next i
    If (ok) Then
        addLine name & " was kicked."
    Else
        addLine "Cannot kick " & name & ". Name unknown. Press ?-button."
    End If
End Sub
 
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    ' send message
    On Error GoTo Hell
    Dim i As Long
    Dim myText As String
    myText = Text3.text
    If (KeyCode = vbKeyReturn And _
        myText <> "Enter message-text here and press return.") Then
        If (iAmServer) Then
            If (clientCount > 0) Then
                addLine "SERVER: " & myText
                Text3.text = ""
                If (Left$(myText, 9) = "kickName=") Then
                    kickByName Right$(myText, Len(myText) - 9)
                Else
                    sendToAll "SERVER: " & myText, 0
                End If
            Else
                addLine "ERROR: Cannot send message, no clients connected."
            End If
        Else
            If (Winsock1(CLIENT).state <> sckConnected) Then
                If (Winsock1(CLIENT).state <> sckConnecting) Then
                    addLine "ERROR: Cannot send message, no connection."
                End If
            Else
                addLine nickName & ": " & myText
                Winsock1(CLIENT).SendData myText
                Text3.text = ""
            End If
        End If
    End If
    Exit Sub
Hell:
    errorHandler "Error while sending message to " & Winsock1(i).RemoteHostIP
End Sub
 
Private Sub Form_Load()
    On Error GoTo SafeSettings
    If (configFileFound) Then
        loadConfigFile
    Else
SafeSettings:
        addLine "File 'WinSockConfig.dat' not found."
        addLine "Loading safe settings."
        winSockPort = 9843
        maxClients = 10
        timeOut = 20
        frmLogin.lastIP_Byte1 = 127
        frmLogin.lastIP_Byte2 = 0
        frmLogin.lastIP_Byte3 = 0
        frmLogin.lastIP_Byte4 = 1
    End If
    ReDim timer1oldState(maxClients)
End Sub
 
Private Function configFileFound() As Boolean
    On Error Resume Next
    Dim s As String
    s = Dir(App.Path & "\WinSockConfig.dat")
    configFileFound = (s <> "")
End Function
 
Private Sub loadConfigFile()
    On Error GoTo Hell
    Dim fileNr As Long
    Dim fileName As String
    Dim temp1 As Byte
    Dim temp2 As Byte
    Dim temp3 As Byte
    Dim temp4 As Byte
    fileNr = FreeFile
    fileName = App.Path & "\WinSockConfig.dat"
    Open fileName For Input As #fileNr
    Input #fileNr, winSockPort
    Input #fileNr, maxClients
    Input #fileNr, temp1
    Input #fileNr, temp2
    Input #fileNr, temp3
    Input #fileNr, temp4
    Input #fileNr, nickName
    Input #fileNr, timeOut
    Close #fileNr
    frmLogin.lastIP_Byte1 = temp1
    frmLogin.lastIP_Byte2 = temp2
    frmLogin.lastIP_Byte3 = temp3
    frmLogin.lastIP_Byte4 = temp4
    Exit Sub
Hell:
    Close #fileNr
    Err.Raise Number:=1001, Description:="Error while loading 'WinSockConfig.dat"
End Sub
 
Private Sub safeConfigFile()
    On Error Resume Next
    Dim fileNr As Long
    Dim fileName As String
    fileNr = FreeFile
    fileName = App.Path & "\WinSockConfig.dat"
    Open fileName For Output As #fileNr
    Write #fileNr, winSockPort
    Write #fileNr, maxClients
    Write #fileNr, frmLogin.lastIP_Byte1
    Write #fileNr, frmLogin.lastIP_Byte2
    Write #fileNr, frmLogin.lastIP_Byte3
    Write #fileNr, frmLogin.lastIP_Byte4
    Write #fileNr, nickName
    Write #fileNr, timeOut
    Close #fileNr
End Sub
 
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If (Winsock1(ROOTSOCKET).state <> sckClosed) Then
        Winsock1(ROOTSOCKET).Close
        DoEvents
    End If
    If (exitMutex) Then
        Cancel = 1
        addLine ""
        addLine "------------------------------------------"
        addLine "Cannot exit while connecting. Please wait."
        addLine "------------------------------------------"
        doExit = True
    Else
        closeAllConnections
        safeConfigFile
    End If
End Sub
 
Private Sub closeAllConnections()
    Dim i As Long
    For i = 1 To clientCount
        If (Winsock1(i).state <> sckClosed) Then
            Winsock1(i).Close
            DoEvents
        End If
        Unload Winsock1(i)
    Next i
    clientCount = 0
End Sub
 
Private Sub Form_Resize()
    If (Form1.WindowState <> vbMinimized) Then
        If (Form1.ScaleWidth > 220) Then
            Text4.Width = Form1.ScaleWidth - 220
            Text3.Width = Form1.ScaleWidth - 220
        End If
        If (Form1.ScaleHeight > Text4.Top + 150) Then
            Text4.Height = Form1.ScaleHeight - Text4.Top - 150
        End If
    End If
End Sub
 
Private Sub Timer1_Timer()
    Static i As Long
    Static s As String
    Static n As String
    For i = 0 To clientCount
        If (timer1oldState(i) <> Winsock1(i).state) Then
            timer1oldState(i) = Winsock1(i).state
            s = stateToString(timer1oldState(i))
            If (iAmServer) Then
                n = " [" & getHostName(Winsock1(i).RemoteHostIP) & "]"
                Form1.Caption = "WinSock SERVER - " & s & n
            Else
                n = " [" & rHostName & "]"
                Form1.Caption = "WinSock - " & s & n
            End If
        End If
    Next i
End Sub
 
Private Function stateToString(state As Long) As String
    Dim s As String
    Select Case state
        Case 0: s = "Connection closed"
        Case 1: s = "Connection open"
        Case 2: s = "Listening"
        Case 3: s = "Connection pending"
        Case 4: s = "Resolving host"
        Case 5: s = "Host resolved"
        Case 6: s = "Connecting"
        Case 7: s = "Connected"
        Case 8: s = "Closing"
        Case 9: s = "Error"
        Case Else: s = "ERROR: Socket-state unknown"
    End Select
    stateToString = s
End Function
 
Private Sub Winsock1_Close(index As Integer)
    On Error GoTo Hell
    Dim i As Long
    If (iAmServer) Then
        If (index = ROOTSOCKET) Then
            addLine "ERROR: Someone accessed Server-ROOTSOCKET: " & _
                     Winsock1(index).RemoteHostIP
        Else
            addLine "Connection closed by client " & Winsock1(index).RemoteHostIP
            i = index
            If (Len(Winsock1(index).Tag) > 0) Then
                sendToAll ">>> " & Winsock1(index).Tag & " has left <<<", i
            End If
            DoEvents
            If (index = clientCount) Then
                Winsock1(index).Close
                Unload Winsock1(index)
                clientCount = clientCount - 1
            Else
                ' closing the client will leave a gap
                ' -> move last client to this gap
                ' --> clientCount is consistent
                Winsock1(index).Close
                Winsock1(index).Tag = "__FREE__"
            End If
        End If
    Else
        Winsock1(index).Close
        addLine "Connection closed by remote host."
    End If
    Exit Sub
Hell:
    errorHandler "Error while closing connection to " & _
                  Winsock1(index).RemoteHostIP
End Sub
 
Private Sub Winsock1_DataArrival(index As Integer, ByVal bytesTotal As Long)
    On Error GoTo Hell
    Dim s As String
    Dim i As Long
    i = index
    Winsock1(index).GetData s, vbString
    If (iAmServer) Then
        If (index > maxClients) Then Exit Sub
        addLine Winsock1(index).Tag & ": " & s
        If (Left$(s, 9) = "nickName=") Then
            Dim oldNickName As String
            Dim newNickName As String
            oldNickName = Winsock1(index).Tag
            If (oldNickName = "__FREE__") Then
                oldNickName = ""
            End If
            newNickName = Right$(s, Len(s) - 9)
            If (Len(newNickName) > 2) Then
                If (nickIsValid(newNickName)) Then
                    Winsock1(index).Tag = newNickName
                    If (oldNickName = "") Then
                        s = ">>> " & newNickName & " has joined <<<"
                        Dim welcomeText As String
                        welcomeText = ">>> Wellcome to WinSock V.0.2 <<<" _
                                      & vbNewLine _
                                      & createClientNameList
                        Winsock1(index).SendData welcomeText
                        DoEvents
                    Else
                        s = ">>> " & oldNickName & " has renamed to " _
                            & newNickName & " <<<"
                        Winsock1(index).SendData ">>> Your new nickName is " _
                            & newNickName & " <<<"
                        DoEvents
                    End If
                Else
                    Winsock1(index).SendData ">>> Bad nickName. " & _
                            "Name is allready in use. <<<" & vbNewLine _
                            & ">>> Connect again with different nickName. <<<"
                    DoEvents
                    Winsock1_Close index
                    Exit Sub
                End If
            Else
                Winsock1(index).SendData ">>> Bad nickName. " & _
                            "At last 3 characters required. <<<"
                DoEvents
                Exit Sub
            End If
        ElseIf (Left$(s, 9) = "listNames") Then
            Dim names As String
            names = createClientNameList
            Winsock1(index).SendData names
            DoEvents
            Exit Sub
        Else
            s = Winsock1(index).Tag & ": " & s
        End If
        sendToAll s, i
    Else
        If (InStr(s, "No more Clients allowed. Goodbey") > 0) Then
            serverIsFull = True
        End If
        addLine s
    End If
    DoEvents
    Exit Sub
Hell:
    errorHandler "Error while receiving data from " & _
                  Winsock1(index).RemoteHostIP
End Sub
 
Private Function nickIsValid(nick As String) As Boolean
    Dim i As Long
    For i = 1 To clientCount
        If (nick = Winsock1(i).Tag) Then
            nickIsValid = False
            Exit Function
        End If
    Next i
    nickIsValid = True
End Function
 
Private Sub sendToAll(text As String, sender As Long)
    Dim i As Long
    For i = 1 To clientCount
        If (i <> sender) Then
            If (Winsock1(i).Tag <> "__FREE__") Then
                If (Winsock1(i).state = sckConnected) Then
                    Winsock1(i).SendData text
                    DoEvents
                Else
                    addLine "ERROR: Cannot send message to" & _
                            "client " & Winsock1(i).RemoteHostIP
                End If
            End If
        End If
    Next i
End Sub
 
Private Function createClientNameList() As String
    Dim i As Long
    Dim res As String
    Dim counter As Long
    res = "List of online Clients:" & vbNewLine
    For i = 1 To clientCount
        If (Winsock1(i).Tag <> "__FREE__") Then
            counter = counter + 1
            res = res & Format(counter, "00") & _
                  ". " & Winsock1(i).Tag & vbNewLine
        End If
    Next i
    createClientNameList = res
End Function
 
Private Sub Winsock1_Error(index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    Err.Number = Number
    Err.Description = Description
    errorHandler "Socket Error"
End Sub
 
Private Sub addLine(s As String)
    addText s & vbNewLine
End Sub
 
Private Sub addText(s As String)
    If (Len(Text4.text) > 25000) Then
        Text4.text = ">>> Reset output-text. Too much text. <<<" & vbNewLine
    End If
    Text4.text = Text4.text & s
    Text4.SelStart = Len(Text4.text)
End Sub
 
Public Sub errorHandler(errText As String)
    Dim displayText As String
    displayText = errText & vbNewLine & _
        "Error Nr.: " & Err.Number & vbNewLine & _
        "Last Dll Error: " & Err.LastDllError & vbNewLine & vbNewLine & _
        Err.Description & vbNewLine & vbNewLine & _
        "Help:" & vbNewLine & _
        WinSockErrorCodes.getTextFromErrorNr(Err.Number)
    MsgBox displayText, vbExclamation, "WinSock"
    If Not (iAmServer) Then
        Winsock1(CLIENT).Close
    End If
    addLine Err.Description
    Err.Clear
End Sub