Results 1 to 6 of 6

Thread: WebSocket: recv function crash

  1. #1

    Thread Starter
    Addicted Member
    Join Date
    Jul 2021
    Posts
    193

    WebSocket: recv function crash

    So I wanted to have a nice File Download function with progress indication - I have it working in VC. Just translated it to VB6.
    All initializations looks fine - exactly same results as VC.
    HOWEVER, executing the recv function causes an immediate colossal crash of IDE.

    Here is the code:

    Code:
    Option Explicit
    
    Private Const GENERIC_READ = &H80000000
    Private Const GENERIC_WRITE = &H40000000
    Private Const CREATE_ALWAYS = 2
    Private Const FILE_SHARE_READ = &H1
    
    Private Const AF_INET As Long = 2
    Private Const SOCK_STREAM As Long = 1
    Private Const IPPROTO_TCP As Long = 6
    
    Private Type SOCKADDR
        sin_family As Integer
        sin_port As Integer
        sin_addr As Long
        sin_zero As String * 8
    End Type
    
    Private Type WSADATA
        wVersion As Integer
        wHighVersion As Integer
        szDescription(0 To 256) As Byte
        szSystemStatus(0 To 128) As Byte
        iMaxSockets As Integer
        iMaxUdpDg As Integer
        lpVendorInfo As Long
    End Type
    
    Private Type ADDRINFO
        ai_flags As Long       ' AI_PASSIVE, AI_CANONNAME, AI_NUMERICHOST
        ai_family As Long      ' PF_xxx
        ai_socktype As Long    ' SOCK_xxx
        ai_protocol As Long    ' 0 or IPPROTO_xxx for IPv4 and IPv6
        ai_addrlen As Long     ' Length of ai_addr
        ai_canonname As Long   ' Canonical name for nodename
        ai_addr As Long        ' Binary address
        ai_next As Long        ' Next structure in linked list
    End Type
    
    
    Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Long)
    
    Private Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequired As Integer, ByRef lpWSAData As WSADATA) As Long
    Private Declare Function gethostbyname Lib "ws2_32.dll" (ByVal name As String) As Long
    Private Declare Function socket Lib "ws2_32.dll" (ByVal af As Long, ByVal lType As Long, ByVal protocol As Long) As Long
    Private Declare Function recv Lib "ws2_32.dll" (ByVal s As Long, ByVal buf As String, ByVal lLen As Long, ByVal flags As Long) As Long
    Private Declare Function connect Lib "ws2_32.dll" (ByVal s As Long, ByVal pSockAdr As Long, ByVal namelen As Long) As Long
    Private Declare Function htons Lib "ws2_32.dll" (ByVal hostshort As Integer) As Integer
    Private Declare Function send Lib "ws2_32.dll" (ByVal s As Long, ByVal buf As String, ByVal lLen As Long, ByVal flags As Long) As Long
    Private Declare Function closesocket Lib "ws2_32.dll" (ByVal s As Long) As Long
    Private Declare Function getaddrinfo Lib "ws2_32.dll" (ByVal host As String, ByVal ServiceName As Long, ByRef Hints As ADDRINFO, ByRef adr As Long) As Long
    Private Declare Sub freeaddrinfo Lib "ws2_32.dll" (ByVal pAdr As Long)
    
    Private Declare Function CreateFileW Lib "kernel32" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Private Declare Function WriteFile Lib "kernel32.dll" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToWrite As Long, ByRef lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
    
    Dim wsa As WSADATA
    
    Public Sub DownloadStart(ByVal URL As String, Optional ByVal Mode As AsyncReadConstants = vbAsyncReadResynchronize)
    vbAsyncReadForceUpdate
    End Sub
    
    Function DownloadUrl(sUrl, sFile)
    Dim domain As String
    Dim p As Long, p2 As Long
    Dim pHost As Long
    Dim sock As Long
    Dim server_addr As SOCKADDR
    Dim send_data As String
    Dim hFile As Long
    Dim bytes_received As Long
    Dim buffer() As Byte
    Dim host As String
    Dim Hints As ADDRINFO, targetAdressInfo As ADDRINFO, pAdrInfo As Long
    Dim ret As Long
    
    If wsa.wVersion = 0 Then If WSAStartup(514, wsa) Then DownloadUrl = "Error WSAStartUp": Exit Function
    p = InStr(sUrl, "//")
    p2 = InStr(p + 2, sUrl, "/")
    domain = Mid(sUrl, p + 2, p2 - p - 2)
    host = Left(sUrl, p2 - 1)
    
    Hints.ai_family = AF_INET
    Hints.ai_protocol = IPPROTO_TCP
    Hints.ai_socktype = SOCK_STREAM
    ret = getaddrinfo(domain, 0, Hints, pAdrInfo)
    If ret <> 0 Or pAdrInfo = 0 Then DownloadUrl = "getaddrinfo": Exit Function
    
    server_addr.sin_family = AF_INET
    server_addr.sin_port = htons(80)
    GetMem4 pAdrInfo + 24, p
    GetMem4 p + 4, server_addr.sin_addr
    freeaddrinfo pAdrInfo
    
    sock = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
    If sock = -1 Then DownloadUrl = "Error socket": Exit Function
    
    If connect(sock, VarPtr(server_addr), Len(server_addr)) = -1 Then DownloadUrl = "Error connect": closesocket sock: Exit Function
    send_data = "GET " & sUrl & " HTTP/1.1" & vbCrLf & "Host: " & host & vbCrLf & "Connection: close" & vbCrLf & vbCrLf
    If send(sock, send_data, Len(send_data), 0) = -1 Then DownloadUrl = "Error send": closesocket sock: Exit Function
    hFile = CreateFileW(StrPtr(sFile), GENERIC_WRITE, FILE_SHARE_READ, 0, CREATE_ALWAYS, 0, 0)
    If hFile = -1 Then DownloadUrl = "Error CreateFile": closesocket sock: Exit Function
    ReDim buffer(0 To 1000000)
    Do
        bytes_received = recv(sock, VarPtr(buffer(0)), 1000000, 0)
        If bytes_received = 0 Then Exit Do
        If bytes_received < 0 Then DownloadUrl = "receive": Exit Do
        WriteFile hFile, VarPtr(buffer(0)), bytes_received, bytes_received, 0
    Loop
    
    jClean:
    CloseHandle hFile
    closesocket sock
    End Function

  2. #2
    Angel of Code Niya's Avatar
    Join Date
    Nov 2011
    Posts
    8,598

    Re: WebSocket: recv function crash

    I don't have the time at the moment to go through all that code with a fine tooth comb. It would help immensely if you could tell us line causes the crash so that we can work from there to find the issue.

    Off the top of my head though, I'm guessing there is some kind of fencepost error or something causing a read or write into memory it's not supposed to. Things like that usually crash the IDE.
    Treeview with NodeAdded/NodesRemoved events | BlinkLabel control | Calculate Permutations | Object Enums | ComboBox with centered items | .Net Internals article(not mine) | Wizard Control | Understanding Multi-Threading | Simple file compression | Demon Arena

    Copy/move files using Windows Shell | I'm not wanted

    C++ programmers will dismiss you as a cretinous simpleton for your inability to keep track of pointers chained 6 levels deep and Java programmers will pillory you for buying into the evils of Microsoft. Meanwhile C# programmers will get paid just a little bit more than you for writing exactly the same code and VB6 programmers will continue to whitter on about "footprints". - FunkyDexter

    There's just no reason to use garbage like InputBox. - jmcilhinney

    The threads I start are Niya and Olaf free zones. No arguing about the benefits of VB6 over .NET here please. Happiness must reign. - yereverluvinuncleber

  3. #3

    Thread Starter
    Addicted Member
    Join Date
    Jul 2021
    Posts
    193

    Re: WebSocket: recv function crash

    The crash happens in the loop near the end in this line:
    Code:
    bytes_received = recv(sock, VarPtr(buffer(0)), 1000000, 0)

  4. #4
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: WebSocket: recv function crash

    Just use an instance of WinHttpRequest. Make an async request and handle the OnResponseDataAvailable event to report progress.

    You shouldn't block the UI thread the way you are.

  5. #5
    Member
    Join Date
    Jan 2018
    Posts
    32

    Re: WebSocket: recv function crash

    I have fixed your crash. The problem was with the api declaration
    Private Declare Function recv Lib "ws2_32.dll" (ByVal s As Long, ByVal buf As Long, ByVal lLen As Long, ByVal flags As Long) As Long

    Code:
    ReDim buffer(0 To 1000)
        bytes_received = recv(sock, VarPtr(buffer(0)), UBound(buffer) + 1, 0)
    Also note in side loop a lengthy buffer is not required. you can read by small parts thus you can show a progress. You need to parse the HTTP headers to get the Content-Length.
    Code:
    Option Explicit
    
    Private Const GENERIC_READ = &H80000000
    Private Const GENERIC_WRITE = &H40000000
    Private Const CREATE_ALWAYS = 2
    Private Const FILE_SHARE_READ = &H1
    
    Private Const AF_INET As Long = 2
    Private Const SOCK_STREAM As Long = 1
    Private Const IPPROTO_TCP As Long = 6
    
    Private Type SOCKADDR
        sin_family As Integer
        sin_port As Integer
        sin_addr As Long
        sin_zero As String * 8
    End Type
    
    Private Type WSADATA
        wVersion As Integer
        wHighVersion As Integer
        szDescription(0 To 256) As Byte
        szSystemStatus(0 To 128) As Byte
        iMaxSockets As Integer
        iMaxUdpDg As Integer
        lpVendorInfo As Long
    End Type
    
    Private Type ADDRINFO
        ai_flags As Long       ' AI_PASSIVE, AI_CANONNAME, AI_NUMERICHOST
        ai_family As Long      ' PF_xxx
        ai_socktype As Long    ' SOCK_xxx
        ai_protocol As Long    ' 0 or IPPROTO_xxx for IPv4 and IPv6
        ai_addrlen As Long     ' Length of ai_addr
        ai_canonname As Long   ' Canonical name for nodename
        ai_addr As Long        ' Binary address
        ai_next As Long        ' Next structure in linked list
    End Type
    
    
    Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Long)
    
    Private Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequired As Integer, ByRef lpWSAData As WSADATA) As Long
    Private Declare Function gethostbyname Lib "ws2_32.dll" (ByVal name As String) As Long
    Private Declare Function socket Lib "ws2_32.dll" (ByVal af As Long, ByVal lType As Long, ByVal protocol As Long) As Long
    'Private Declare Function recv Lib "ws2_32.dll" (ByVal s As Long, ByVal buf As String, ByVal lLen As Long, ByVal flags As Long) As Long
    Private Declare Function recv Lib "ws2_32.dll" (ByVal s As Long, ByVal buf As Long, ByVal lLen As Long, ByVal flags As Long) As Long
    Private Declare Function connect Lib "ws2_32.dll" (ByVal s As Long, ByVal pSockAdr As Long, ByVal namelen As Long) As Long
    Private Declare Function htons Lib "ws2_32.dll" (ByVal hostshort As Integer) As Integer
    Private Declare Function send Lib "ws2_32.dll" (ByVal s As Long, ByVal buf As String, ByVal lLen As Long, ByVal flags As Long) As Long
    Private Declare Function closesocket Lib "ws2_32.dll" (ByVal s As Long) As Long
    Private Declare Function getaddrinfo Lib "ws2_32.dll" (ByVal host As String, ByVal ServiceName As Long, ByRef Hints As ADDRINFO, ByRef adr As Long) As Long
    Private Declare Sub freeaddrinfo Lib "ws2_32.dll" (ByVal pAdr As Long)
    
    Private Declare Function CreateFileW Lib "kernel32" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Private Declare Function WriteFile Lib "kernel32.dll" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToWrite As Long, ByRef lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
    
    Dim wsa As WSADATA
    
    Public Sub DownloadStart(ByVal URL As String, Optional ByVal Mode As AsyncReadConstants = vbAsyncReadResynchronize)
    'vbAsyncReadForceUpdate
    End Sub
    
    Function DownloadUrl(sUrl, sFile)
    Dim domain As String
    Dim p As Long, p2 As Long
    Dim pHost As Long
    Dim sock As Long
    Dim server_addr As SOCKADDR
    Dim send_data As String
    Dim hFile As Long
    Dim bytes_received As Long
    Dim buffer() As Byte
    Dim host As String
    Dim Hints As ADDRINFO, targetAdressInfo As ADDRINFO, pAdrInfo As Long
    Dim ret As Long
    
    If wsa.wVersion = 0 Then If WSAStartup(514, wsa) Then DownloadUrl = "Error WSAStartUp": Exit Function
    p = InStr(sUrl, "//")
    p2 = InStr(p + 2, sUrl, "/")
    domain = Mid(sUrl, p + 2, p2 - p - 2)
    host = Left(sUrl, p2 - 1)
    
    Hints.ai_family = AF_INET
    Hints.ai_protocol = IPPROTO_TCP
    Hints.ai_socktype = SOCK_STREAM
    ret = getaddrinfo(domain, 0, Hints, pAdrInfo)
    If ret <> 0 Or pAdrInfo = 0 Then DownloadUrl = "getaddrinfo": Exit Function
    
    server_addr.sin_family = AF_INET
    server_addr.sin_port = htons(80)
    GetMem4 pAdrInfo + 24, p
    GetMem4 p + 4, server_addr.sin_addr
    freeaddrinfo pAdrInfo
    
    sock = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
    If sock = -1 Then DownloadUrl = "Error socket": Exit Function
    
    If connect(sock, VarPtr(server_addr), Len(server_addr)) = -1 Then DownloadUrl = "Error connect": closesocket sock: Exit Function
    send_data = "GET " & sUrl & " HTTP/1.1" & vbCrLf & "Host: " & host & vbCrLf & "Connection: close" & vbCrLf & vbCrLf
    If send(sock, send_data, Len(send_data), 0) = -1 Then DownloadUrl = "Error send": closesocket sock: Exit Function
    hFile = CreateFileW(StrPtr(sFile), GENERIC_WRITE, FILE_SHARE_READ, 0, CREATE_ALWAYS, 0, 0)
    If hFile = -1 Then DownloadUrl = "Error CreateFile": closesocket sock: Exit Function
    Do
        ReDim buffer(0 To 1000)
        bytes_received = recv(sock, VarPtr(buffer(0)), UBound(buffer) + 1, 0)
        If bytes_received = 0 Then Exit Do
        If bytes_received < 0 Then DownloadUrl = "receive": Exit Do
        WriteFile hFile, VarPtr(buffer(0)), bytes_received, bytes_received, 0
    Loop
    
    jClean:
    CloseHandle hFile
    closesocket sock
    End Function
    
    Private Sub Command1_Click()
    DownloadUrl "https://www.vbforums.com/", App.path & "\Test.txt"
    
    End Sub
    Last edited by joshyfrancis; Sep 12th, 2021 at 09:59 PM.

  6. #6

    Thread Starter
    Addicted Member
    Join Date
    Jul 2021
    Posts
    193

    Re: WebSocket: recv function crash

    This is INSANE!

    I have been working for 20 hours now to fix this code and all I've missed is this one stupid word!
    What kind of hell is this?
    I am so upset right now I am literally want to quit programming altogether!

    Thank you anyway.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width