Hola: Soy nuevo en el foro pero siempre lo visito. He querido aportar con algo ahora, espero a más de alguien pueda serle útil 

Utilizando la API de Winsock

Quizás una de las preguntas que mas se han hecho quienes intentan programar una aplicación Cliente-Servidor bajo Windows, es "¿Cómo uso la API de Winsock?" o "¿Cómo evito el uso de MSWINSCK.OCX?"

En este, y otros foros, se ha hecho muchas veces esta pregunta, y es poco lo que se ha conseguido.

Es sin duda uno de los temas donde se encuentra poca información, y la poca que hay está en inglés, y los manuales o tutoriales que hay son extensos y poco entendibles. Como último recurso sólo nos queda utilizar un módulo ya hecho por otro programador, con cientos de líneas que no entendemos.

La buena noticia es que todos podemos realizar una aplicación utilizando la API de Winsock en pocas lineas de código y un módulo ni tan extenso.

Es por eso que después de mucho averiguar, y leer, logré entender y poner en práctica el funcionamiento de la API de Winsock. Quizás no en un 100%, pero me permitió encontrar algunas funciones en un módulo y crear una aplicación funcional utilizando este método.

En este tutorial intentaré explicar paso a paso cómo realizar una sencilla aplicación Cliente y otra Servidor utilizando 100% la API y evitando el uso de cualquier OCX.

Manos a la obra:

El Cliente

Vamos a abrir VB6 y abrimos un proyecto nuevo. Añadimos los controles necesarios:



Como pueden ver, lleva Label, Textbox, Command, Listview. El texto rojo indica los nombre que les asigné a los controles para que luego no les de error el código.

Ahora vamos al MODULO:

Primero debemos declarar, entre otras cosas, las funciones para utilizar los sockets en Windows y además otras funciones para crear la subclase que nos permitirá interceptar los mensajes que se envién a la ventana (esto lo explicaremos mas adelante)

Option Explicit
 
Private Declare Function accept Lib "wsock32.dll" (ByVal s As Long, _
addr As SOCKADDR, addrlen As Long) As Long
Private Declare Function bind Lib "wsock32.dll" (ByVal s As Long, addr As SOCKADDR, _
ByVal namelen As Long) As Long
Private Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
Private Declare Function Connect Lib "wsock32.dll" Alias "connect" (ByVal s As Long, _
addr As SOCKADDR, ByVal namelen As Long) As Long
Private Declare Function htonl Lib "wsock32.dll" (ByVal hostlong As Long) As Long
Private Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
Private Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inn As Long) As Long
Private Declare Function Listen Lib "wsock32.dll" Alias "listen" (ByVal s As Long, _
ByVal backlog As Long) As Long
Private Declare Function recv Lib "wsock32.dll" (ByVal s As Long, buf As Any, _
ByVal buflen As Long, ByVal Flags As Long) As Long
Private Declare Function Send Lib "wsock32.dll" Alias "send" (ByVal s As Long, _
buf As Any, ByVal buflen As Long, ByVal Flags As Long) As Long
Private Declare Function Socket Lib "wsock32.dll" Alias "socket" (ByVal af As Long, _
ByVal s_type As Long, ByVal protocol As Long) As Long
Private Declare Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As Long
Private Declare Function gethostname Lib "wsock32.dll" (ByVal host_name As String, _
ByVal namelen As Long) As Long
Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVR As Long, _
lpWSAD As WSADataType) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
Private Declare Function WSAIsBlocking Lib "wsock32.dll" () As Long
Private Declare Function WSACancelBlockingCall Lib "wsock32.dll" () As Long
Private Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
Private Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, _
ByVal hWnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" _
(ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, _
ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, _
ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
Private Declare Sub CopyMemoryIP Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, _
ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb As Long)
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
 

Como pueden ver hemos llamado a "wsock32.dll" que contiene todas las funciones Winsock que necesitamos.

Ahora vamos a definir los tipos de datos necesarios para trabajar con Winsock:

Private Type WSADataType
 wVersion As Integer
 wHighVersion As Integer
 szDescription As String * 257
 szSystemStatus As String * 129
 iMaxSockets As Integer
 iMaxUdpDg As Integer
 lpVendorInfo As Long
End Type
 
Private Type HostEnt
 hName As Long
 hAliases As Long
 hAddrType As Integer
 hLen As Integer
 hAddrList As Long
End Type
 
Private Type SOCKADDR
 sin_family As Integer
 sin_port As Integer
 sin_addr As Long
 sin_zero As String * 8
End Type

Las Constantes:

