CONSOLE WINSOCK(SERVEUR) AVEC COMMANDES SIMPLES V.1.0

Option Explicit

Dim intTemp                     As Integer
Dim intFullCommandLen           As Integer
Dim intCommandLen               As Integer
Dim intComIndex                 As Integer

Dim requestID                   As Long
Dim requestID2                  As Long

Dim strCommand                  As String
Dim strValue                    As String
Dim strEcho                     As String
Dim strComIndex(0 To 10)        As String
Dim strData                     As String

Dim FlagComFound                As Boolean

Private Sub Form_Load()

txtLog.Text = ""
txtComLog.Text = ""
txtCommand.Text = ""

End Sub


Private Sub Form_Resize()

On Error Resume Next

txtLog.Top = 120
txtLog.Left = 25
txtLog.Width = frmMain.Width - 200
txtLog.Height = (frmMain.Height / 2) - 400

txtComLog.Top = txtLog.Height + 200
txtComLog.Left = 25
txtComLog.Width = frmMain.Width - 200
txtComLog.Height = txtLog.Height - 400

txtCommand.Top = txtComLog.Top + txtComLog.Height + 200
txtCommand.Left = 25
txtCommand.Width = frmMain.Width - 200

End Sub

Private Sub txtCommand_KeyPress(KeyAscii As Integer)

'If KeyAscii = vbKeyUp Then
'    intComIndex = intComIndex + 1
'    txtCommand.Text = strComIndex(intComIndex)
'End If

'If KeyAscii = vbKeyDown Then
'    intComIndex = intComIndex - 1
'    txtCommand.Text = strComIndex(intComIndex)
'End If
    

