Cuando intento utilizar la fn accept siempre me devuelve SOCK_INVALID, pero aun asi establece la conexion con el client..... Y no puedo utilizar las fn send y recv.. bueno aqui esta el codigo.... Bueno con unos cuantos cambios que le hecho...
Option Explicit
'Servidor simple con Sockets del API Winsock2. 'Autor: HaXprT 'Fecha: 01/03/2002 'Ultima actualización: 05/03/2002
'Constantes del API Winsock 2 Private Const INVALID_SOCKET = -1 Private Const SOCKET_ERROR = -1 Private Const WSADESCRIPTION_LEN = 256 Private Const WSASYSSTATUS_LEN = 128 Private Const AF_INET = 2 Private Const INADDR_ANY = 0 Private Const SOCK_STREAM = 1 Private Const SOCK_DGRAM = 2
'Tipos de Datos del API Winsock 2 Private Type WSAData_Type wVersion As Integer wHighVersion As Integer szDescription(WSADESCRIPTION_LEN) As Byte szSystemStatus(WSASYSSTATUS_LEN) As Byte iMaxSockets As Integer 'U_SHORT iMaxUdpDg As Integer 'U_SHORT lpVendorInfo As Long End Type
'Estructura IN_ADDR implementada sin uniones Private Type IN_ADDR S_addr As Long 'U_LONG End Type
Private Type SOCKADDR_IN sin_family As Integer sin_port As Integer 'U_SHORT sin_addr As Long sin_zero(7) As Byte 'array de 8 bytes End Type
'Funciones del API Winsock 2 ' Ojo, probar con "ws2_32" Private Declare Function socket Lib "ws2_32" (ByVal AF As Long, _ ByVal Tipo As Long, _ ByVal Protocol As Long) As Long
Private Declare Function WSAStartup Lib "ws2_32" (ByVal wVersionRequested As Integer, _ ByRef lpWSAData As Any) As Long
Private Declare Function WSACleanup Lib "ws2_32" () As Long
Private Declare Function WSAGetLastError Lib "ws2_32" () As Long
Private Declare Function htons Lib "ws2_32" (ByVal hostshort As Integer) As Long 'U_SHORT
Private Declare Function bind Lib "ws2_32" (ByVal s As Long, _ name As SOCKADDR_IN, _ ByVal namelen As Long) As Long
Private Declare Function listen Lib "ws2_32" (ByVal s As Long, _ ByVal backlog As Long) As Long
Private Declare Function send Lib "ws2_32" (ByVal Sock As Long, _ ByVal Buf As Byte, _ ByVal Lenght As Long, _ ByVal Flags As Long) As Long
Private Declare Function accept Lib "ws2_32" (ByVal hSock&, _ from As SOCKADDR_IN, _ ByVal LenFrom&) As Long
Private Declare Function recv Lib "ws2_32" (ByVal Sock As Long, _ ByVal Buf As Byte, _ ByVal Lenght As Long, _ ByVal Flags As Long) As Long
Private Declare Function closesocket Lib "ws2_32" (ByVal s As Long) As Long
Dim SockServer As Long Function MakeWord(ByVal low As Byte, ByVal high As Byte) As Integer
MakeWord = high * 256 + low
End Function
Function LoByte(ByVal Num As Integer) As Byte
LoByte = Num And 255
End Function
Function HiByte(ByVal Num As Integer) As Byte
Num = Num / 256 HiByte = Num And 255
End Function
Function ComplementoADos(Num As Long) As Integer ' Esta función recibe un número entero que debe estar entre 0..65535, ' el cual es el rango para un tipo de dato unsigned short en C, ' y lo convierte a un valor equivalente para ser almacenado en un ' tipo de dato Integer de Visual Basic (-32768..32767)
If Num > 32767 Then Num = Num - 1 ComplementoADos = -(Num Xor 65535)
Else ComplementoADos = Num End If
End Function
Function ByteArrayToString(Arreglo() As Byte, Tamaño As Long) As String Dim Str As String Dim i As Integer
For i = 0 To Tamaño - 1 Str = Str & Chr(Arreglo(i)) Next
ByteArrayToString = Str
End Function
'*** Mis Funciones de Alto Nivel *** ' Inica el socket del servidor y lo retorna si todo sale bien. ' En caso de fallo retorna SOCKET_ERROR Private Function IniciarSocketServidor(Puerto As Long, Cola As Long) As Long Dim Error As Long Dim wVersionRequested As Integer Dim Sin As SOCKADDR_IN Dim wsaData As WSAData_Type
wVersionRequested = MakeWord(2, 2) Error = WSAStartup(wVersionRequested, wsaData)
If Error <> 0 Then
MsgBox "error", vbExclamation, "Socket Invalido 1" IniciarSocketServidor = SOCKET_ERROR Exit Function
End If
If (LoByte(wsaData.wVersion) <> 2) Or (HiByte(wsaData.wVersion) <> 2) Then
Call WSACleanup MsgBox "Socket Invalido, Versión de Winsock Incorrecta", vbExclamation, Error IniciarSocketServidor = SOCKET_ERROR Exit Function
End If
SockServer = socket(AF_INET, SOCK_STREAM, 0)
If SockServer = INVALID_SOCKET Then
Error = WSAGetLastError() Call WSACleanup MsgBox "Error al llamar a socket: " & Error, vbExclamation, "Error" IniciarSocketServidor = SOCKET_ERROR Exit Function End If
Sin.sin_family = AF_INET Sin.sin_addr = INADDR_ANY Sin.sin_port = ComplementoADos(htons(Puerto))
If bind(SockServer, Sin, Len(Sin)) = SOCKET_ERROR Then
Error = WSAGetLastError() closesocket SockServer Call WSACleanup closesocket (SockServer) MsgBox "Error al llamar a bind: " & Error, vbExclamation, "Error" IniciarSocketServidor = SOCKET_ERROR Exit Function
End If
If listen(SockServer, Cola) = SOCKET_ERROR Then
Error = WSAGetLastError() closesocket SockServer Call WSACleanup MsgBox "Error al llamar a listen: " + Error, vbExclamation, "Error" IniciarSocketServidor = SOCKET_ERROR Exit Function End If
IniciarSocketServidor = SockServer
End Function
Private Function AcceptLoop(SockServ As Long)
Dim Buf(255) As Byte, N As Long, hSock&, from As SOCKADDR_IN
Do
hSock = accept(SockServ, from, Len(from))
Debug.Print "bucle"
Loop While hSock = INVALID_SOCKET
Debug.Print "hSock = " & hSock
Do N = 0
N = recv(SockServ, Buf(0), UBound(Buf), 0) If N > 0 Then Debug.Print "Se recibió: " & ByteArrayToString(Buf, N)
Else Debug.Print N
End If
N = send(SockServ, Buf(0), N, 0) If N > 0 Then Debug.Print "Se envió: " & ByteArrayToString(Buf, N)
Else Debug.Print N
End If
DoEvents
Loop
End Function
Private Sub cndCerrar_Click()
closesocket SockServer Unload Me
End Sub
Private Sub CommandIniciarSocket_Click() Dim SockServer As Long
SockServer = IniciarSocketServidor(Val(TextPuerto.Text), 5) If SockServer <> SOCKET_ERROR Then Call AcceptLoop(SockServer)
End Sub
|