Private Const WINSOCK_MESSAGE As Long = 1025
Private Const INADDR_NONE As Long = &HFFFF
Private Const INADDR_ANY As Long = &H0
Private Const IPPROTO_TCP As Long = 6
Private Const INVALID_SOCKET As Long = -1
Private Const SOCKET_ERROR As Long = -1
Private Const SOCK_STREAM As Long = 1
Private Const AF_INET As Long = 2
Private Const PF_INET As Long = 2
Private Const FD_READ As Long = &H1&
Private Const FD_WRITE As Long = &H2&
Private Const FD_OOB As Long = &H4&
Private Const FD_ACCEPT As Long = &H8&
Private Const FD_CONNECT As Long = &H10&
Private Const FD_CLOSE As Long = &H20&
Private Const GWL_WNDPROC As Long = (-4)

Las Variables:

Private PrevProc As Long
Private bIsInit As Boolean
Private hWin As Long
Private m_ObjectHost As Object
Private TimeOut As Long
 
Public PortOpen As Collection
Public PortSesion As Collection
 
Public Sockets As Collection
Public IPAddresses As Collection
Public PortConection As Collection
 
Public CurrentSocketHandle As Long

Listo. Ahora seguimos (en el mismo módulo). Vamos a crear las funciones que nos permitirán crear y utilizar los socket.

Aquí debemos llamar a la API "CreateWindowEx" para crear el socket. A la función le pasaremos como argumento ObjectHost, que es la ventana o formulario principal. De esta forma, podemos posteriormente interceptar los mensajes que lleguen a este socket, por ejemplo cuando el Servidor nos envié datos o nos cierre la conexión:

Public Function InitWinSock(ObjectHost As Object) As Boolean
 
 Dim StartupData As WSADataType
 
 Set Sockets = New Collection
 Set IPAddresses = New Collection
 Set PortOpen = New Collection
 Set PortSesion = New Collection
 Set PortConection = New Collection
 
 Set m_ObjectHost = ObjectHost
 
 If Not bIsInit Then
 If Not WSAStartup(&H101, StartupData) Then
 bIsInit = True
 hWin = CreateWindowEx(0&, "STATIC", "SOCKET_WINDOW", _
0&, 0&, 0&, 0&, 0&, 0&, 0&, App.hInstance, ByVal 0&)
 PrevProc = SetWindowLong(hWin, GWL_WNDPROC, _
AddressOf WindowProc)
 Else
 bIsInit = False
 End If
 End If
 
 InitWinSock = bIsInit
 
End Function
 

Ahora creamos una función que será llamada en el Form_Unload:

Public Sub TerminateWinSock()
 
 Dim Ret As Long
 Dim Cnt As Long
 
 For Cnt = 1 To Sockets.Count
 WsClose Sockets.Item(1)
 Next
 
 For Cnt = 1 To PortSesion.Count
 closesocket PortSesion.Item(1)
 PortSesion.Remove (1)
 PortOpen.Remove (1)
 Next
 
 If WSAIsBlocking Then WSACancelBlockingCall
 
 Call WSACleanup
 
 bIsInit = False
 SetWindowLong hWin, GWL_WNDPROC, PrevProc
 DestroyWindow hWin
 
 Set Sockets = Nothing
 Set IPAddresses = Nothing
 Set PortConection = Nothing
 Set PortSesion = Nothing
 Set PortOpen = Nothing
 
End Sub
 

Importante: Cuando ejecuten la aplicación desde el IDE de VB, no lo hagan con el botón "Stop", sino que deben cerrar la aplicación, ya que de lo contrario VB se cerrará y no preguntará por guardar cambios.

Una función muy importante: La que nos permite abrir la conexión:

Public Function WsConnect(ByVal Host As String, _
ByVal Port As Long) As Long
 
 Dim s As Long
 Dim Sockin As SOCKADDR
 
 Sockin.sin_family = AF_INET
 Sockin.sin_port = htons(Port)
 
 If Sockin.sin_port = INVALID_SOCKET Then Exit Function
 
 Sockin.sin_addr = GetHostByNameAlias(Host$)
 
 If Sockin.sin_addr = INADDR_NONE Then Exit Function
 
 s = Socket(PF_INET, SOCK_STREAM, IPPROTO_TCP)
 If s < 0 Then Exit Function
 
 If Connect(s, Sockin, 16) <> 0 Then
 If s Then closesocket s
 Exit Function
 End If
 
 If WSAAsyncSelect(s, hWin, ByVal WINSOCK_MESSAGE, _
ByVal FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE) Then
 closesocket s
 Else
 IPAddresses.Add GetAscIp(Sockin.sin_addr), CStr(s)
 Sockets.Add s, CStr(s)
 PortConection.Add Port, CStr(s)
 CurrentSocketHandle = s
 WsConnect = s
 End If
 
End Function
 

Otra función importante. Para enviar datos al servidor:

