Jul 102009
 

Este es un módulo para trabajar con los Socket de Windows, vendría a ser un reemplazo del WinSock.ocx, en este me he basado en el módulo de KPD-Team y lo reformé a mi gusto. Su uso creo, es muy sencillo y práctico, especialmente a la hora de trabajar con múltiples conexiones, si lo utilizan tal vez puedan encontrarse con algunas diferencias con respecto a la forma convencional de trabajo de como se utiliza con el WinSock.ocx.
A continuación voy a dejar dos ejemplos de uso, en el cual expliqué detalladamente, para su fácil entendimiento:
El primero trata de una conexión Cliente-Servidor de tipo Chat donde el Servidor puede escuchar en distintos puertos a la vez y aceptar varias conexiones al mismo tiempo, para la parte Cliente también puede realizar más de una conexión y en diferentes puertos a la vez.
El segundo se trata de una conexión Cliente-Servidor para Transferir Archivos.
Una cosa para resaltar, si es que lo van a usar, es que deben agregar manualmente las subrutinas comentadas en el final del módulo al formulario o módulo clase que llame a la función InitWinSock Me  del módulo WinSock32.
No lo he probado a full, pero creo que está funcionando perfectamente, cualquier inquietud, sugerencia o error pueden utilizar el sistema de comentarios.

Option Explicit

' --------------------------------------------------------------------
' Autor:     Leandro Ascierto
' WEB:       www.leandroascierto.com.ar
' Fecha:     09/07/2009
' Adaptado a mi gusto :)
' Basado en el módulo de KPD-Team  http://www.allapi.net/
'----------------------------------------------------------------------

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)

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

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)

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       ' Colección de los puertos abiertos, tiene como key el ID/Sesión de los puertos Abiertos.
Public PortSesion As Collection      ' Colección de los ID/Sesión de los puertos Abiertos.

Public Sockets As Collection         ' Colección de el ID/Sesión de las Conexiones establecidas.
Public IPAddresses As Collection     ' Colección de las IP de las Conexiones establecidas, tiene como key el ID/Sesión.
Public PortConection As Collection   ' Colección de los Puertos de las Conexiones establecidas, tiene como key el ID/Sesión.

Public CurrentSocketHandle As Long   ' ID de la última sesión activa.

' Esta función inicializa los Socket, debe hallarse al comienzo, y ObjectHost es el formulario o módulo clase que recibirá los Eventos/Mensajes
' En ese formulario o módulo clase deberán ir las líneas comentadas que se encuentran al final de este módulo.

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

' Esta función es importante llamarla cuando se descarga el formulario, nunca cerrar el Visual Basic desde el Stop
' Sino no se ejecutara esta rutina, el IDE de Visual Basic se cerrará automáticamente dando lugar a no guardar los cambios.

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

' Función para conectar, Host es la ip o el dsn a que se quiera conectar, y port el puerto.
' Si conecta la función retorna el ID de la sesión del Socket, de lo contrario 0.

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

' Función para poner a la escucha en determinado puerto.
' Si no ocurre ningún error y el puerto está disponible, la función retorna el ID de la sesión del Socket, de lo contrario 0.

