Verifying if a page exists on a website using VB

Tech-Archive recommends: Fix windows errors by optimizing your registry

From: Irishmaninusa (jdaly_at_structuctureinteractive.com.takemeoffifyouwantoemailme)
Date: 06/03/04 

Date: Thu, 3 Jun 2004 10:49:55 -0400

Hi,

I am trying to write a tool that will verify for me if pages exist on the
site or not. I have the list of pages in a text file and I using following
piece of vb code

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 InternetConnect Lib "wininet.dll" Alias
"InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As
String, ByVal nServerPort As Integer, ByVal sUsername As String, ByVal
sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal
lContext As Long) As Long
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias
"HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal sVerb As String, ByVal
sObjectName As String, ByVal sVersion As String, ByVal sReferer As String,
ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As
Long
Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias
"HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long,
ByRef sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As
Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet
As Long) As Integer
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias
"HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As String,
ByVal lHeadersLength As Long, ByVal sOptional As String, ByVal
lOptionalLength As Long) As Integer
Private Const HTTP_QUERY_STATUS_CODE = 19
Private Const INTERNET_SERVICE_HTTP = 3
Private Const scUserAgent = "http sample"
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000

Private Function CheckUrl(Url As String) As Long
 Dim sBuffer As String * 1024
 Dim lBufferLength As Long
 Dim hInternetSession As Long
 Dim hInternetConnect As Long
 Dim hHttpOpenRequest As Long

 lBufferLength = 1024

 'Remove Http if needed
 If UCase(Left$(Url, 7)) = "http://" Then
  Url = Right$(Url, Len(Url) - 7)
 End If

 'Open the Internetconnection
 hInternetSession = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PRECONFIG,
vbNullString, vbNullString, 0)

 If CBool(hInternetSession) = False Then
  CheckUrl = 0
  Exit Function
 End If

 'Connect and get the Status
 hInternetConnect = InternetConnect(hInternetSession, Url, 80, "", "",
INTERNET_SERVICE_HTTP, 0, 0)
 hHttpOpenRequest = HttpOpenRequest(hInternetConnect, "GET", "", "HTTP/1.0",
vbNullString, 0, INTERNET_FLAG_RELOAD Or INTERNET_FLAG_KEEP_CONNECTION, 0)
 HttpSendRequest hHttpOpenRequest, vbNullString, 0, vbNullString, 0
 HttpQueryInfo hHttpOpenRequest, HTTP_QUERY_STATUS_CODE, ByVal sBuffer,
lBufferLength, 0

 CheckUrl = Val(Left$(sBuffer, lBufferLength))
 DoEvents
 ' 0 No Connect / Error
 ' 200 OK
 ' 201 Created
 ' 202 Accepted
 ' 204 No Content
 ' 301 Moved Permanently
 ' 302 Moved Temporarily
 ' 304 Not Modified
 ' 400 Bad Request
 ' 401 Unauthorized
 ' 403 Forbidden
 ' 404 Not Found
 ' 500 Internal Server Error
 ' 501 Not Implemented
 ' 502 Bad Gateway
 ' 503 Service Unavailable

 'Close connections
 InternetCloseHandle (hHttpOpenRequest)
 InternetCloseHandle (hInternetSession)
 InternetCloseHandle (hInternetConnect)
End Function

If I pass in the url as being www.domain.com then it connects and returns
the code from the list above. If I add www.domain.com/folder/pagename.htm
then I get a no connect/error. And I am not exactly sure why that is the
case. If anyone has any ideas on this I would really appreciate it. Thanks.

Relevant Pages

  • Re: CryptAPI
    ... > Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias ... > As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long ... > On Error GoTo ErrSign ...
    (microsoft.public.vb.winapi)
  • Re: Microsoft Common Dialog control, version 6.0
    ... Private Declare Function lstrlen Lib "kernel32" _ ... Lib "kernel32" (ByVal lpPathName As String) As ... Private Const OFN_ALLOWMULTISELECT As Long = &H200 ... Dim strFile As String ...
    (microsoft.public.excel.programming)
  • Re: export to a text file
    ... Private Declare Function lstrlen Lib "kernel32" _ ... Lib "kernel32" (ByVal lpPathName As String) As Long ... Private Const OFN_ALLOWMULTISELECT As Long = &H200 ... Dim strFile As String ...
    (microsoft.public.excel.programming)
  • Re: newbie: reading from registry?
    ... Private Const REG_DWORD As Long = 4 ... Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) ... "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ...
    (microsoft.public.vb.crystal)
  • Re: Msgbox button labels
    ... Private Const MB_RETRYCANCEL = &H5& ... Private Declare Function GetCurrentThreadId Lib "kernel32" As Long ... ByVal lpCaption As String, ByVal wType As Long) As Long ... SetDlgItemText wParam, IDABORT, But1 ...
    (microsoft.public.excel.programming)