Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/vbrowser/vbrowser.bas

BASIC Source File | 1995-10-24 | 28.1 KB | 823 lines

Declare Function getmodulehandle% Lib "Kernel" (ByVal lpModuleName$)
Declare Function lstrcpy& Lib "Kernel" (ByVal dststring As Any, ByVal srcstring As Any)
Declare Sub hmemcpy Lib "Kernel" (dst As Any, src As Any, ByVal bytecount As Long)



Global debugging
Global cr$, lf$, crlf$, crlfcrlf$, lflf$
Global quit_flag
Global main_hwnd%           'Handle of main window to where
                            'WSAAsync NAME messages are sent. Msgblast
                            'will intercept them.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Global name_msg%            'Message number of any get name request
Global got_name_response    'Flag that indicates WSAsync Name call
                            'got a message(response).
Global event_error%         'Hiword is returned error code, if any.
Global event_type%          'Loword is event type.
Global event_wparam%        'Returned handle of caller
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Global event_msg%           'Message number for a ASYNC event.
Global server_addr&
Global server_domain$
Global server_dotaddr$
Global document$            'Document to get from server
Global current_msg$         'Current received message
Global current_header$      'Current header after split routine
Global callsocket%          'Current socket(handle) assigned
                            'to the server

Global closed
Global urls$(), numurls, urlnum

