frmmain.frm

Winsock Auto Find Server

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmMain 
   Caption         =   "Server"
   ClientHeight    =   5250
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   8430
   LinkTopic       =   "Form1"
   ScaleHeight     =   5250
   ScaleWidth      =   8430
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer1 
      Interval        =   333
      Left            =   1350
      Top             =   315
   End
   Begin MSWinsockLib.Winsock SckTCP 
      Left            =   765
      Top             =   315
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock SckUDP 
      Left            =   180
      Top             =   315
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.ListBox lstMessages 
      Height          =   4545
      Left            =   90
      TabIndex        =   0
      Top             =   135
      Width           =   8160
   End
   Begin VB.TextBox txtSendMessage 
      Height          =   285
      Left            =   90
      TabIndex        =   1
      Top             =   4770
      Width           =   7035
   End
   Begin VB.CommandButton cmdSend 
      Caption         =   "&Send"
      Height          =   285
      Left            =   7245
      TabIndex        =   2
      Top             =   4770
      Width           =   1005
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' Made By Michael Ciurescu (CVMichael)


Private Const DiscoveryPort As Long = 4111
Private Const ResponsePort As Long = 4112

Private Const TCP_ListenPort As Long = 4511

Private Sub Form_Load()
    ' Prepare UDP Broadcasting and UDP Listeing
    With SckUDP
        .Close
        .Protocol = sckUDPProtocol
        .RemoteHost = "255.255.255.255"
        .LocalPort = DiscoveryPort
        .RemotePort = ResponsePort
        
        ' start listening for UDP packets
        .Bind DiscoveryPort
    End With
    
    ListenTCP
End Sub

Private Sub ListenTCP()
    With SckTCP
        .Close
        .LocalPort = TCP_ListenPort
        
        ' Start listening for TCP connections
        .Listen
    End With
End Sub

Private Sub SckTCP_Close()
    SckTCP.Close
    ListenTCP
End Sub

Private Sub SckUDP_DataArrival(ByVal bytesTotal As Long)
    Dim MSG As String
    
    ' Received message from client
    SckUDP.GetData MSG, vbString
    
    ' Check if message is from a "friendly" application (our client application)
    If MSG = "CLIENT|What's your IP ?" Then
        ' Broadcast back our IP and TCP port number
        SckUDP.SendData "SERVER|" & SckUDP.LocalIP & "," & TCP_ListenPort
    End If
End Sub

Private Sub txtSendMessage_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        cmdSend_Click
        KeyAscii = 0
    End If
End Sub

Private Sub cmdSend_Click()
    If Len(Me.txtSendMessage.Text) > 0 Then
        SckTCP.SendData Me.txtSendMessage.Text
        
        On Error Resume Next
        lstMessages.AddItem "Server: " & Me.txtSendMessage.Text
        lstMessages.TopIndex = lstMessages.ListCount
        
        Me.txtSendMessage.Text = ""
    End If
End Sub

Private Sub SckTCP_ConnectionRequest(ByVal requestID As Long)
    SckTCP.Close
    SckTCP.Accept requestID
End Sub

Private Sub SckTCP_DataArrival(ByVal bytesTotal As Long)
    Dim MSG As String
    
    SckTCP.GetData MSG, vbString
    
    lstMessages.AddItem "Client: " & MSG
    On Error Resume Next
    lstMessages.TopIndex = lstMessages.ListCount
End Sub

Private Sub Timer1_Timer()
    Dim TmpStr As String
    
    TmpStr = "Server - " & Choose(SckTCP.State + 1, "Closed", "Open", "Listening", "Connection pending", "Resolving host", "Host resolved", "Connecting", "Connected", "Server is disconnecting", "Error")
    
    If Me.Caption <> TmpStr Then Me.Caption = TmpStr
End Sub