VERSION 5.00
Begin VB.UserControl ctUrlMonDownloader 
   CanGetFocus     =   0   'False
   ClientHeight    =   480
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   480
   ClipBehavior    =   0  'None
   ClipControls    =   0   'False
   FillStyle       =   0  'Solid
   FontTransparent =   0   'False
   HasDC           =   0   'False
   HitBehavior     =   0  'None
   InvisibleAtRuntime=   -1  'True
   PaletteMode     =   4  'None
   ScaleHeight     =   32
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   32
   Windowless      =   -1  'True
End
Attribute VB_Name = "ctUrlMonDownloader"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Option Base 0

Public Enum hlpUrlMon_Enum
  hlpUrlMon_ErrInProgress = &H80000000
  hlpUrlMon_ErrAlreadyMatches = -1&
  hlpUrlMon_ErrNotFound = -10&
  hlpUrlMon_ErrTimeOut = -11&
  hlpUrlMon_ErrIncomplete = -12&
  hlpUrlMon_ErrUrlMonDllMissing = -90&
  hlpUrlMon_ErrUnknownError = -99&
  End Enum

#Const hlpUrlMon_UseCache = True
#If hlpUrlMon_UseCache Then
  Private Const DLCacheMax As Long = 2048&
  Private Const DLCacheMaxX As Long = DLCacheMax - 1&
  Private DLCacheFile(DLCacheMaxX) As String
  'Private DLCacheFileDL(DLCacheMaxX) As String
  Private DLCacheSize(DLCacheMaxX) As Long
  Private DLCacheData(DLCacheMaxX) As String
  Private DLCacheDL(DLCacheMaxX) As Byte
  Private DLCacheCount As Long
  Private DLCacheIndex As Long
  #End If

Private hlpUrlMon_Filesize As Long
Private hlpUrlMon_GetSizeOnly As Boolean
Private hlpUrlMon_LastEvent As Long

Private hlpUrlMon_ProgressControl As Long
Private hlpUrlMon_ProgressStart As Long
Private hlpUrlMon_ProgressTotal As Long
Private hlpUrlMon_ProgressQueue  As Long

#If hlpUrlMon_UseCache Then
  Private xHasCachedData As Long
  #Else
  Private xCachedData As String
  Private xHasCachedData As Boolean
  #End If

'Private Declare Function CreateFileA Lib "kernel32.dll" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long

Private Declare Function CopyFileA Lib "kernel32" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Declare Function DeleteFileA Lib "kernel32" (ByVal lpFileName As String) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, ByVal Length As Long)

Public Event DownloadStatus(ByVal BytesRead As Long, ByVal BytesTotal As Long)

