|
Question : How do I retrieve text from a website
|
|
Hello to all,
I need to write some code in to import currency exchange rate data from a website into a database table and display it in a form.
I found the following code , and I was wondering if someone can explain how to use it:
*******************************************************************************************************************************************
'I had to write some code in VB6 to import currency exchange rate data into a database and I thought I'd post it here in case anyone else needed to do the same thing.
'The API part of the code was from Ryan Woodward who has many thanks from me!
'The Text from the website can be retrieved and placed in a text field or string by using a simple function call from within any form event,
'eg. if you had a command button called btnRetrieve you could put it in btnRetrieve_Click().
'I then used Split, Left, Mid and Right to extract the parts of the data which I needed.
'In the following, txtURL is the web-site address and txtURLSource is the string variable you are placing it into.
'
'txtURLSource = OpenUrl(txtURL)
'
'To implement it, create a module called rwInetXfer and copy the following into it.
'It worked a treat for me, both in VB6 and when I imported it into Access2K.
'
'--rwInetXfer
':: ::ver 1.0vb::
':: ::orig. author R. Woodward::
':: ::[email protected]::
'::
'::WHY:
':: Many versions of the Microsoft Internet Transfer Control
':: that shipped with VB are buggy or unreliable
':: Here's a nice substitute with source code
':: Currently only implements OpenUrl
'::
'::DESC:
':: Internet File Transfer Object
':: Retrieve internet files over http using
':: Windows system DLLs (wininet) and system network config
'::
'::E.G.:
':: Dim inet As rwInetXfer
':: debug.Print "HTML SOURCE-"
':: debug.Print inet.OpenUrl("http://www.yahoo.com")
'::
Option Explicit
Const ClassName = "rwInetXfer"
Public DontUseCache As Boolean
Private Enum InfoLevelEnum
http_QUERY_CONTENT_TYPE = 1
http_QUERY_CONTENT_LENGTH = 5
http_QUERY_EXPIRES = 10
http_QUERY_LAST_MODIFIED = 11
http_QUERY_PRAGMA = 17
http_QUERY_VERSION = 18
http_QUERY_STATUS_CODE = 19
http_QUERY_STATUS_TEXT = 20
http_QUERY_RAW_HEADERS = 21
http_QUERY_RAW_HEADERS_CRLF = 22
http_QUERY_FORWARDED = 30
http_QUERY_SERVER = 37
http_QUERY_USER_AGENT = 39
http_QUERY_SET_COOKIE = 43
http_QUERY_REQUEST_METHOD = 45
http_STATUS_DENIED = 401
http_STATUS_PROXY_AUTH_REQ = 407
End Enum
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PROXY = 3
Private Const SCUSERAGENT = "Mozilla/4.0 (compatible; MSIE 5.0; Windows NT 5.1)"
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_ASYNC = &H10000000 ' this request is asynchronous (where supported)
Private Const INTERNET_FLAG_FROM_CACHE = &H1000000 ' use offline semantics
Private Const INTERNET_FLAG_OFFLINE = INTERNET_FLAG_FROM_CACHE
Private Const INTERNET_FLAG_EXISTING_CONNECT = &H20000000
' BOOL httpQueryInfo(
' IN HINTERNET hhttpRequest,
' IN DWORD dwInfoLevel,
' IN LPVOID lpvBuffer,
' IN LPDWORD lpdwBufferLength,
' IN OUT LPDWORD lpdwIndex,
' );
'--httpQueryInfo
'::DESC:
':: Queries for information about an http request.
'::
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 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
'--InternetOpenUrl
'::DESC:
':: Open a handle for retrieving a URL
'::EG:
':: hOpenUrl = InternetOpenUrl(hOpen, sUrl, vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
':: hOpenUrl = InternetOpenUrl(hOpen, sUrl, vbNullString, 0, INTERNET_FLAG_FROM_CACHE, 0)
':: hOpenUrl = InternetOpenUrl(hOpen, sUrl, vbNullString, 0, INTERNET_FLAG_EXISTING_CONNECT, 0)
':: hOpenUrl = InternetOpenUrl(hOpen, sUrl, vbNullString, 0, 0, 0)
'::
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" _
(ByVal hOpen As Long, ByVal sURL As String, ByVal sHeaders As String, _
ByVal lLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" _
(ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, _
lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer
Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" _
(lpdwError As Long, ByVal lpszBuffer As String, ByVal lpdwBufferLength As Long) As Integer
'--OpenUrl(url)
'::DESC:
':: Retrieve the page specified by "url"
':: Returns string of page source
':: On error, returns "error #"
':: e.g. page not found returns "error 404"
'::
Public Function OpenUrl(ByVal sURL As String) As String
#If DEVREL < 1 Then
On Error GoTo exitfunc
#End If
Dim S As String
Dim sReadBuf As String * 2048 'a data buffer for InternetOpen fcns
Dim bytesRead As Long
Dim hInet As Long 'wininet handle
Dim hUrl As Long 'url request handle
Dim flagMoreData As Boolean
Dim ret As String
' used for callling httpQueryInfo
Dim sErrBuf As String * 255
Dim sErrBufLen As Long
Dim dwIndex As Long
' return codes and err code saves
Dim lastErr As Long
Dim bRet As Boolean
Dim wRet As Integer
' http status code
Dim httpCode As Integer
' grab a handle for using wininet
hInet = InternetOpen(SCUSERAGENT, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
If Err.LastDllError <> 0 Then
lastErr = Err.LastDllError
ret = "error (wininet.dll," & lastErr & ")"
GoTo exitfunc
End If
' retrieve the requested URL
If DontUseCache Then
hUrl = InternetOpenUrl(hInet, sURL, vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
Else
hUrl = InternetOpenUrl(hInet, sURL, vbNullString, 0, 0, 0)
End If
If Err.LastDllError <> 0 Then
lastErr = Err.LastDllError
ret = "error (wininet.dll," & lastErr & ")"
GoTo exitfunc
End If
' get query info, this should give us a status code among other things
sErrBufLen = 255
bRet = httpQueryInfo(hUrl, http_QUERY_STATUS_CODE, ByVal sErrBuf, sErrBufLen, dwIndex)
If Err.LastDllError <> 0 Then
lastErr = Err.LastDllError
ret = "error (wininet.dll," & lastErr & ")"
GoTo exitfunc
End If
' sErrBuf should now hopefully contain http status code stuff
' if the call failed, no status info was returned (i.e. sErrBuf is empty)
' then throw error
If sErrBufLen = 0 Or Not bRet Then
ret = "error"
GoTo exitfunc
Else
' retrieve the http status code
httpCode = CInt(Left(sErrBuf, sErrBufLen))
If httpCode >= 300 Then
ret = "error " & httpCode
GoTo exitfunc
End If
End If
' if we made it this far, then we can begin retrieving data
flagMoreData = True
Do While flagMoreData
sReadBuf = vbNullString
wRet = InternetReadFile(hUrl, sReadBuf, Len(sReadBuf), bytesRead)
If Err.LastDllError <> 0 Then
lastErr = Err.LastDllError
ret = "error (wininet.dll," & lastErr & ")"
GoTo exitfunc
End If
If wRet <> 1 Then
ret = "error"
GoTo exitfunc
End If
S = S & Left$(sReadBuf, bytesRead)
If Not CBool(bytesRead) Then flagMoreData = False
Loop
ret = S
exitfunc:
If hUrl <> 0 Then InternetCloseHandle (hUrl)
If hInet <> 0 Then InternetCloseHandle (hInet)
OpenUrl = ret
End Function
Private Sub Class_Initialize()
DontUseCache = False
End Sub
********************************************************************************************************************************************
I'm new to MS Access, so please elaborate your answers.
Thanks in advance!
|
|
|
Answer : How do I retrieve text from a website
|
|
Are you protecting files from inbetween the 5 users? or they all will need the same access? Are you going to need email? if no email, then creating a domain is actually really easy so then each computer can login, only those 5 will have access and group policy will be nice to have to limit their actions on the computer themselves, nice server too, so you might as well use it for something else rather than just a fileserver.
Let me know if you need more help on this.
|
|
|
|
|
