Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

vb and web server

Status
Not open for further replies.
hope this will help


example for "connect" taken from vbapi.com


example
---------
to Download the main page of this web site ( This example supports a very crude implementation of HyperText Transport Protocol (HTTP), sending a request to the server and receiving the document. The document downloaded, with HTTP headers removed, is output to the Debug window. To use this example, place a command button named cmdDownload on a form window.

Note the careful use of GoTo in this example. Since there are lots of things that can go wrong, and WSACleanup must be called at the end no matter what happens, the GoTo skip down to the end if an unrecoverable error occurs. If VB had better exception handling, I would use that instead of GoTo.


' This code is licensed according to the terms and conditions listed here.

' Declarations and such needed for the example:
' (Copy them to the (declarations) section of a module.)
Public Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription As String * 257
szSystemStatus As String * 129
iMaxSockets As Long
iMaxUdpDg As Long
lpVendorInfo As Long
End Type
Public Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequested As Integer, lpWSAData _
As WSADATA) As Long
Public Declare Function WSACleanup Lib "wsock32.dll" () As Long
Public Type HOSTENT
h_name As Long
h_aliases As Long
h_addrtype As Integer
h_length As Integer
h_addr_list As Long
End Type
Public Const AF_INET = 2
Public Declare Function gethostbyname Lib "wsock32.dll" (ByVal name As String) As Long
Public Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Integer) As Integer
Public Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal prototype As Long, ByVal _
protocol As Long) As Long
Public Const SOCK_STREAM = 1
Public Type SOCKADDR
sin_family As Integer
sin_port As Integer
sin_addr As Long
sin_zero As String * 8
End Type
Public Declare Function connect Lib "wsock32.dll" (ByVal s As Long, name As SOCKADDR, ByVal namelen _
As Long) As Long
Public Declare Function send Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal length As Long, _
ByVal flags As Long) As Long
Public Declare Function recv Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal length As Long, _
ByVal flags As Long) As Long
Public Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source _
As Any, ByVal Length As Long)

' A useful API macro.
Public Function MAKEWORD(ByVal bLow As Byte, ByVal bHigh As Byte) As Integer
MAKEWORD = Val("&H" & Right("00" & Hex(bHigh), 2) & Right("00" & Hex(bLow), 2))
End Function

' *** Place the following code inside the form window. ***

Private Sub cmdDownload_Click()
Dim wsockinfo As WSADATA ' info about Winsock
Dim sock As Long ' descriptor of the socket to use
Dim retval As Long ' generic return value
Dim pHostinfo As Long ' pointer to info about the server
Dim hostinfo As HOSTENT ' info about the server
Dim pIPAddress As Long ' pointer to server's IP address
Dim ipAddress As Long ' server's IP address
Dim sockinfo As SOCKADDR ' info about the socket

Dim buffer As String ' communications buffer
Dim reply As String ' reply from server
Dim bytesleft As Long ' number of bytes left to read of response body
Dim headerline As String ' line of HTTP response header

' Initialize a Winsock session.
retval = WSAStartup(MAKEWORD(2, 2), wsockinfo)
If retval <> 0 Then
Debug.Print &quot;Unable to initialize Winsock!&quot;
Exit Sub
End If

' Get the IP address of the server to connect to.
pHostinfo = gethostbyname(&quot; If pHostinfo = 0 Then
Debug.Print &quot;Unable to resolve host!&quot;
GoTo Cleanup
End If
CopyMemory hostinfo, ByVal pHostinfo, Len(hostinfo)
If hostinfo.h_addrtype <> AF_INET Then
Debug.Print &quot;Couldn't get IP address of GoTo Cleanup
End If
CopyMemory pIPAddress, ByVal hostinfo.h_addr_list, 4
CopyMemory ipAddress, ByVal pIPAddress, 4
' Create a socket to use for the TCP/IP connection.
sock = socket(AF_INET, SOCK_STREAM, 0)
If sock = &HFFFFFFFF Then
Debug.Print &quot;Unable to create socket!&quot;
GoTo Cleanup
End If

' Make a connection to the server.
With sockinfo
' Use the IP protocol family.
.sin_family = AF_INET
' Connect to port 80 (the typical HTTP port).
.sin_port = htons(80)
' IP address of the server to connect to.
.sin_addr = ipAddress
' Dummy data that isn't used.
.sin_zero = String(8, vbNullChar)
End With
Debug.Print &quot;Attempting to connect....&quot;
retval = connect(sock, sockinfo, Len(sockinfo))
If retval <> 0 Then
Debug.Print &quot;Unable to connect!&quot;
GoTo Cleanup
End If

' Send an HTTP request to GET the document /index.html.
buffer = &quot;GET /index.html HTTP/1.1&quot; & vbCrLf & _
&quot;Host: & vbCrLf & _
&quot;User-Agent: Winsock-Example-Program&quot; & vbCrLf & vbCrLf
retval = send(sock, ByVal buffer, Len(buffer), 0)
Debug.Print &quot;Sent request. Waiting for reply...&quot;

' Read from the socket until the entire HTTP response header is received.
' (i.e., until the connection times out or a double Cr-Lf pair is received)
reply = &quot;&quot;
buffer = Space(1024) ' read in 1 KB chunks
Do
retval = recv(sock, ByVal buffer, Len(buffer), 0)
reply = reply & Left(buffer, retval)
Loop Until retval = 0 Or InStr(reply, vbCrLf & vbCrLf) <> 0

' Parse the header to see how many more bytes we need to read.
Do
headerline = Left(reply, InStr(reply, vbCrLf) - 1)
If LCase(Left(headerline, 16)) = &quot;content-length: &quot; Then
bytesleft = Val(Right(headerline, Len(headerline) - 16))
End If
reply = Right(reply, Len(reply) - Len(headerline) - 2)
Loop While bytesleft = 0 Or Left(reply, 2) = vbCrLf

' Trim the rest of the header out of the reply.
reply = Right(reply, Len(reply) - InStr(reply, vbCrLf & vbCrLf) - 3)
bytesleft = bytesleft - Len(reply)

' Read the rest of the content of the response.
Do Until bytesleft = 0 Or retval = 0
retval = recv(sock, ByVal buffer, Len(buffer), 0)
reply = reply & Left(buffer, retval)
bytesleft = bytesleft - retval
Loop

' Print the document that was received.
Debug.Print &quot;Document Retrieved!&quot;
Debug.Print
Debug.Print reply

Cleanup:
' Closes the socket, ends the Winsock session.
retval = closesocket(sock)
retval = WSACleanup()
End Sub




aniket
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top