Public Function SendData(Socket As Long, Data As Variant) As Boolean
 Dim Ret As Long
 Dim TheMsg() As Byte, sTemp$
 TheMsg = ""
 
 Select Case VarType(Data)
 Case 8209 'byte array
 sTemp = Data
 TheMsg = sTemp
 Case 8 'String
 sTemp = StrConv(Data, vbFromUnicode)
 Case Else
 sTemp = CStr(Data)
 sTemp = StrConv(Data, vbFromUnicode)
 End Select
 TheMsg = sTemp
 
 If UBound(TheMsg) > -1 Then
 Ret = Send(Socket, TheMsg(0), (UBound(TheMsg) - LBound(TheMsg) + 1), 0)
 
 If Ret = SOCKET_ERROR Then
 TimeOut = GetTickCount + 5000
 Do While Ret = SOCKET_ERROR
 Ret = Send(Socket, TheMsg(0), (UBound(TheMsg) - LBound(TheMsg) + 1), 0)
 DoEvents
 Sleep 10
 If TimeOut < GetTickCount Then Exit Do
 Loop
 End If
 SendData = Ret <> SOCKET_ERROR
 End If
 
End Function
 

Para cerrar la conexión:

Public Function WsClose(ByVal s As Long) As Boolean
On Local Error Resume Next
 WsClose = closesocket(s)
 IPAddresses.Remove CStr(s)
 Sockets.Remove CStr(s)
 PortConection.Remove CStr(s)
End Function
 

Estas funciones nos devuelven la IP local y el HOST local:

Public Function GetLocalIp() As String
 
 Dim sHostName As String * 256
 Dim lpHost As Long
 Dim Host As HostEnt
 Dim dwIPAddr As Long
 Dim tmpIPAddr() As Byte
 Dim i As Integer
 Dim sIPAddr As String
 
 lpHost = gethostbyname(sHostName)
 
 CopyMemoryIP Host, lpHost, Len(Host)
 CopyMemoryIP dwIPAddr, Host.hAddrList, 4
 ReDim tmpIPAddr(1 To Host.hLen)
 CopyMemoryIP tmpIPAddr(1), dwIPAddr, Host.hLen
 For i = 1 To Host.hLen
 sIPAddr = sIPAddr & tmpIPAddr(i) & "."
 Next
 GetLocalIp = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)
 
End Function
 
 
Public Function LocalHostName() As String
 Dim sHostName As String * 256
 If gethostname(sHostName, 256) <> INVALID_SOCKET Then
 LocalHostName = Trim$(sHostName)
 End If
End Function
 
 

Esta es la función de la que hablábamos anteriormente. Nos permite interceptar los mensajes que Windows nos envía a la ventana:

