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)
Código
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:
Código
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:
Código
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:
Código
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:
Código
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:
Código
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:
Código
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:
Código
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:
Código
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:
Código
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:
Código
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:
Código
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.
Código
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!