Public Function WsListenInPort(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 = htonl(INADDR_ANY)

    If Sockin.sin_addr = INADDR_NONE Then Exit Function

    s = Socket(PF_INET, SOCK_STREAM, 0)
    If s < 0 Then Exit Function     If bind(s, Sockin, 16) Then         closesocket s         Exit Function     End If     If WSAAsyncSelect(s, hWin, ByVal WINSOCK_MESSAGE, ByVal FD_READ Or FD_WRITE Or FD_CLOSE Or FD_ACCEPT) Then         closesocket s         Exit Function     End If     If Listen(s, 1) Then         closesocket s     Else         WsListenInPort = s         PortOpen.Add Port, CStr(s)         PortSesion.Add s, CStr(s)     End If End Function ' Esta función Cierra un puerto previamente abierto, si se afirma ForceCloseConection, cerrará todas las conexiones establecidas en ese puerto ' de lo contrario, las conexiones que ya estaban establecidas permanecen y pueden seguir enviando mensajes, pero no se podrá hacer una nueva conexión a ese puerto ' si todo sale bien la funcion retorna True. Public Function WsClosePort(ByVal Port As Long, Optional ForceCloseConection As Boolean) As Boolean     On Error GoTo ErrOut     Dim s As Long     Dim Cnt As Long     For Cnt = 1 To PortOpen.Count         If PortOpen(Cnt) = Port Then             s = PortSesion(Cnt)             Exit For         End If     Next     If s = 0 Then Exit Function     closesocket s     PortSesion.Remove CStr(s)     PortOpen.Remove CStr(s)     If ForceCloseConection Then         For Cnt = Sockets.Count To 1 Step -1             If PortConection(Cnt) = Port Then                 WsClose Sockets(Cnt)             End If         Next     End If     WsClosePort = True     Exit Function ErrOut:     WsClosePort = False End Function ' Esta función envía datos al servidor, el primer parámetro es el ID de la sesión, la cual la podemos obtener de Sockets(index) ' o con CurrentSocketHandle que es el último ID de sesión activa. ' El segundo parámetro la data a enviar. ' Si el mensaje se envió con éxito la función devuelve True 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

' Esta función cierra la conexión indicada mediante el ID de sesión que se pase como parámetro
' el ID lo obtenemos de Sockets(index) o con CurrentSocketHandle que es el último ID de sesión activa.
' si todo sale bien la función retorna True.

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

' Función que retorna la IP 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

' Función que retorna el Nombre de Host Local.

Public Function LocalHostName() As String
    Dim sHostName As String * 256
    If gethostname(sHostName, 256) <> INVALID_SOCKET Then
        LocalHostName = Trim$(sHostName)
    End If
End Function

' Función Privada del módulo.
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 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

' Función Privada del módulo.
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

'Funcion Privada del módulo
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

'*=====================ATENCION=====ATENCION======ATENCION=======================*
'*===============================================================================*
'*===============================================================================*
'ESTAS LINEAS DEBEN IR EN EL FORMULARIO O MODULO CLASE DONDE RECIBIRAN LOS EVENTOS
'*===============================================================================*
'*===============================================================================*
'_________________________________________________________________________________________________

'Public Sub Socket_Conect(ID As Long, IP As String, Puerto As String)
'End Sub
'_________________________________________________________________________________________________

'Public Sub Socket_DataArrival(ID As Long, IP As String, Puerto As String, Data As String)
'End Sub
'_________________________________________________________________________________________________

'Public Sub Socket_Close(ID As Long, IP As String, Puerto As String)
'End Sub
'_________________________________________________________________________________________________

Ejemplo: Cliente – Servidor (Chat)
Webcam

Ejemplo: Cliente – Servidor (Transferencia de archivos)
Webcam

  13 Responses to “WinSock32”

  1. Coordial Saludos.
    Necesito que me digan ese proyecto cliente server,tiene un ERROR ,no sed donde pero que lo tiene lo tiene.ufff..

    Leandro por favor tomate la molestia en crearlo un momento,asi tal cual como tienes en Zip..
    y veras tu mismo que pasa.

    Haslo y veras……

    • Hola, no tiene ningun error, yo porlomenos no tengo ningun problema, lo descargue, descomprimi, ejecute en el ide, lo compile nuevamente y todo perfecto, podrias se un poco mas especifico, cual es exactamente el problema. No te conecta?, no lo puedes compilar? te da error al ejecutarlo?, el error esta en alguna linea?

      Saludos.

      PD: si no lo puedes compilar, quizas sea tu antivirus.

  2. Te agradesco tu pronta respuesta.
    Si al ejecutarlo,me da error,en esta linea Private Sub Form_Load()
    WinSock32.InitWinSock Me = Esta es la linea del Error
    TxtIP = WinSock32.GetLocalIp
    End Sub

    Tengo todo aparentemente en orden,las funciones en el modulo llamado WinSock32.todo lo demas,Controles de comando,textbox,list.etc.de el Ide.S.O que tengo es Windowns Vista Rd.Por fa echame una mano,lo necesito,quiero ver que le puedo implementar.No sabes las ganas y el gusto que tengo de ejecutarlo.

    Gracias………………

    • Hola realmente no comprendo cual es el error, vos estas probando el mismo zip que descargaste o este es otro proyecto?, de ser otro proyecto podrías subirlo a un servidor para echarle un vistazo.
      Los dos ejemplos te dan error?, que pasa si lo vas depurando?, cual es el numero de error y descripción.

      Saludos.

  3. Hola..
    Si ya lo he depurado y no encuentro cual es el bug.El numero de descripcion no presenta solo Msg.que dice variable no definida en la linea de codigo que te indique.Yo creo que el problema no es grave,A se me olvidaba decirte que la plataforma que utilizo en Visual Basic 6,es portable,genera Exe.Si depronto sea eso que no creo.

    Hagamos una cosa,enviame el codigo fuente a mi Email. jose_xox_55@hotmail.com .Pero asi como lo haces tu.no como esta en el zip.No le hace si es el mismo enviamelo,depronto alguna cosa por mas minisiosa que sea.ese sea la SOLUCION

    Se te agradese….

  4. Hola

    RUN TIME ERROR «424» Ojecto requerido
    Error en tiempo ejecucion

  5. Los nombres de métodos, variables, constantes y tipos no son claros. Y el fuente no cumple con los estándares de programación.
    Decís que lo explicas detalladamente, pero poca documentación veo sobre su funcionamiento.

    Igual, en tu caso solo destaco que al menos comentaste en las firmas de los métodos públicos.

    Esto sirve únicamente para que alguien lo copie, lo pegue, lo compile, y lo utilice. Te hubiera sido mas sencillo subir la dll compilada, porque esto que pusiste realmente no muestra nada. Y los ejemplos (que yo sepa) son para mostrar el funcionamiento de las cosas.

  6. Hola de nuevo poraqui opinando,pues para mi es entendible el code,puesto que tengo conocimientos medio de programacion,Nunca pude ejecutarlo,una verdadera lastima,a pesar que busque solucion nada no la encontre.

    El codigo esta buenisimoable ,pero algo le falta,el ejecutable funciona muy bien.

    Alguien se tome la molestia de hacerlo de nuevo tal cual como esta ahi,para que vean..que es lo que pasa…ummmmh me tiene desvelado este code…
    Saludes desde Colombia

  7. Hola Leandro,

    Estoy intentando adaptado tu módulo para que funcione en un libro Excel. El control OCX winsock tiene incompatibilidades con VBA por lo que tu modulo parece la alternativa ideal a este control. Tu código tiene muy buena pinta pero no soy capaz de hacerlo funcionar.

    Los cambios que he aplicado son mínimos, a excepción de la siguiente línea:

    hWin = CreateWindowEx(0&, «STATIC», «SOCKET_WINDOW», 0&, 0&, 0&, 0&, 0&, 0&, 0&, App.hInstance, ByVal 0&)

    Que la he cambiado por esta otra:
    hWin = CreateWindowEx(0&, «STATIC», «SOCKET_WINDOW», 0&, 0&, 0&, 0&, 0&, 0&, 0&, ThisWorkbook.Windows(1).hWnd, ByVal 0&)

    No soy capaz de ejecutar la función «InitWinSock». Al intentarlo se muestra el mensaje «No se ha definido Sub o Function». Me muestra este mensaje incluso si comento todas las líneas de la función.

    Por favor, ¿podrías aclararme don esta el error?

    Te adjunto el código de la función, pero si lo prefieres te puedo enviar el código completo.

    Public Function InitWinSock(ObjectHost As Object) As Boolean
     
    Dim StartupData As WSADataType

    If bIsInit Then
    ‘Si ya esta incializado no hacemos nada
    InitWinSock = True
    Exit Function
    End If
     
    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&)
    hWin = CreateWindowEx(0&, «STATIC», «SOCKET_WINDOW», 0&, 0&, 0&, 0&, 0&, 0&, 0&, ThisWorkbook.Windows(1).hWnd, ByVal 0&)

    PrevProc = SetWindowLong(hWin, GWL_WNDPROC, AddressOf WindowProc)
    Else
    bIsInit = False
    End If
    End If
     
    InitWinSock = bIsInit
     
    End Function

    • Hola Jesus, podes remplazar el App.hInstance por 0&, no es imprescindible. hice un test con vba y funciona, cualquier cosa si no logras que te funcione pasa al foro y lo vemos bien, pero funciona bien.

      hWin = CreateWindowEx(0&, «STATIC», «SOCKET_WINDOW», 0&, 0&, 0&, 0&, 0&, 0&, 0&, 0&, ByVal 0&)

  8. muy buen dia, estoy adaptando el codigo API a vb7 64bit, se puede decir que lo he logrado pero hay un detalle no logo obtener datos de llegada he usado los tutoriales para adecuar el codigo a 64bit longptr, ptrsafe y esas cosas sin embargo aunque conecta no logra obtener la trama si tiene alguna pista o desea el codigo nuevo para yo enviarselo y tambien podria servir para nuevos programadores que estan lidiando con office 365 64bit que de seguro les esta costando trabajar con socket quedo atento muchas gracias por el aporte que hay hecho.

    • hola sin ver su código esta difícil predecir que esta mal, pero es muy probable que tenga mal la funcion WindowProc, tendria que quear de esta forma para x64

      Private Function WindowProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

      cualquier cosa cuelgue un enlace de su archivo para ver si lo puedo hacer correrr.

 Leave a Reply

You may use these HTML tags and attributes: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

(required)

(required)