Private Function WindowProc(ByVal hWnd As Long, _
ByVal uMsg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
 
On Local Error Resume Next
 
 If uMsg = WINSOCK_MESSAGE Then
 
 Dim mIP As String
 Dim mPuerto As String
 
 CurrentSocketHandle = wParam
 
 Select Case lParam
 
 Case FD_ACCEPT
 Dim s As Long, tempAddr As SOCKADDR
 s = accept(wParam, tempAddr, Len(tempAddr))
 
 mIP = GetAscIp(tempAddr.sin_addr)
 mPuerto = PortOpen(CStr(wParam))
 
 IPAddresses.Add mIP, CStr(s)
 Sockets.Add s, CStr(s)
 PortConection.Add mPuerto, CStr(s)
 
 Call m_ObjectHost.Socket_Conect(s, mIP, mPuerto)
 
 Case FD_CONNECT
 'Debug.Print "FD_CONNECT"
 
 Case FD_WRITE
 'Debug.Print "FD_WRITE"
 
 Case FD_READ
 Dim sTemp As String, lRet As Long, szBuf As String
 
 Do
 szBuf = String(1024, 0)
 lRet = recv(wParam, ByVal szBuf, Len(szBuf), 0)
 If lRet > 0 Then sTemp = sTemp + Left$(szBuf, lRet)
 Loop Until lRet <= 0
 
 If LenB(sTemp) > 0 Then
 mIP = IPAddresses(CStr(wParam))
 mPuerto = PortConection(CStr(wParam))
 
 Call m_ObjectHost.Socket_DataArrival(wParam, _
mIP, mPuerto, sTemp)
 End If
 
 Case Else 'FD_CLOSE
 mPuerto = PortConection(CStr(wParam))
 mIP = IPAddresses(CStr(wParam))
 WsClose wParam
 
 Call m_ObjectHost.Socket_Close(wParam, mIP, mPuerto)
 
 End Select
 
 Else
 WindowProc = CallWindowProc(PrevProc, hWnd, uMsg, wParam, lParam)
 End If
 
End Function
 

Por último, otras funciones para tratar IP y Hosts:

Private Function GetHostByNameAlias(ByVal HostName As String) As Long
 
 On Error Resume Next
 Err.Clear
 
 Dim heDestHost As HostEnt
 Dim addrList As Long
 Dim retIP As Long
 Dim phe As Long
 
 retIP = inet_addr(HostName)
 
 If retIP = INADDR_NONE Then
 phe = gethostbyname(HostName)
 If phe <> 0 Then
 MemCopy heDestHost, ByVal phe, 16
 MemCopy addrList, ByVal heDestHost.hAddrList, 4
 MemCopy retIP, ByVal addrList, heDestHost.hLen
 Else
 retIP = INADDR_NONE
 End If
 End If
 
 GetHostByNameAlias = retIP
 
 If Err Then GetHostByNameAlias = INADDR_NONE
End Function
 
Private Function GetAscIp(ByVal inn As Long) As String
 On Error Resume Next
 Dim lpStr&
 Dim nStr&
 Dim retString$
 
 retString = String(32, 0)
 
 lpStr = inet_ntoa(inn)
 If lpStr = 0 Then
 GetAscIp = "255.255.255.255"
 Exit Function
 End If
 nStr = lstrlen(lpStr)
 If nStr > 32 Then nStr = 32
 MemCopy ByVal retString, ByVal lpStr, nStr
 retString = Left(retString, nStr)
 GetAscIp = retString
 If Err Then GetAscIp = "255.255.255.255"
End Function
 
 

Muy bién. Con esto hemos terminado el módulo.

Lo llamaremos: WinSock32


Ahora, el código del formulario. Creo que no hace falta explicarlo ya que todo corresponde a funciones que ya todos saben manejar (eso creo).

Lo principal aquí es que se establece una conexión, se envián y se reciben datos.

Option Explicit
 
Dim Conectado As Boolean
 
Private Sub Form_Load()
 Conectado = False
 WinSock32.InitWinSock Me ' Aqui inicializamos el socket
 txtIP = WinSock32.GetLocalIp ' Obtenemos nuestra IP local
End Sub
 
Private Sub cmdConectar_Click()
 cmdConectar.Enabled = False
 lblEstado.Caption = "Intentando conectar": DoEvents
 If WinSock32.WsConnect(txtIP, txtPuerto) Then 'Si la conexion es exitosa
 lblEstado.Caption = "Conectado con " & txtIP & " en el puerto " & _
 txtPuerto
 Conectado = True
 Else
 lblEstado.Caption = "Error al conectar" 'No se pudo conectar
 cmdConectar.Enabled = True
 Conectado = False
 End If
End Sub
 
Private Sub cmdEnviar_Click()
 If WinSock32.SendData(CurrentSocketHandle, txtMsg.Text) Then 'Intentamos enviar datos al servidor
 lstShow.AddItem "[Cliente]: " & txtMsg.Text
 txtMsg.Text = ""
 Else
 lblEstado.Caption = "Error al enviar mensaje" 'No se pudo enviar
 End If
End Sub
 
Private Sub txtMsg_Change()
'Funcion para habilitar/deshabilitar el boton Enviar
 If Conectado = False Then Exit Sub
 If txtMsg.Text = vbNullString Then
 cmdEnviar.Enabled = False
 Else
 cmdEnviar.Enabled = True
 End If
End Sub
 
Public Sub Socket_DataArrival(ID As Long, IP As String, Puerto As String, _
Data As String) 'Funcion que intercepta datos que llegan al socket
 lstShow.AddItem "[Servidor]: " & Data
End Sub
 
Public Sub Socket_Close(ID As Long, IP As String, Puerto As String) 'Si se cierra la conexion
 cmdConectar.Enabled = True
 lblEstado.Caption = "Desconectado"
 Conectado = False
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
 WinSock32.TerminateWinSock 'Importante llamada al descargar formulario
End Sub
 

Ahora compilamos y ejecutamos. Tenemos listo nuestro Cliente Winsock sin usar un OCX.

Lo más bonito de todo esto, es que el programa está testeado en Windows XP, Vista y Seven y funciona perfectamente

En la 2º parte, explicaremos cómo programar la parte servidor (la que pone a la escucha un puerto y recibe la conexión) también utilizando llamadas a la API.

De esta manera, nuestra aplicación será 100% portable, ya que no tiene absolutamente ninguna dependencia con Controles ActiveX

Nota Final: Lo importante de todo esto es quienes quieran aprender, traten de ENTENDER el código. No basta con COPIAR y PEGAR, pues de esa manera nunca podrán aprender.

Espero que a más de alguien le sirva.

Pronto la 2º parte...

Saludos!