Guest
Feb 5, 2012, 9:32 pm UTCHome arrow Coding arrow Snippets arrow getWebPage
header image
getWebPage
Written by Dream Dancer   
Apr 30, 2008 at 06:53 AM

This is the core of the actual internet access function itself along with the definations used in using Windows API functions to achieve the desired results. Not everything is here, there still needs to be the coding of section which strips the results from the access of all HTML elements and returns the page as a single string so you can use [word#] to get at specific parts of the page.

The  headers:

Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Public Const INTERNET_FLAG_RELOAD = &H80000000
Public Const INTERNET_FLAG_NO_AUTO_REDIRECT = &H200000
Public Const INTERNET_DEFAULT_HTTP_PORT = 80
Public Const INTERNET_SERVICE_HTTP = 3
Public Const INTERNET_DEFAULT_HTTPS_PORT = 443
Public Const HTTP_QUERY_STATUS_CODE = 19
Public Const HTTP_QUERY_LOCATION = 33
 
Public Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" _
  (ByVal sAgent As String, ByVal lAccessType As Long, _
    ByVal sProxyName As String, ByVal sProxyBypass As String, _
      ByVal lFlags As Long) As Long
Public 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
Public Declare Function InternetCloseHandle Lib "wininet" _
  (ByVal hInet As Long) As Integer
Public 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
Public Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" _
  (ByVal hHttpRequest As Long, ByVal sHeaders As String, _
    ByVal lHeadersLength As Long, sOptional As Any, _
      ByVal lOptionalLength As Long) As Long
Public 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 Long
Public Declare Function InternetReadFile Lib "wininet.dll" _
  (ByVal hFile As Long, ByVal lpBuffer As String, _
    ByVal dwNumberOfBytesToRead As Long, lpdwNumberOfBytesRead As Long) As Long
GeSHi parsed in 0.0370681285858 seconds.

And the code:

Public Function getWebPage(AccessMode As MYURLARRAY, FollowRedirection As Boolean, _
  IncludeGet As Boolean) As String
Dim botInternetOpen As Long, botInternetConnect As Long, botOpenRequest As Long
Dim botPageValid As Boolean, DomainName As String, PortMode As Long
Dim InternetUserName As String, InternetPassWord As String, UrlString As String
Dim FetchPage As String, FetchFlags As Long, FetchMode As String
Dim FetchPost As String, lenFetchPost As Long, webUserAgent As String
Dim WebPage As String * 1024, lenWebPage As Long, idxWebPage As Long
Dim Whack() As String, WiDx As Long
Dim InternetError As Long, botPageCode As Long, webResults As String
 
  On Error GoTo InternetWhoops
  MINE.Item(fbInternetResults) = ""
  If axInternetTimer Then Err.Raise 1009
  UrlString = BotScript.Http.serverName & BotScript.Http.serverPath
  If UrlString = "" Then Err.Raise 1000
  Whack() = Split(UrlString, "/")
  If InStr(1, Whack(0), "http", vbTextCompare) <> 1 Then Err.Raise 1001
  If InStr(Whack(2), ".") = 0 Then Err.Raise 1002
  If BotScript.Http.botUserAgent = "" Then Err.Raise 1003
  webUserAgent = VersionInfo & " : " & BotScript.Http.botUserAgent
  PortMode = IIf(LCase$(Whack(0)) = "http:", _
    INTERNET_DEFAULT_HTTP_PORT, INTERNET_DEFAULT_HTTPS_PORT)
  DomainName = Whack(2)
  FetchPage = ""
  For WiDx = 3 To UBound(Whack())
    FetchPage = FetchPage & "/" & Whack(WiDx)
  Next WiDx
  InternetUserName = IIf(BotScript.Http.serverUser = "", _
    vbNullString, BotScript.Http.serverUser)
  InternetPassWord = IIf(BotScript.Http.serverPass = "", _
    vbNullString, BotScript.Http.serverPass)
 
  lenWebPage = Len(WebPage)
  botInternetOpen = InternetOpen(webUserAgent, _
    INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
  InternetError = GetLastError()
  If botInternetOpen = 0 Then Err.Raise 1011
 
  botInternetConnect = InternetConnect(botInternetOpen, DomainName, PortMode, _
    InternetUserName, InternetPassWord, INTERNET_SERVICE_HTTP, 0, 0)
  InternetError = GetLastError()
  If botInternetConnect = 0 Then Err.Raise 1012
 
  FetchPage = IIf(IncludeGet, combineUrlMembers(FetchPage, urlget), FetchPage)
  FetchFlags = INTERNET_FLAG_RELOAD Or IIf(FollowRedirection, _
    0, INTERNET_FLAG_NO_AUTO_REDIRECT)
  FetchMode = IIf(AccessMode = urlpost, "POST", "GET")
  botOpenRequest = HttpOpenRequest(botInternetConnect, FetchMode, FetchPage, _
    "HTTP/1.0", vbNullString, 0, FetchFlags, 0)
  InternetError = GetLastError()
  If botOpenRequest = 0 Then Err.Raise 1013
 
  lenWebPage = Len(WebPage)
  If AccessMode = urlpost Then
    FetchPost = combineUrlMembers("", urlpost)
    lenFetchPost = Len(FetchPost)
  Else
    FetchPost = vbNullString
    lenFetchPost = 0
  End If
  botPageValid = HttpSendRequest(botOpenRequest, vbNullString, 0, _
    FetchPost, lenFetchPost)
  InternetError = GetLastError()
  If botPageValid = False Then Err.Raise 1014
  idxWebPage = lenWebPage
  botPageValid = HttpQueryInfo(botOpenRequest, HTTP_QUERY_STATUS_CODE, _
    ByVal WebPage, idxWebPage, 0)
  InternetError = GetLastError()
  If botPageValid = False Then Err.Raise 1015
 
  botPageCode = Val(WebPage)
  Select Case botPageCode
    Case 200
      MINE.Item(fbInternetResults) = "200 - Successful Page Fetch"
      Do
        WebPage = String$(lenWebPage, Chr$(0))
        botPageValid = InternetReadFile(botOpenRequest, WebPage, _
          lenWebPage, idxWebPage)
        If (botPageValid = False) Or (idxWebPage = 0) Then Exit Do
        webResults = webResults & Left$(WebPage, idxWebPage)
        DoEvents ' to prevent program from seeming to be unresponsive
      Loop
      webResults = stripHtmlEntities(webResults)
    Case 302
      MINE.Item(fbInternetResults) = "302 - Got Redirection"
      idxWebPage = lenWebPage
      WebPage = String$(lenWebPage, Chr$(0))
      botPageValid = HttpQueryInfo(botOpenRequest, HTTP_QUERY_LOCATION, _
        ByVal WebPage, idxWebPage, 0)
      If lenWebPage > 0 Then webResults = Left$(WebPage, idxWebPage)
    Case Else
      Err.Raise 1004
  End Select
 
InternetWhoops:
  InternetCloseHandle botOpenRequest
  InternetCloseHandle botInternetConnect
  InternetCloseHandle botInternetOpen
  If Err.number > 0 Then
    If Err.number < 1000 Then
      PumpInternalMessage "I-Net Failure: " _
        & Err.number & "-" & Err.Description
    Else
      If Err.number < 1010 Then
        Select Case Err.number
          Case 1000
            MINE.Item(fbInternetResults) = _
              "000 - Internet Access Failure, no server defined"
          Case 1001
            MINE.Item(fbInternetResults) = "001 - Invalid protocol, " _
              & Whack(0) & " not supported"
          Case 1002
            MINE.Item(fbInternetResults) = "002 - Invalid domain name, " _
              & Whack(2) & " does not appear to be valid"
          Case 1003
            MINE.Item(fbInternetResults) = "007 - Invalid botname"
          Case 1004
            MINE.Item(fbInternetResults) = botPageCode _
              & " - Got unhandled code"
          Case 1009
            MINE.Item(fbInternetResults) = "444 - Access timeout failure"
          Case Else
            MINE.Item(fbInternetResults) = "990 - unknown error code"
        End Select
        PumpInternalMessage "I-Net Failure: " _
          & Err.number & "-" & MINE.Item(fbInternetResults)
      Else
        WebPage = String$(0, lenWebPage)
        FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, InternetError, _
          LANG_NEUTRAL, WebPage, 200, ByVal 0&
        PumpInternalMessage "I-Net Failure: " _
          & Err.number & "-" & Left$(WebPage, InStr(WebPage, Chr$(0)) - 1)
        MINE.Item(fbInternetResults) = _
          "999 - Read connection log for error message"
      End If
    End If
    getWebPage = ""
  Else
    getWebPage = webResults
    axInternetTimer = True
    addAutomation axInternetInhibit, axInternetTimeOut
  End If
End Function
GeSHi parsed in 0.106692075729 seconds.
 

Last Updated ( Jun 15, 2008 at 11:37 AM )
<Previous   Next>
header image