Edik Level: Trainee
 Registered: 12-10-2006 Posts: 1
|
WININET timeout problem
I am trying to build an application that would connect to an Access database (DAO 3.60), containing URLs, fetch the links one by one and then write the status back to the database. First I used Inet control for that purpose, but it turned out to be too buggy, that's why have decided to wininet.dll istead (found some examples on the web and customized them). But the problem is that if a link is timed out the application hangs up, because I cannot set the time out for wininet.
Can anyone help me out?
So the form has:
1. Textbox named "txturl" - URL from the database are read into it
2. Richeditbox named "txtbuf" - HTML is read into it to find out the status of the website (Server not fount, page not found, etc.)
3. Commandbutton to start the procedure
********************
Private Const scUserAgent = "MyApplication"
Private Const INTERNET_USER_AGENT = "My own WinInet"
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const PRE_CONFIG_INTERNET_ACCESS = 0
Private Const INTERNET_INVALID_PORT_NUMBER = 0
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hOpen As Long, ByVal sUrl As String, ByVal sHeaders As String, ByVal lLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Sub Command1_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = OpenDatabase("Links.mdb")
Set rs = db.OpenRecordset("Select * from internet")
Do While Not rs.EOF
txturl = rs!URL
Dim hNet As Long
Dim hUrlFile As Long
Dim buffer As String
Dim BytesRead As Long
Dim bRead As Integer
hNet = InternetOpen("My Test", PRE_CONFIG_INTERNET_ACCESS, vbNullString, INTERNET_INVALID_PORT_NUMBER, 0)
hUrlFile = InternetOpenUrl(hNet, txturl, vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
buffer = String(102400, 0)
bRead = InternetReadFile(hUrlFile, buffer, Len(buffer), BytesRead)
buffer = Left(buffer, BytesRead)
txtbuf = buffer
Call InternetCloseHandle(hUrlFile)
Call InternetCloseHandle(hNet)
Dim st As String
txtbuf.Text = Left(txtbuf.Text, 200)
If txtbuf.Text = "" Then
st = "Server Not Found"
ElseIf InStr(1, txtbuf, "404") Or InStr(1, txtbuf, "found") Then
st = "File Not Found"
ElseIf InStr(1, txtbuf, "ERROR") Then
st = "Error"
Else
st = "OK"
End If
rs.Edit
rs!Status = st
rs.Update
rs.MoveNext
Loop
rs.Close
End Sub
********************
Thanks in advance.
Best regards,
Ed
|