Public Function GetFile(ByVal URL As String, Optional ByVal TimeOutMS As Long = 15000&, Optional ByVal Filename As String, Optional ByVal GetSizeOnly As Boolean, Optional ByVal FileVersionMinH As Long = 0&, Optional ByVal FileVersionMinL As Long = 0&, Optional ByVal FileVersionMaxH As Long = &H7FFFFFFF, Optional ByVal FileVersionMaxL As Long = &H7FFFFFFF, Optional ByVal ProgressControl As Long = 0&, Optional ByVal ProgressStart As Long = 0&, Optional ByVal ProgressTotal As Long = 0&, Optional ByVal ProgressQueue As Long = 0&, Optional ByVal ForceUpdate As Boolean = False, Optional ByRef IsCachedFile As Boolean) As Long
  Dim xLong1 As Long
  Dim xLong2 As Long
  
  
  URL = Replace(URL, "\", "/")
  If InStr(URL, "://") = 0& Then
    'if not mid(url,2&,1&)=":") or left(
    URL = "http://" + URL
    End If
  
  #If hlpUrlMon_UseCache Then
    xLong1 = GetMyCacheIndex(URL, False)
    If Not xLong1 = -1& Then
      If DLCacheSize(xLong1) > -10& Or DLCacheSize(xLong1) = hlpUrlMon_ErrNotFound Then  'Or DLCacheIndex = xLong1 Then
        
        If GetSizeOnly Then
          IsCachedFile = True
          GetFile = DLCacheSize(xLong1)
          Exit Function
          ElseIf DLCacheDL(xLong1) = 1 Then
          IsCachedFile = True
          GetFile = DLCacheSize(xLong1)
          xHasCachedData = xLong1 + 1&
          Exit Function
          End If
        End If
      End If
    #End If
  
  
  If Not Len(Filename) = 0& Then
    'hlpUrlMon_GetSizeOnly = True
    'Else
    'xLong1 = CreateFileA(Filename, &H80000000, &H1, ByVal 0&, 3&, &H20&, 0&)
    xLong1 = CreateFile(Filename, 1&)
    If Not xLong1 = -1& Then
      If GetFileSize(xLong1, ByVal 0&) Then
        Call CloseHandle(xLong1)
        xLong1 = GetFileVersionEx(Filename, xLong2)
        If Not (xLong1 < FileVersionMinH Or xLong1 > FileVersionMaxH Or xLong1 = FileVersionMinH And xLong2 < FileVersionMinL Or xLong1 = FileVersionMaxH And xLong2 > FileVersionMaxL) Then
          GetFile = hlpUrlMon_ErrAlreadyMatches
          Exit Function
          End If
        Else
        Call CloseHandle(xLong1)
        End If
      End If
    'hlpUrlMon_GetSizeOnly = GetSizeOnly
    End If
  hlpUrlMon_GetSizeOnly = GetSizeOnly
  'hlpUrlMon_LastEvent = DoEventsEx_GetTickCount
  hlpUrlMon_Filesize = hlpUrlMon_ErrInProgress
  
  On Error GoTo Er1
  'If Len(FileName) = 0& Then
  '  hlpUrlMon_GetSizeOnly = True
  '  Else
  '  hlpUrlMon_GetSizeOnly = GetSizeOnly
  '  End If
  hlpUrlMon_ProgressControl = ProgressControl
  hlpUrlMon_ProgressStart = ProgressStart
  hlpUrlMon_ProgressTotal = ProgressTotal
  hlpUrlMon_ProgressQueue = ProgressQueue
  
#If hlpUrlMon_UseCache Then
#Else
  If hlpUrlMon_GetSizeOnly Or Len(Filename) = 0 Then
#End If
    If ForceUpdate Then
      UserControl.AsyncRead URL, vbAsyncTypeByteArray, Filename, vbAsyncReadForceUpdate
      Else
      UserControl.AsyncRead URL, vbAsyncTypeByteArray, Filename ', vbAsyncReadForceUpdate
      End If
#If hlpUrlMon_UseCache Then
#Else
    ElseIf ForceUpdate Then
    UserControl.AsyncRead URL, vbAsyncTypeFile, Filename, vbAsyncReadForceUpdate
    Else
    UserControl.AsyncRead URL, vbAsyncTypeFile, Filename ', vbAsyncReadForceUpdate
    End If
#End If
  
  hlpUrlMon_LastEvent = DoEventsEx_GetTickCount
  Do While (hlpUrlMon_Filesize = hlpUrlMon_ErrInProgress)
    DoEventsEx 500
    If DoEventsEx_IsTickCountElapsed(hlpUrlMon_LastEvent, TimeOutMS) Then
      If hlpUrlMon_Filesize = hlpUrlMon_ErrInProgress Then
        hlpUrlMon_Filesize = hlpUrlMon_ErrTimeOut
        End If
      End If
    Loop
  GetFile = hlpUrlMon_Filesize
Rs1:
  On Error Resume Next
  UserControl.CancelAsyncRead Filename
  On Error GoTo 0
'  Stop
  Exit Function
  
Er1:
  If Err = 690 Then
    GetFile = hlpUrlMon_ErrUrlMonDllMissing
    Else
    GetFile = hlpUrlMon_ErrUnknownError
    End If
  Resume Rs1
  End Function

Private Sub UserControl_AsyncReadComplete(AsyncProp As AsyncProperty)
  Dim xByteA1() As Byte
  
  On Error GoTo Er1:
  If AsyncProp.BytesMax = 0 Then
    'If hlpUrlMon_GetSizeOnly Then
      hlpUrlMon_Filesize = hlpUrlMon_ErrNotFound
    '  ElseIf Not hlpUrlMon_Filesize = 0& Then
    '  hlpUrlMon_Filesize = hlpUrlMon_ErrIncomplete
    '  End If
    ElseIf hlpUrlMon_GetSizeOnly Then
    #If hlpUrlMon_UseCache Then
      hlpUrlMon_Filesize = GetMyCacheIndex(AsyncProp.Status, True)
      DLCacheSize(hlpUrlMon_Filesize) = AsyncProp.BytesMax
      #End If
    hlpUrlMon_Filesize = AsyncProp.BytesMax
    ElseIf AsyncProp.BytesRead = AsyncProp.BytesMax Then
#If hlpUrlMon_UseCache Then
#Else
    If Len(AsyncProp.PropertyName) = 0& Then
#End If
      xByteA1() = AsyncProp.Value
      hlpUrlMon_Filesize = UBound(xByteA1()) + 1&
      
      'xCachedData = AsyncProp.Value
      #If hlpUrlMon_UseCache Then
        xHasCachedData = GetMyCacheIndex(AsyncProp.Status, True)
        'DLCacheFile(xHasCachedData) = AsyncProp.
        DLCacheData(xHasCachedData) = String(hlpUrlMon_Filesize, vbNullChar)
        Call RtlMoveMemory(ByVal DLCacheData(xHasCachedData), xByteA1(0), hlpUrlMon_Filesize)
        DLCacheSize(xHasCachedData) = hlpUrlMon_Filesize
        DLCacheDL(xHasCachedData) = 1
        xHasCachedData = xHasCachedData + 1&
        #Else
        xHasCachedData = True
        xCachedData = String(hlpUrlMon_Filesize, vbNullChar)
        Call RtlMoveMemory(ByVal xCachedData, xByteA1(0), hlpUrlMon_Filesize)
        #End If
      hlpUrlMon_Filesize = AsyncProp.BytesRead
#If hlpUrlMon_UseCache Then
#Else
      ElseIf CopyFileA(AsyncProp.Value, AsyncProp.PropertyName, False) Then
      Call DeleteFileA(AsyncProp.Value)
      hlpUrlMon_Filesize = AsyncProp.BytesRead
      Else
      hlpUrlMon_Filesize = hlpUrlMon_ErrIncomplete
      End If
#End If
    End If
Rs1:
  On Error GoTo 0
  Exit Sub
  
Er1:
  hlpUrlMon_Filesize = hlpUrlMon_ErrUnknownError
  Resume Rs1
  End Sub

Private Sub UserControl_AsyncReadProgress(AsyncProp As AsyncProperty)
  On Error GoTo Er1:
  If Not AsyncProp.BytesMax = 0 Then
    If hlpUrlMon_GetSizeOnly Then
      hlpUrlMon_Filesize = AsyncProp.BytesMax
      Else
      If hlpUrlMon_ProgressQueue = -1& Then hlpUrlMon_ProgressQueue = AsyncProp.BytesMax
      RaiseEvent DownloadStatus(AsyncProp.BytesRead, AsyncProp.BytesMax)
      ctProgressB_SetValue hlpUrlMon_ProgressControl, (hlpUrlMon_ProgressStart + (AsyncProp.BytesRead / AsyncProp.BytesMax * hlpUrlMon_ProgressQueue)), hlpUrlMon_ProgressTotal
      End If
    'If AsyncProp.BytesRead = AsyncProp.BytesMax Or hlpUrlMon_GetSizeOnly Then hlpUrlMon_Filesize = AsyncProp.BytesMax
    hlpUrlMon_LastEvent = DoEventsEx_GetTickCount
    'frmMain.Caption = CStr(AsyncProp.BytesRead) + " - " + CStr(AsyncProp.BytesMax)
    End If
Rs1:
  On Error GoTo 0
  Exit Sub
  
Er1:
  hlpUrlMon_Filesize = hlpUrlMon_ErrUnknownError
  Resume Rs1
  End Sub

Public Function GetDataNow(ByRef xReturnData As String) As Boolean
  #If hlpUrlMon_UseCache Then
    
    If Not xHasCachedData = 0& Then
      xReturnData = DLCacheData(xHasCachedData - 1&)
      xHasCachedData = 0&
      GetDataNow = True
      End If
    #Else
    If xHasCachedData Then
      xReturnData = xCachedData
      xCachedData = ""
      xHasCachedData = False
      GetDataNow = True
      End If
    #End If
  End Function

#If hlpUrlMon_UseCache Then
  Private Function GetMyCacheIndex(ByVal URL As String, ByVal Required As Boolean) As Long
    'Dim xLong1 As Long
    
    URL = LCase(URL)
    For GetMyCacheIndex = 0& To DLCacheCount - 1&
      If DLCacheFile(GetMyCacheIndex) = URL Then
        Exit Function
        End If
      Next
    
    If Required Then
      'Debug.Print "CreateCacheObject:", DLCacheIndex, URL
      DLCacheFile(DLCacheIndex) = URL
      DLCacheSize(DLCacheMaxX) = -1&
      DLCacheDL(DLCacheMaxX) = 0&
      GetMyCacheIndex = DLCacheIndex
      DLCacheIndex = (DLCacheIndex + 1) Mod DLCacheMax
      If Not DLCacheCount = DLCacheMax Then
        DLCacheCount = DLCacheCount + 1&
        End If
      Else
      GetMyCacheIndex = -1&
      End If
    End Function
  #End If
