6 ways to get HTML
'
' ---------------------------------------------------
'
' 6 METHODS IN VB6 TO GET TEXT FROM A REMOTE WEB PAGE
'
' ===================================================
'
' REQUIREMENTS - VISUAL BASIC 6.0 SOFTWARE
' EXPERIENCE - BEGINNER TO INTERMEDIATE VB6
'
' ---------------------------------------------------
'
' 1) sText = SendAPIRequest("http://knowlesrealty.com") - API: NO CONTROL OR REFERENCE REQUIRED
' 2) sText = SendXMLRequest("http://knowlesrealty.com") - MSXML: REFERENCE MS XML, Version 2.0
' 3) sText = Inet1.OpenURL("http://www.knowlesrealty.com") - INET: INET CONTROL REQUIRED - ** NO FUNCTION
' 4) sText = getHTMLDocument("http://knowlesrealty.com") - HTMLDOC: REFERENCE MS HTML Object Library
' 5) WebBrowser1.Navigate "http://knowlesrealty.com/" - WEBBROWSER: WEB BROWSER CONTROL REQUIRED
' 6) Winsock - ADVANCED - Not Included in this example - WINSOCK: NEEDS WINSOCK CONTROL/SOCKETS API
' NOTES:
'
' The simplest to implement is the Inet Control.
' The Least Stable IMO would be the API (No Control or Reference)
' The Best yet most advanced is the Winsock.
'***************************************************************************
'***************************************************************************
'** **
'** API - GET TEXT FROM WEB PAGE - NO CONTROL OR REFERENCE REQUIRED **
'** **
'***************************************************************************
'***************************************************************************
Private Const STRING_SIZE = 128
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Private 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
Private Declare Function InternetCloseHandle Lib "wininet" (ByRef hInet As Long) As Long
Private Declare Function InternetReadFile Lib "wininet" _
(ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" _
(ByVal hInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, _
ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Function SendAPIRequest(ByVal strUrl As String) As String
Dim hOpen As Long, hFile As Long
Dim Ret As Long, sBuffer As String * 128
Dim iResult As Integer, sData As String
hOpen = InternetOpen("VB Program", 1, vbNullString, vbNullString, 0)
If hOpen = 0 Then
MsgBox "Error opening Internet connection"
Exit Function
End If
hFile = InternetOpenUrl(hOpen, strUrl, vbNullString, 0, INTERNET_FLAG_NO_CACHE_WRITE, 0)
If hFile = 0 Then
MsgBox "Error opening Web page"
Else
InternetReadFile hFile, sBuffer, STRING_SIZE, Ret
sData = sBuffer
Do While Ret <> 0
InternetReadFile hFile, sBuffer, STRING_SIZE, Ret
sData = sData + Mid(sBuffer, 1, Ret)
Loop
End If
InternetCloseHandle hFile
InternetCloseHandle hOpen
SendAPIRequest = sData
sData = ""
End Function
'***************************************************************************
'***************************************************************************
'** **
'** MSXML - GET TEXT FROM WEB PAGE - REFERENCE REQUIRED **
'** **
'***************************************************************************
'***************************************************************************
Private Function SendXMLRequest(ByVal strUrl As String) _
As String
On Error Resume Next
Dim objHTTP As New MSXML.XMLHTTPRequest
objHTTP.Open "GET", strUrl, False
objHTTP.setRequestHeader "Content-Type", "text/html"
If Err = 0 Then
objHTTP.send
SendXMLRequest = objHTTP.responseText
Else
MsgBox "Error " & Err.Number & _
vbNewLine & Err.Description
End If
End Function
'***************************************************************************
'***************************************************************************
'** **
'** HTMLDOC - GET TEXT FROM WEB PAGE - REFERENCE REQUIRED **
'** **
'***************************************************************************
'***************************************************************************
Private Function getHTMLDocument(ByVal strUrl As String) As String
Dim HTML As New HTMLDocument
Dim DOC As HTMLDocument
Set DOC = HTML.createDocumentFromUrl(strUrl, vbNullString)
Do While DOC.ReadyState <> "complete"
DoEvents
Loop
getHTMLDocument = DOC.documentElement.innerHTML '// .innerText
End Function
'***************************************************************************
'***************************************************************************
'** **
'** WEBBROWSER - GET TEXT FROM WEB PAGE - WEB BROWSER CONTROL REQUIRED **
'** **
'***************************************************************************
'***************************************************************************
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
If (pDisp Is WebBrowser1.Application) Then
sText = WebBrowser1.document.documentElement.innerHTML '// .innerText
End If
End Sub
|
