Home Page Bahamas Software Bahamas Real Estate Bahamas Writer Business Services Contact Us

Computer Repair
Tel: 242-364-9183
Nassau, Bahamas
Bahamas Video Surveillance . Bahamas CCTV . Bahamas Infrared . Bahamas Digital Video . Bahamas Remote Video . Bahamas Burglar Alarm . Bahamas Technician
Bahamas Real Estate
Bahamas Yellow Pages


Free Software:


We Recommend:
MediaFire - Free File Hosting Made Simple
Follow us on:
Twitter Twitter


 

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

Bahamas CCTV . Bahamas DVR . Bahamas Camera . Bahamas Video . Bahamas Computer Repair . Bahamas Software . Bahamas Business . Bahamas Real Estate
Copyright (c) 2001/2010 BahamasSecurity.com