If KeyAscii = vbKeyReturn Then
    'Inutile pour le moment.... perte de temps... LOL
    'strComIndex(10) = strComIndex(9)
    'strComIndex(9) = strComIndex(8)
    'strComIndex(8) = strComIndex(7)
    'strComIndex(7) = strComIndex(6)
    'strComIndex(6) = strComIndex(5)
    'strComIndex(5) = strComIndex(4)
    'strComIndex(4) = strComIndex(3)
    'strComIndex(3) = strComIndex(2)
    'strComIndex(2) = strComIndex(1)
    'strComIndex(1) = strComIndex(0)
    'strComIndex(0) = txtCommand.Text
    
    strCommand = ""
    strValue = ""
    strEcho = ""
    FlagComFound = False
    
    txtCommand.Text = txtCommand.Text & " "
    
    'Identifie la commande
    For intTemp = 1 To Len(txtCommand.Text)
        If Mid(txtCommand.Text, intTemp, 1) <> " " Then
            strCommand = strCommand & Mid(txtCommand.Text, intTemp, 1)
        Else
            FlagComFound = True
            intFullCommandLen = Len(txtCommand.Text)
            intCommandLen = Len(strCommand)
            
            'La commande est trouvée
            'On identifie la valeur donné à la variable
            strValue = Mid(txtCommand.Text, intTemp + 1, intFullCommandLen - intCommandLen + 1)
            
            Select Case UCase(strCommand)
            
            
            '>==================================================<
            '>==================================================<
            '>=LISTING COMPLET DES COMMANDES ET DE LEURS EFFETS=<
            '>==================================================<
            '>==================================================<

            '----------------------------------------------------
            'PARAMÈTRE DU PORT D'ÉCOUTE DU SERVEUR
            '----------------------------------------------------
            Case "SV_LISTENPORT"
            If strValue <> "" Then
                wskServer.LocalPort = strValue
                strEcho = UCase(strCommand) & " Successfully set on " & UCase(strValue)
            Else
                strEcho = UCase(strCommand) & " = " & wskServer.LocalPort
            End If
            '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
            
            '----------------------------------------------------
            'VALEUR DE L'IP DU SERVEUR
            '----------------------------------------------------
            Case "SV_LISTENIP"
            If strValue <> "" Then
                'wskServer.LocalPort = strValue
                'strEcho = UCase(strCommand) & " Successfully set on " & UCase(strValue)
                strEcho = "This value (SV_LISTENIP) cannot be changed"
            Else
                strEcho = UCase(strCommand) & " = " & wskServer.LocalIP
            End If
            '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
            
            '----------------------------------------------------
            'OVERTURE/FERMETURE DU SERVEUR
            '----------------------------------------------------
            Case "SV_LISTEN"
            If Trim(strValue) <> "" Then
                If Trim(strValue) = "1" Then
                    wskServer.Listen
                    strEcho = "Server listening"
                End If
                If Trim(strValue) = "0" Then
                    wskServer.Close
                    strEcho = "Server Closed"
                End If
                'strEcho = UCase(strCommand) & " Successfully set on " & UCase(strValue)
                'strEcho = "This value (SV_LISTENIP) cannot be changed"
            Else
                strEcho = UCase(strCommand) & " = " & wskServer.LocalIP
            End If
            '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
            
            '----------------------------------------------------
            'PARAMÈTRE DU PROTOCOLE SERVEUR
            '----------------------------------------------------
            Case "SV_PROTOCOL"
            If UCase(Trim(strValue)) <> "" Then
                If UCase(Trim(strValue)) = "TCP" Then
                    wskServer.Protocol = sckTCPProtocol
                    strEcho = "Server Protocol set on : TCP/IP"
                End If
                If UCase(Trim(strValue)) = "UDP" Then
                    wskServer.Protocol = sckUDPProtocol
                    strEcho = "Server Protocol set on : UDP"
                End If
                'strEcho = UCase(strCommand) & " Successfully set on " & UCase(strValue)
                'strEcho = "This value (SV_LISTENIP) cannot be changed"
            Else
                strEcho = UCase(strCommand) & " = " & wskServer.LocalIP
            End If
            '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
            
            '----------------------------------------------------
            'COMMANDE HELP QUI RETOURNE LA LISTE DES COMMANDES
            '----------------------------------------------------
            Case "HELP"
            txtComLog.Text = txtComLog.Text & "----------------------------------------------------------" & vbNewLine
            txtComLog.Text = txtComLog.Text & "HELP FUNCTION : COMMAND LISTING                           " & vbNewLine
            txtComLog.Text = txtComLog.Text & "----------------------------------------------------------" & vbNewLine
            txtComLog.Text = txtComLog.Text & "1) SERVER SIDE                                            " & vbNewLine
            txtComLog.Text = txtComLog.Text & ".........................................................." & vbNewLine
            txtComLog.Text = txtComLog.Text & "SV_LISTENPORT[Port] : Server listening Port               " & vbNewLine
            txtComLog.Text = txtComLog.Text & "SV_LISTENIP : Returns server IP                           " & vbNewLine
            txtComLog.Text = txtComLog.Text & "SV_PROTOCOL[TCP-UDP] : Select server protocol (TCP or UDP)" & vbNewLine
            txtComLog.Text = txtComLog.Text & "SV_LISTEN[1-0] : Open/Close server connection             " & vbNewLine
            txtComLog.Text = txtComLog.Text & ".........................................................." & vbNewLine
            txtComLog.Text = txtComLog.Text & "2) OTHER FUNCTIONS                                        " & vbNewLine
            txtComLog.Text = txtComLog.Text & ".........................................................." & vbNewLine
            txtComLog.Text = txtComLog.Text & "HELP : Returns the full listing of commands               " & vbNewLine
            txtComLog.Text = txtComLog.Text & ".........................................................." & vbNewLine
            txtComLog.Text = txtComLog.Text & "----------------------------------------------------------" & vbNewLine
            '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
            
            '>==================================================<
            '>==================================================<
            '>==================== F I N =======================<
            '>==================================================<
            '>==================================================<
            
            End Select
                    
            If strEcho <> "" Then
                txtComLog.Text = txtComLog.Text & _
                    "<" & Day(Date) & "/" & Month(Date) & "/" & Year(Date) & "[" & Time _
                        & "]> " & strEcho & vbNewLine
                GoTo CheckOut
            End If
                    
        End If
    Next intTemp
CheckOut:
txtCommand.Text = ""
End If

End Sub

Private Sub wskServer_ConnectionRequest(ByVal requestID As Long)

If wskServer.State <> 0 Then
    wskServer.Close
    wskServer.Accept requestID
    requestID2 = requestID
    strEcho = "Connection [" & requestID & "] Accepted"
    txtLog.Text = txtLog.Text & _
        "<" & Day(Date) & "/" & Month(Date) & "/" & Year(Date) & "[" & Time _
            & "]> " & strEcho & vbNewLine
End If

End Sub

Private Sub wskServer_DataArrival(ByVal bytesTotal As Long)

wskServer.GetData strData
    
strEcho = "Data Received from ID[" & requestID2 & "] " & strData
txtLog.Text = txtLog.Text & _
    "<" & Day(Date) & "/" & Month(Date) & "/" & Year(Date) & "[" & Time _
        & "]> " & strEcho & vbNewLine

End Sub

Télécharger le zip