Attribute VB_Name = "modGetPage"
'<meta HTTP-EQUIV="Refresh" CONTENT="
Option Explicit

' Win32 Internet function: InternetOpen
Public 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

' Win32 Internet function: InternetOpenUrl
Public 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

' Win32 Internet function: InternetReadFile
Public Declare Function InternetReadFile Lib "wininet.dll" _
(ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, _
lNumberOfBytesRead As Long) As Integer

' Win32 Internet function: InternetCloseHandle
Public Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer

Public Const scUserAgent = "VB OpenUrl"
' Use registry access settings.
Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Public Const INTERNET_FLAG_RELOAD = &H80000000
Public Const INTERNET_FLAG_SECURE = &H800000




Function GetDataFrom(ByVal URL As String, ByVal ToFile As String) As String
Dim Errors As String
Errors = ""
On Error Resume Next
    Dim hOpen               As Long
    Dim hOpenUrl            As Long
    Dim sUrl                As String
    Dim bDoLoop             As Boolean
    Dim bRet                As Boolean
    Dim sReadBuffer         As String * 2048
    Dim lNumberOfBytesRead  As Long
    Dim sBuffer             As String
    
    sUrl = URL
       
    hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
    If hOpen = 0 Then
        Errors = Errors & "Error Locating Server..." & Err.LastDllError & Chr(13) & Chr(10)
        GetDataFrom = Errors
        Exit Function
    Else
        'found server
    End If
    
    hOpenUrl = InternetOpenUrl(hOpen, sUrl, vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
    If hOpenUrl = 0 Then
        
        Errors = Errors & "Error Requesting Data...." & Err.LastDllError & Chr(13) & Chr(10)
        
        If Err.LastDllError = 12007 Then
            Errors = Errors & "No internet connection may be active, please check your internet connection and try again." & Chr(13) & Chr(10)
        End If
         
        GetDataFrom = Errors
        Exit Function
    Else
        'Downloading Data...
    End If
    
    bDoLoop = True
    While bDoLoop
        sReadBuffer = vbNullString
        bRet = InternetReadFile(hOpenUrl, sReadBuffer, Len(sReadBuffer), lNumberOfBytesRead)
       If bRet = 0 Then
            Errors = Errors & "Error Reading File on Server" & Err.LastDllError & Chr(13) & Chr(10)
            GetDataFrom = Errors
            Exit Function
        Else
            'Downloading Data
            'Status.Caption = "Downloading Data... " & lNumberOfBytesRead & " bytes downloaded so far..."
        End If
        
        sBuffer = sBuffer & Left$(sReadBuffer, lNumberOfBytesRead)
        If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
    Wend
    
    'Status.Caption = "Download Complete... Storing Data..."
    
    On Error Resume Next
    
    Open ToFile For Binary Access Write As #1
        Put #1, , sBuffer
    Close #1
    
    If hOpenUrl <> 0 Then InternetCloseHandle (hOpenUrl)
    If hOpen <> 0 Then InternetCloseHandle (hOpen)
    
GetDataFrom = Errors
End Function