'''''''''''''''''''''''''''''''''''''''''''''''''''''
'Winsock declarations needed for VBrowser

Type sockaddr_in_type
  sin_family As Integer
  sin_port As Integer
  sin_addr As Long
  sin_zero As String * 8
End Type
Global call_sockaddr_in As sockaddr_in_type

Type WSAdata_type
   wVersion As Integer
   wHighVersion As Integer
   szDescription As String * 257
   szSystemStatus As String * 129
   iMaxSockets As Integer
   iMaxUdpDg As Integer
   lpVendorInfo As String * 200
End Type
Global WSAdata As WSAdata_type

Type namehostent_type               'Where Winsock, after
    h_name As Long                  'WSAAsyncGetHostByAddr/Name
    h_aliases As Long               'places the hostent data.
    h_addrtype As Integer           'Winsock also palces the data
    h_length As Integer             'pointed to by these pointers
    h_addr_list As Long             'at the end of the hostent data.
    buff As String * 100            'The data 'pointed' to by the
                                    'above pointers.
End Type
Global namehostent As namehostent_type

Type sockopt_bool_type               'Used for setting socket options
  val As Integer
End Type
Global sockopt_bool As sockopt_bool_type

'Winsock calls in VB format
Declare Function bind Lib "winsock.dll" (ByVal s As Integer, addr As sockaddr_in_type, ByVal namelen As Integer) As Integer
Declare Function inet_addr Lib "winsock.dll" (ByVal s As String) As Long
Declare Function gethostbyname Lib "winsock.dll" (ByVal hostname As String) As Long
Declare Function gethostbyaddr Lib "winsock.dll" (hostaddress As Long, ByVal lenaddress As Integer, ByVal pftype As Integer) As Long
Declare Function inet_ntoa Lib "winsock.dll" (ByVal iaddr As Long) As Long
Declare Function socket Lib "winsock.dll" (ByVal af As Integer, ByVal typesock As Integer, ByVal protocol As Integer) As Integer
Declare Function connect Lib "winsock.dll" (ByVal sock As Integer, sockstruct As sockaddr_in_type, ByVal structlen As Integer) As Integer
Declare Function send Lib "winsock.dll" (ByVal sock As Integer, ByVal msg As String, ByVal msglen As Integer, ByVal flag As Integer) As Integer
Declare Function recv Lib "winsock.dll" (ByVal sock As Integer, ByVal msg As String, ByVal msglen As Integer, ByVal flag As Integer) As Integer
Declare Function closesocket Lib "winsock.dll" (ByVal sock As Integer) As Integer
Declare Function setsockopt Lib "winsock.dll" (ByVal sock As Integer, ByVal level As Integer, ByVal optname As Integer, optval As sockopt_bool_type, ByVal optlen As Integer) As Integer
Declare Function htons Lib "winsock.dll" (ByVal a As Integer) As Integer

'These are the Win specific calls which use messages
Declare Function WSAStartup Lib "winsock.dll" (ByVal a As Integer, b As WSAdata_type) As Integer
Declare Function WSACleanup Lib "winsock.dll" () As Integer
Declare Function WSAAsyncSelect Lib "winsock.dll" (ByVal sock As Integer, ByVal hWnd As Integer, ByVal msg As Integer, ByVal event As Long) As Integer
Declare Function WSAGetLastError Lib "winsock.dll" () As Integer
Declare Function WSAAsyncGetHostByAddr Lib "winsock.dll" (ByVal hWnd As Integer, ByVal msg As Integer, hostaddr As Long, ByVal lenhostaddr As Integer, ByVal pftype As Integer, namehostent As namehostent_type, ByVal lenstruc As Integer) As Integer
Declare Function WSAAsyncGetHostByName Lib "winsock.dll" (ByVal hWnd As Integer, ByVal msg As Integer, ByVal hostname As String, namehostent As namehostent_type, ByVal lenanmehostent As Integer) As Integer

'Some constants declarations
Global Const SOCKET_ERROR = -1
Global Const INVALID_SOCKET = -1

Global Const SOCK_STREAM = 1
Global Const AF_INET = 2
Global Const PF_INET = 2

Global Const IPPROTO_TCP = 6
Global Const SOL_SOCKET = &HFFFF
Global Const SO_DEBUG = &H1
Global Const SO_ACCEPTCONN = &H2
Global Const SO_REUSEADDR = &H4
Global Const SO_KEEPALIVE = &H8
Global Const SO_DONTROUTE = &H10
Global Const SO_BROADCAST = &H20
Global Const SO_USELOOPBACK = &H40
Global Const SO_LINGER = &H80
Global Const SO_OOBINLINE = &H100
Global Const SO_DONTLINGER = &HFF7F

Global Const AF_UNSPEC = 0

Global Const FD_READ = 1
Global Const FD_WRITE = 2
Global Const FD_OOB = 4
Global Const FD_ACCEPT = 8
Global Const FD_CONNECT = &H10
Global Const FD_CLOSE = &H20

Function ask_server (req_msg$)
DoEvents
mlen = Len(req_msg$)
'Clear the inbound message buffer
current_msg$ = ""
dprint "Send request"
send_next_segment:
status% = send(callsocket%, req_msg$, mlen, 0)
If status% = SOCKET_ERROR Then
    status% = WSAGetLastError()
    dprint "Send ERROR " & sockerror$(status%)
    GoTo exit_ask_server
ElseIf status% = mlen Then
    dprint "Send was OK...waiting for response."
Else
    dprint "Partial send of " & mlen & " bytes"
    req_msg$ = Mid$(req_msg$, status% + 1)
    mlen = Len(req_msg$)
    GoTo send_next_segment
End If
'Now wait for the response from the server.
'Keep trying to receive until the server disconnects.
'At that time the receive will fail
Do
    DoEvents
    'We should also place a timeout routine...just in
    'case. I'll let you write that.
    If quit_flag Then
        Exit Do
    End If
    If closed Then
        'Msgblast routine dprints the close message and
        'sets the global flag 'closed'
        dprint "Closed received"
        Exit Do
    End If
Loop
status% = close_sock(callsocket%)
callsocket% = 0
'Current_msg$ is global and is where the receive event
'code in Msgblast placed the received data.
ok = True
exit_ask_server:
ask_server = ok
End Function

Sub call_server (n$)
browserfrm.Text1.Text = ""
If get_server_address(n$) Then
    If get_callsock() Then
        If connect_server() Then
            'ask for document
            If Len(document$) = 0 Then
                'The operator did't ask for a specific
                'document, so use the HTTP standard request
                'for the server root directory. It will return
                'its 'index.htm'.
                document$ = "/"
            End If
            browserfrm.url.Caption = "http://" + server_domain$ + document$
            msg$ = "GET " + document$ + " HTTP/1.0" + crlf$
            msg$ = msg$ + "Accept: */*" + crlf$
            msg$ = msg$ + "Accept: text/html" + crlf$
            msg$ = msg$ + crlf$
            browserfrm.Text1.Text = "Our request:" + crlfcrlf$ + msg$
            If ask_server(msg$) Then
                'Places received message in current_msg$
                parse_current_msg
            End If
        End If
    End If
Else
    'Invalid name or can't get DNS resolution of
    'User entered server dot address or domain name.
    'Called function gave a error so do nothing.
End If
End Sub

Function close_sock (socket%)
status% = closesocket(socket%)
If status% = SOCKET_ERROR Then
    status% = WSAGetLastError()
    dprint "Close socket ERROR " & sockerror$(status%) & " on socket " & socket%
    GoTo exit_close_callsock
Else
    dprint "Closed socket " & socket% & " OK"
End If
ok = True
exit_close_callsock:
close_callsock = ok
End Function

Function connect_server ()
'Set up structure (type) we will pass in connect call.
'Notice that we have to pass the Internet address of the
'server we want to connect to in sin_addr. Also the port
'for Web servers is 80 but we have to call Winsock to convert
'it into the correct byte order.
call_sockaddr_in.sin_family = AF_INET
call_sockaddr_in.sin_port = htons(80)     'converts byte order from PC to Network
call_sockaddr_in.sin_addr = server_addr&
call_sockaddr_in.sin_zero = " "

'We sometimes get a refused message so we'll just loop
'until success or timeout.
connect_server_again:
DoEvents
dprint "Connect socket " & callsocket%
status% = connect(callsocket%, call_sockaddr_in, Len(call_sockaddr_in))
If status% = SOCKET_ERROR Then
    status% = WSAGetLastError()
    dprint "Connect server error " & sockerror$(status%)
    If status% = 10060 Then
        'Winsock timed out.
        'This usually means that the server is not answering
        dprint "Connect server timed out...the server is not answering."
        'Can't go any further
        status% = close_sock(callsocket%)
        Exit Function
    ElseIf status% = ISCONN Then    'We connected last try
        'OK. We did connect last shot but the status didn't
        'update or something. This does happen sometimes...I don't know
        'why? Maybe it's an 'undocumented' Winsock feature.
    Else
        'Some other kind of error. Try 10 times.
        retrys = retrys + 1
        If retrys < 10 Then
            GoTo connect_server_again
        End If
    End If
Else
    dprint "Connected to server OK."
End If

'Setup to get a message when server disconnects
'This tells Winsock to send a message to Msgblast whenever
'this socket gets a read(data) or a close.
dprint "Select (arm) READ & CLOSE messages."
net_event& = FD_CLOSE + FD_READ
status% = WSAAsyncSelect(callsocket%, main_hwnd%, event_msg%, net_event&)
If status% = SOCKET_ERROR Then
    status% = WSAGetLastError()
    dprint "WSAAsyncSelect error " & sockerror$(status%)
    GoTo exit_connect_server
Else
    dprint "WSAASyncSelect OK"
End If
ok = True
exit_connect_server:
connect_server = ok
End Function

Sub dprint (msg$)
browserfrm.Sockstatus.Caption = msg$
If debugging Then
    Debug.Print msg$ + crlf$
End If
End Sub

Function get_callsock ()
closed = False
dprint "Open socket"
'Get a socket/handle from Winsock
callsocket% = socket(PF_INET, SOCK_STREAM, AF_UNSPEC)
If callsocket% = INVALID_SOCKET Then
    dprint "Socket error " & sockerror$(WSAGetLastError())
    GoTo exit_get_callsock
Else
    dprint "Got socket handle " & callsocket%
End If

'Some Winsocks want you to do this if you are using
'multiple sockets. If you don't, even though you
'closed a socket Winsock won't ever use that handle
'again, which means you'll run out of handles after a while.
dprint "Set Reuse option for socket " & callsocket%
sockopt_bool.val = -1
DoEvents
status% = setsockopt(callsocket%, SOL_SOCKET, SO_REUSEADDR, sockopt_bool, 2)
If status% = SOCKET_ERROR Then
    status% = WSAGetLastError()
    dprint "Setsockopt error " & sockerror$(status%)
    GoTo exit_get_callsock
Else
    dprint "Reuse issued OK"
End If
DoEvents

'Now bind the socket
dprint "Bind socket " & cllsocket%
'We pass this structure during a bind.
call_sockaddr_in.sin_family = AF_INET
call_sockaddr_in.sin_port = htons(80)
call_sockaddr_in.sin_addr = 0
call_sockaddr_in.sin_zero = " "

status% = bind(callsocket%, call_sockaddr_in, Len(call_sockaddr_in))
If status% = SOCKET_ERROR Then
    status% = WSAGetLastError()
    dprint "Bind error " & sockerror$(status%)
    GoTo exit_get_callsock
Else
    dprint "Bind OK"
End If

'If we got here then all is OK
ok = True
exit_get_callsock:
get_callsock = ok

End Function

Function get_server_address (n$)
'There are 3 pieces of information needed for server ops:
'1. The server domain name.
'2. The server Internet address in Long format.
'3. The server dot address in String format. This is
'really the Internet address formatted into human readable
'form.
'Given any one of the three we can get the others.
'server_domain$, server_addr&, and server_dotaddr$ are all Global
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Either a dot address or a name was passed as n$
'A document URL may have been appended to n$.
'(http://wwwdev.com or http://165.247.64.3)
'(http://wwwdev.com/docs/adoc.htm or
'http://165.247.64.3/docs/adoc.htm)
'At this time, we only do www servers 'http://'
'After all, Web servers support file transfers, so let
'the UNIX weenies mess with FTP.

ok = True
pos% = 1
pos% = InStr(n$, "http://")
If pos% Then
    'check for possible dot address
    pos% = InStr(n$, "//") + 2
    For i = 1 To 4
        t$ = parsestring$(pos%, n$, ".")
        If IsNumeric(t$) Then
            'so far so good
            server_dotaddr$ = server_dotaddr$ + t$ + "."
        Else
            ok = False
            Exit For
        End If
    Next
    If Not ok Then
        'wasn't a dot address
        ok = True
        pos% = 8    'start past 'http://' again
        server_domain$ = parsestring$(pos%, n$, "/")
        If Len(server_domain$) Then
            'got something
            got_domain = True
        Else
            ok = False
        End If
    Else
        'was a dot address
        server_dotaddr$ = Left$(server_dotaddr$, Len(server_dotaddr$) - 1)
    End If
    If pos% Then
        'Got something PAST the URL. (a directory entry (document))
        'save it
        document$ = Mid$(n$, pos%)
    End If
Else
    'Invalid name field, no 'http://'
    ok = False
End If
If ok Then
    'Here we either have a validated dot address (human
    'readable Internet address) or a Domain name.
    If got_domain Then
        'SEE Winsock.txt
        'Now have to get server Internet address by name.
        'ie. ask for a DNS lookup against a Domain name.
        'The call returns the address of a winsock hostent
        'structure which is an area of the Winsock's memory
        'that is mapped (laid out) in the hostent structure
        'format.
        'Use the Async or non-blocking call. In English this
        'means call Winsock, who will initiate the call and
        'will return immediately. This allows us to control
        'how long we wait for a response and to check our network
        'connected status. Otherwise, if we use the 'blocking'
        'call we have to wait until Winsock times out. The
        'response from Winsock is a message which we trap
        'with msgblast.
        dprint "WSAAsyncGetHostByName for " & server_domain$
        namehandle% = WSAAsyncGetHostByName(main_hwnd%, name_msg%, server_domain$, namehostent, Len(namehostent))

        ''''''''''''''''''''''''''''''''''''
        'FYI, this is the blocking call, that is, Winsock "hangs" until
        'a DNS response is received or Winsock times out.
        'ha& = gethostbyname(n$)
        ''''''''''''''''''''''''''''''''''''
        If namehandle% Then
            'Call was successful. Wait for a response.
            got_name_response = False
            Do
                DoEvents
                'Don't wait forever
                'Here check for a timeout against how long
                'you want to wait. Set OK to false if
                'you time out.
                If got_name_response Then
                    Exit Do
                Else
                    'check for timeout
                    'If timeout then
                    '   ok=false
                    '   exit do
                    'end if
                End If
                If quit_flag Then
                    Exit Function
                End If
            Loop
            If ok Then
                'Didn't time out but check for any errors.
                'Global 'name_errcode%' is set by the msgblast
                'message routine.
                If event_error% Then
                    dprint "Get Host by Name failed with error code " & sockerror$(event_error%)
                    ok = False
                Else
                    'We have the domain name.
                    'We need the Internet address and the dot address.

                    'We now have the hostent structure plus data pointed
                    'to in our namehostent structure.
                    'One of the variables is a memory address (pointer)
                    'pointing to a memory address (pointer) pointing to
                    'a list of Internet addresses.
                    listaa& = namehostent.h_addr_list
                    If listaa& = 0 Then
                        'Insurance...some Winsocks say it's OK
                        'but return null buffer pointers which
                        'cause GPF's in hmemcpy
                        dprint "Bad name response"
                        ok = False
                        Exit Function
                    End If
                    'listaa& now points to the address of the address
                    'of the list.
                    hmemcpy lista&, ByVal listaa&, 4
                    'lista& now points to the list itself.
                    'get first list entry which is the
                    'server Internet address.
                    hmemcpy server_addr&, ByVal lista&, 4
                    'This call converts an Internet address into
                    'a dot address and returns the address of the
                    'resultant string. You have to pass it the memory
                    'address of the Internet address.
                    dota& = inet_ntoa&(server_addr&)
                    'lpstrcpy needs a blank VB target string
                    server_dotaddr$ = Space$(256)
                    temp& = lstrcpy&(server_dotaddr$, dota&)
                    'Get rid of nulls copied from Winsock
                    server_dotaddr$ = replacechar2(server_dotaddr$, Chr$(0), " ")
                    'And trim it
                    server_dotaddr$ = Trim$(server_dotaddr$)
                    dprint server_domain & " is " & server_dotaddr$
                    'Whew!
                End If
            Else
                dprint "Get Host by Name timed out"
                ok = False
            End If

        Else
            'Something wrong. Find out what.
            errcode% = WSAGetLastError()
            MsgBox "Get Host by Name failed with error " & sockerror$(errcode%)
            ok = False
        End If
    Else
        'convert dot address to Internet address, then
        'get server name by address. i.e. ask for DNS
        'lookup against an Internet address.
        'Convert dot address (human) to a long& (computer)
        server_addr& = inet_addr(server_dotaddr$)
        'Now call a DNS server on the network to get the assigned
        'Domain name.
        dprint "WSAAsyncGetHostByAddress for " & server_dotaddr$
        got_name_response = False
        namehandle% = WSAAsyncGetHostByAddr(main_hwnd%, name_msg%, server_addr&, 4, PF_INET, namehostent, Len(namehostent))
        If namehandle% Then
            'Call was a 'non-blocking call'. In English this
            'means that Winsock is now doing a DNS network access.
            'We'll have to wait until he's done, but this
            'way we have control over how long we wait, and
            'can immediately get network status instead of
            'hanging in the blocking version waiting for Winsock to
            'time out only to find out that we are not connected to
            'the network.
            'Call was successful. Wait for a response.
            Do
                DoEvents
                'Don't wait forever
                'Here check for a timeout against how long
                'you want to wait. Set OK to false if
                'you time out.
                If got_name_response Then
                    Exit Do
                Else
                    'check for timeout
                    'If timeout then
                    '   ok=false
                    '   exit do
                    'end if
                End If
            Loop
            If ok Then
                'Didn't time out but check for any errors.
                'Global 'name_errcode%' is set by the msgblast
                'message routine.
                If event_error% Then
                    dprint "Get Host by Address failed with error " & sockerror$(event_error%)
                    ok = False
                Else
                    'We have the dot address.
                    'We've converted it to a long (the internet address).
                    'We need the domain name.

                    'We now have the hostent structure plus data pointed
                    'to in our namehostent structure.
                    'get address of name
                    namea& = namehostent.h_name
                    'copy name
                    server_domain$ = Space$(256)
                    temp& = lstrcpy&(server_domain$, namea&)
                    'strip nulls
                    server_domain$ = Trim$(replacechar2$(server_domain$, Chr$(0), " "))
                    dprint server_dotaddr$ & " is " & server_domain$
                End If
            Else
                dprint "Get Host by Address timed out"
                ok = False
            End If

        Else
            errcode% = WSAGetLastError()
            dprint "Get Host by Addressfailed with error " & sockerror$(errcode%)
            ok = False
        End If
    End If
End If
exit_get_server_address:
get_server_address = ok

End Function

Sub init_all ()

main_hwnd% = browserfrm.hWnd
event_msg% = &H2000         '&h2000=8192
name_msg% = event_msg% + 1  '8193   (see msgblast routine)

cr$ = Chr$(13): lf$ = Chr$(10)
crlf$ = cr$ + lf$
crlfcrlf$ = crlf$ + crlf$
lflf$ = lf$ + lf$
ReDim urls$(1 To 1)

End Sub

Sub main ()
debugging = True
browserfrm.Show
init_all

If start_winsock() Then
    Do While Not quit_flag
        DoEvents
    Loop
    status% = close_sock(callsocket%)
    status% = WSACleanup()
    dprint "WSACleanup status " & sockerror$(status%)
    'Allow viewing of debug.print stuff before actual quit.
    'Use ctl-break to break out of msgbox and into VB with
    'program still active
    If debugging Then
        MsgBox "Debug is on, click OK to exit, ctl_break to see debug screen."
    End If
End If
End
End Sub

Sub parse_current_msg ()
'It is almost impossible to use Vanilla VB to parse and
'display an HTML document as you have to mix fonts, font sizes, text colors,
'and images(jpeg and gifs).


'Change single lf's to crlf's if the msg is in Unix/Mac
'format, which uses single line feeds as end of line
'indicators. The PC world uses carriage return-line feed pairs.
current_msg$ = browserfrm.Text1.Text + crlfcrlf$ + "Received from server:" + crlfcrlf$ + current_msg$
browserfrm.Text1.Text = set_lf_to_crlf$(current_msg$)
End Sub

Function parsestring$ (start, wrk$, target$)
'Replaces Crescent Software's FUN parsestring$(). If you
'are serious about VB programming, then you must get their
'toolkit.
'This call is invaluable as it allows you to step thru delimited
'string retrieving the data BETWEEN the delimiters.

If start = 0 Then
    start = 1
End If
delim = InStr(start, wrk$, target$)
If delim Then
    t$ = Mid$(wrk$, start, delim - start)
    If delim > Len(wrk$) Then
        start = 0
    Else
        start = delim + 1
    End If
Else
    t$ = Mid$(wrk$, start)
    start = 0
End If
parsestring$ = t$
End Function

Function replacechar2$ (l$, oldchar$, newchar$)
'This function replaces Crescent Software's FUN.
For i = 1 To Len(l$)
    If Mid$(l$, i, 1) = oldchar$ Then
        Mid$(l$, i, 1) = newchar$
    End If
Next
replacechar2$ = l$
End Function

Function set_lf_to_crlf$ (m$)
'Change Unix/Mac line feeds to carriage return - linefeeds
delim = 1
Do
    DoEvents
    delim = InStr(delim, m$, lf$)
    If delim Then
        If Mid$(m$, delim - 1, 1) = cr$ Then
            'check the entire message
            delim = delim + 1
        Else
            'insert a cr ahead of the lf
            m$ = Left$(m$, delim - 1) + cr$ + Mid$(m$, delim)
            delim = delim + 2
        End If
    Else
        'done scanning
        Exit Do
    End If
Loop


set_lf_to_crlf$ = m$
End Function

Function sockerror$ (n)
'Return error message for n
'n is return status from a call
e$ = "WSAE"
Select Case n
    Case 0
        e$ = "OK"
    Case 10004
        e$ = e$ + "INTR"
    Case 10009
        e$ = e$ + "BADF"
    Case 10013
        e$ = e$ + "ACCES"
    Case 10014
        e$ = e$ + "FAULT"
    Case 10022
        e$ = e$ + "INVAL"
    Case 10024
        e$ = e$ + "MFILE"
    Case 10035
        e$ = e$ + "WOULDBLOCK"
    Case 10036
        e$ = e$ + "INPROGRESS"
    Case 10037
        e$ = e$ + "ALREADY"
    Case 10038
        e$ = e$ + "NOTSOCK"
    Case 10039
        e$ = e$ + "DESTADDRREQ"
    Case 10040
        e$ = e$ + "MSGSIZE"
    Case 10041
        e$ = e$ + "PROTOTYPE"
    Case 10042
        e$ = e$ + "NOPROTOOPT"
    Case 10043
        e$ = e$ + "PROTONOSUPPORT"
    Case 10044
        e$ = e$ + "SOCKTNOSUPPORT"
    Case 10045
        e$ = e$ + "OPNOTSUPP"
    Case 10046
        e$ = e$ + "PFNOSUPPORT"
    Case 10047
        e$ = e$ + "AFNOSUPPORT"
    Case 10048
        e$ = e$ + "ADDRINUSE"
    Case 10049
        e$ = e$ + "ADDRNOTAVAIL"
    Case 10050
        e$ = e$ + "NETDOWN"
    Case 10051
        e$ = e$ + "NETUNREACH"
    Case 10052
        e$ = e$ + "NETRESET"
    Case 10053
        e$ = e$ + "CONNABORTED"
    Case 10054
        e$ = e$ + "CONNRESET"
    Case 10055
        e$ = e$ + "NOBUFS"
    Case 10056
        e$ = e$ + "ISCONN"
    Case 10057
        e$ = e$ + "NOTCONN"
    Case 10058
        e$ = e$ + "SHUTDOWN"
    Case 10059
        e$ = e$ + "TOOMANYREFS"
    Case 10060
        e$ = e$ + "TIMEDOUT"
    Case 10061
        e$ = e$ + "CONNREFUSED"
    Case 10062
        e$ = e$ + "LOOP"
    Case 10063
        e$ = e$ + "NAMETOOLONG"
    Case 10064
        e$ = e$ + "HOSTDOWN"
    Case 10065
        e$ = e$ + "HOSTUNREACH"
    Case 10066
        e$ = e$ + "NOTEMPTY"
    Case 10067
        e$ = e$ + "PROCLIM"
    Case 10068
        e$ = e$ + "USERS"
    Case 10069
        e$ = e$ + "DQUOT"
    Case 10070
        e$ = e$ + "STALE"
    Case 10071
        e$ = e$ + "REMOTE"
    Case 10091
        e$ = "WSASYSNOTREADY"
    Case 10092
        e$ = "WSAVERNOTSUPPORTED"
    Case 10093
        e$ = "WSANOTINITIALIZED"
    Case 11001
        e$ = e$ + "WSA_HOST_NOT_FOUND"
    Case 11002
        e$ = "WSATRY_AGAIN"
    Case 11003
        e$ = "WSANO_RECOVERY"
    Case 11004
        e$ = "WSANO_DATA"
    Case Else
        e$ = "UNKNOWN ERROR CODE" + Str$(n)
End Select
sockerror$ = e$
End Function

Function start_winsock ()
dprint "WSAStartup"
reqver% = &H101
status% = WSAStartup(reqver%, WSAdata)
If status% Then
    dprint "Startup Winsock error " & sockerror$(status%)
Else
    dprint "Startup status " & sockerror$(status%)
    dprint "Version " & WSAdata.wVersion
    dprint "High version " & WSAdata.wHighVersion
    dprint "Description " & WSAdata.szDescription
    dprint "System status " & WSAdata.szSystemStatus
    dprint "Max sockets " & WSAdata.iMaxSockets
    dprint "Max datagrams " & WSAdata.iMaxUdpDg
    'Each vendor can have a structure which is their
    'own design. I haven't found the specific descriptions
    'for Trumpet or Microsoft.
    dprint "Pointer to vendor info " & WSAdata.lpVendorInfo
    start_winsock = True
End If
End Function