|
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 LongGeSHi 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 FunctionGeSHi parsed in 0.106692075729 seconds. |