Post by Paul Baker [MVP, Windows - SDK]It looks like a problem with your code to me.
Using ReDim to reallocate the memory for your buffer is very inefficient and
if the file is received in small chunks, it will repeat your loop often and
take the extra time to reallocate memory often.
And what is lngTotalBytes? Is it the total number of bytes expected? I
wouldn't even look at this, just keep reading until you're done. If you do
use it, use it only for a progress bar. You, however, are using it to decide
how large to make the buffer. You are making it large enough to fit the
entire portion of the file not already downloaded. Most of the time this is
allocating way more memory than you need.
Allocating 10 MB
Re-allocating 10.999 MB
Re-allocating 10.990 MB
Re-allocating 10.987 MB
etc.
Hundres of times.
Instead, allocate a small buffer (no more than a few KB), just once. If you
happen to received more at one time, you'll get it in chunks with minimal
overhead.
Paul
Hello thanks for answer, you see i've very problem with english....
however lngTotalBytes Is the total number of bytes expected, i'm using
redim only to download the last chunk if it is smaller than buffer.
This is the complete code of class module...
Option Explicit
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
Private Declare Function InternetConnect Lib "wininet.dll" Alias
"InternetConnectA" (ByVal hInternetSession As Long, ByVal
lpszServerName As String, ByVal nProxyPort As Integer, ByVal
lpszUserName As String, ByVal lpszPassword As String, ByVal dwService
As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias
"HttpOpenRequestA" (ByVal hInternetSession As Long, ByVal lpszVerb As
String, ByVal lpszObjectName As String, ByVal lpszVersion As String,
ByVal lpszReferer As String, ByVal lpszAcceptTypes As Long, ByVal
dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias
"HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As
String, ByVal lHeadersLength As Long, sOptional As Any, ByVal
lOptionalLength As Long) As Long
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 Long
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal
hFile As Long, ByRef sBuffer As Any, 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 InternetErrorDlg Lib "wininet.dll" (ByVal
hwnd As Long, ByVal hResourceHandleuest As Long, ByVal dwError As
Long, ByVal dwFlags As Long, ByVal lppvData As String) As Long
Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll"
(ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, ByVal
dwNameLen As Integer, ByVal dwReserved As Long) As Long
Private Declare Function InternetCheckConnection Lib "wininet.dll"
Alias "InternetCheckConnectionA" (ByVal lpszUrl As String, ByVal
dwFlags As Long, ByVal dwReserved As Long) As Long
'Flags for API declarations
Private Const FLAG_ICC_FORCE_CONNECTION = &H1
Private Const INTERNET_DEFAULT_HTTPS_PORT = 443
Private Const INTERNET_DEFAULT_HTTP_PORT = 80
Private Const INTERNET_SERVICE_HTTP = 3
Private Const INTERNET_FLAG_SECURE = &H800000
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Private Const INTERNET_FLAG_DONT_CACHE = &H4000000
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const ERROR_INTERNET_FORCE_RETRY = 12032
Private Const FLAGS_ERROR_UI_FILTER_FOR_ERRORS = 1
Private Const FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS = 2
Private Const FLAGS_ERROR_UI_FLAGS_GENERATE_DATA = 4
Private Const HTTP_STATUS_PROXY_AUTH_REQ = 407
Private Const HTTP_STATUS_OK = 200
Private Const HTTP_STATUS_CREATED = 201
Private Const HTTP_QUERY_STATUS_CODE = 19
Private Const HTTP_QUERY_FLAG_NUMBER = &H20000000
Private Const HTTP_QUERY_CONTENT_LENGTH = 5
Private hOpenHandle As Long
Private hConnectHandle As Long
Private lngHandle As Long
Dim lngByteTotali As Long
Dim lngByteLetti As Long
Public Event NotificaDownload(lngByteScaricati As Long)
Public Sub Download(server As String, url As String, LocalFile As
String, Handle As Long)
Dim sErr As String
If ApriConnessione(server, Handle) Then
DownloadFile url, LocalFile, sErr
ChiudiConnessione
End If
End Sub
Public Property Get DimensioneDownload() As Long
DimensioneDownload = lngByteTotali
End Property
Private Function GetPortaProxy() As Integer
On Error GoTo errore
Dim sPorta As String
Dim objProxy As Object
Set objProxy = CreateObject("ProxySetting.clsProxy")
sPorta = objProxy.ProxyPort
If sPorta <> 0 Then
GetPortaProxy = sPorta
Else
GetPortaProxy = INTERNET_DEFAULT_HTTP_PORT
End If
Exit Function
errore:
GetPortaProxy = INTERNET_DEFAULT_HTTP_PORT
End Function
Private Function ApriConnessione(strServer As String, Handle As Long)
As Boolean
Dim iPorta As Integer
iPorta = GetPortaProxy
lngHandle = Handle
'If InternetCheckConnection("http://" & strServer,
FLAG_ICC_FORCE_CONNECTION, 0&) Then
If hOpenHandle = 0 Then
hOpenHandle = InternetOpen(App.Title,
INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
If hOpenHandle > 0 Then
hConnectHandle = InternetConnect(hOpenHandle,
strServer, iPorta, vbNullString, vbNullString, INTERNET_SERVICE_HTTP,
0, 0)
If hConnectHandle > 0 Then
ApriConnessione = True
End If
End If
Else
ApriConnessione = True
End If
'Else
' ApriConnessione = False
'End If
End Function
Private Sub ChiudiConnessione()
Dim lngRet As Long
If hConnectHandle > 0 Then
lngRet = InternetCloseHandle(hConnectHandle)
hConnectHandle = 0
End If
If hOpenHandle > 0 Then
lngRet = InternetCloseHandle(hOpenHandle)
hOpenHandle = 0
End If
End Sub
Private Function DownloadFile(ByVal sUrl As String, ByVal sFile As
String, ByRef strErrore As String) As Boolean
'Public Function CallInternet(strPage As String, strOperation As
String, strRes As String, strErrore As String, Optional strData As
String = "") As Boolean
Const Bytes2Read = 1024
Dim hResourceHandle As Long
Dim sString As String
Dim sReadBuffer() As Byte
Dim lNumberOfBytesRead As Long
Dim lStatus As Long
Dim dwErrorCode As Integer
Dim dwError As Integer
Dim iFreeFile As Integer
lngByteTotali = 0
lngByteLetti = 0
hResourceHandle = HttpOpenRequest(hConnectHandle, "GET", sUrl,
vbNullString, vbNullString, 0, INTERNET_FLAG_DONT_CACHE Or
INTERNET_FLAG_KEEP_CONNECTION, 0)
If hResourceHandle > 0 Then
resend:
If HttpSendRequest(hResourceHandle, vbNullString, 0, Null, 0) > 0
Then
If HttpQueryInfo(hResourceHandle, HTTP_QUERY_FLAG_NUMBER Or
HTTP_QUERY_STATUS_CODE, lStatus, Len(lStatus), 0) > 0 Then
If lStatus = HTTP_STATUS_PROXY_AUTH_REQ Then
'Set error code
If hResourceHandle Then
dwErrorCode = 0
Else
dwErrorCode = Err.LastDllError
End If
'Ask for proxy login
dwError = InternetErrorDlg(lngHandle, hResourceHandle,
dwErrorCode, FLAGS_ERROR_UI_FILTER_FOR_ERRORS Or
FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS Or
FLAGS_ERROR_UI_FLAGS_GENERATE_DATA, vbNullString)
'Resend request with proxy authorization
If (dwError = ERROR_INTERNET_FORCE_RETRY) Then
GoTo resend
End If
End If
If lStatus <> HTTP_STATUS_OK And lStatus <>
HTTP_STATUS_CREATED Then
GoTo Gestione_Errore
End If
If (HttpQueryInfo(hResourceHandle,
HTTP_QUERY_CONTENT_LENGTH Or HTTP_QUERY_FLAG_NUMBER, lngByteTotali,
Len(lngByteTotali), 0)) Then
If lngByteTotali > 0 Then
ReDim sReadBuffer(1 To Bytes2Read)
iFreeFile = FreeFile
Open sFile For Binary Access Write As #iFreeFile
Do While lngByteLetti < lngByteTotali
If (lngByteLetti + Bytes2Read) > lngByteTotali
Then
ReDim sReadBuffer(1 To lngByteTotali -
lngByteLetti)
End If
If InternetReadFile(hResourceHandle,
sReadBuffer(1), UBound(sReadBuffer), lNumberOfBytesRead) > 0 Then
If lNumberOfBytesRead = 0 Then Exit Do
lngByteLetti = lngByteLetti +
lNumberOfBytesRead
Put #iFreeFile, , sReadBuffer
RaiseEvent NotificaDownload(lngByteLetti)
Else
GoTo Gestione_Errore
End If
Loop
Close #iFreeFile
DownloadFile = True
Else
GoTo Gestione_Errore
End If
Else
GoTo Gestione_Errore
End If
Else
GoTo Gestione_Errore
End If
Else
GoTo Gestione_Errore
End If
Else
GoTo Gestione_Errore
End If
Exit Function
Gestione_Errore:
DownloadFile = False
strErrore = "errore=" & lStatus
If hResourceHandle > 0 Then
Call InternetCloseHandle(hResourceHandle)
End If
End Function