none
how to get file size and type befor downloading from internst by access db?? RRS feed

  • Question

  • hello every body

    i build  my access database like (internet Download manger )

    i need to get file type , size  before downloading   PLZ

    i use  that code for size

    Function GetFileSize(URL As String) As Long
    
    Dim xml As Object ' MSXML2.XMLHTTP60
    Dim result As String
    
    Set xml = CreateObject("Msxml2.ServerXMLHTTP")
    
    With xml
      ' get headers only
      .Open "HEAD", URL, False
      .send
    End With
    
    result = xml.getResponseHeader("Content-Length")
    
    GetFileSize = CLng(result)
    
    End Function


     but not work  i dont know  why

    and i use another code for type

    Function GetFiletype(URL As String) As Long
    
    Dim xml As Object ' MSXML2.XMLHTTP60
    Dim result As String
    
    Set xml = CreateObject("Msxml2.ServerXMLHTTP")
    
    With xml
      ' get headers only
      .Open "HEAD", URL, False
      .send
    End With
    
    result = xml.getResponseHeader("Content-type")
    GetFiletype= result
    
    End Function

    and that not worked

     plz  help me hoe to do that


    • Edited by sayed gamal Sunday, September 18, 2016 8:49 PM
    Sunday, September 18, 2016 8:48 PM

Answers

  • You could try:

    'Source: https://www.experts-exchange.com/questions/26397034/VB6-Downloading-file-with-progress-bar-and-KBP-S.html

    Private Const BUF_SIZE        As Long = 4096  ' allocation buffer
     Private Const INVALID_HANDLE_VALUE As Long = (-1)
     Private Const CREATE_ALWAYS   As Long = &H2&
     Private Const GENERIC_WRITE   As Long = &H40000000
     Private Const INTERNET_OPEN_TYPE_PRECONFIG As Long = 1
     Private Const INTERNET_FLAG_NO_CACHE_WRITE As Long = &H4000000
     Private Const INTERNET_FLAG_RELOAD As Long = &H80000000
     Private Const INTERNET_FLAG_RESYNCHRONIZE As Long = &H800&
     Private Const HTTP_QUERY_CONTENT_LENGTH As Long = &H5&
     Private Const HTTP_QUERY_FLAG_NUMBER As Long = &H20000000
     Private Const WININET_API_FLAG_SYNC As Long = &H4&
    
    Private Declare Function CreateFileW Lib "Kernel32.dll" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
     Private Declare Function WriteFile Lib "Kernel32.dll" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
     Private Declare Function CloseHandle Lib "Kernel32.dll" (ByVal hObject As Long) As Long
     Private Declare Function InternetOpenW Lib "Wininet.dll" (ByVal lpszAgent As Long, ByVal dwAccessType As Long, ByVal lpszProxyName As Long, ByVal lpszProxyBypass As Long, ByVal dwFlags As Long) As Long
     Private Declare Function InternetOpenUrlW Lib "Wininet.dll" (ByVal hInternet As Long, ByVal lpszUrl As Long, ByVal lpszHeaders As Long, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
     Private Declare Function InternetReadFile Lib "Wininet.dll" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal dwNumberOfBytesToRead As Long, lpdwNumberOfBytesRead As Long) As Long
     Private Declare Function InternetCloseHandle Lib "Wininet.dll" (ByVal hInternet As Long) As Long
     Private Declare Function HttpQueryInfoW Lib "Wininet.dll" (ByVal hRequest As Long, ByVal dwInfoLevel As Long, ByRef lpvBuffer As Long, ByRef lpdwBufferLength As Long, ByRef lpdwIndex As Long) As Long
    
    
     Private Function GetContentLength(ByVal url As String) As Long
         Dim hInternet             As Long
         Dim hRequest              As Long
         Dim dwFileSize            As Long
         Dim dwLength              As Long
         Dim dwIndex               As Long
    
        dwLength = 4    ' DWORD 32 bit value buffer length.
         hInternet = InternetOpenW(0, 1, 0, 0, WININET_API_FLAG_SYNC)
         hRequest = InternetOpenUrlW(hInternet, StrPtr(url), 0, 0, 0, 0)
    
        If HttpQueryInfoW(hRequest, HTTP_QUERY_CONTENT_LENGTH Or HTTP_QUERY_FLAG_NUMBER, _
                           dwFileSize, dwLength, dwIndex) Then
             GetContentLength = dwFileSize
         Else
             GetContentLength = (-1)
         End If
    
        InternetCloseHandle hRequest
         InternetCloseHandle hInternet
     End Function
    
    Public Sub DownloadFile(ByVal url As String, ByVal filePath As String)
         Dim Buffer(BUF_SIZE)      As Byte
         Dim hInternet             As Long
         Dim hRequest              As Long
         Dim hFile                 As Long    'file handle
         Dim dwBytesWritten        As Long    'bytes written
         Dim dwBytesRead           As Long    'bytes read
         Dim dwFileSize            As Long
         Dim dwStatus              As Long
         Dim dwPercent             As Long
    
        ' Returns requested size of the file on the server in bytes.
         dwFileSize = GetContentLength(url)
    
        If dwFileSize = (-1) Then
             Debug.Print "Content-Length couldn't be determined."
             Exit Sub
         End If
    
        ' Create the file, always overwriting any existing file
         hFile = CreateFileW(StrPtr("\\?\" & filePath), GENERIC_WRITE, 0, 0, CREATE_ALWAYS, 0, 0)
         If hFile = INVALID_HANDLE_VALUE Then
             Debug.Print "CreateFile error"; Err.LastDllError
             Exit Sub    ' _leave
         End If
    
        ' Initialize request
         hInternet = InternetOpenW(0, INTERNET_OPEN_TYPE_PRECONFIG, 0, 0, WININET_API_FLAG_SYNC)
         If hInternet = 0 Then
             CloseHandle hFile
             Debug.Print "InternetOpen error"; Err.LastDllError
             Exit Sub
         End If
    
        ' The requested url
         hRequest = InternetOpenUrlW(hInternet, StrPtr(url), 0, 0, _
                                     INTERNET_FLAG_NO_CACHE_WRITE Or _
                                     INTERNET_FLAG_RELOAD Or _
                                     INTERNET_FLAG_RESYNCHRONIZE, 0)
         If hRequest = 0 Then
             InternetCloseHandle hInternet
             CloseHandle hFile
             Debug.Print "InternetOpenUrl error"; Err.LastDllError
             Exit Sub
         End If
    
        ' Request the bytes and write them to the file.
         Do
             If InternetReadFile(hRequest, VarPtr(Buffer(0)), BUF_SIZE, dwBytesRead) Then
                 If WriteFile(hFile, VarPtr(Buffer(0)), dwBytesRead, dwBytesWritten, 0) Then
                     ' TODO:// calculate progress
                     dwStatus = (dwStatus + dwBytesWritten)
                     dwPercent = (dwStatus / dwFileSize) * 100
                     '            Form1.Caption = dwPercent '<-- change this
                     Debug.Print dwPercent
                 Else
                     Debug.Print "WriteFile error"; Err.LastDllError
                     Exit Do
                 End If
             Else
                 Debug.Print "InternetReadFile error"; Err.LastDllError
                 Exit Do    ' _leave
             End If
             DoEvents
         Loop Until dwBytesRead = 0
    
        ' cleanup
         InternetCloseHandle hRequest
         InternetCloseHandle hInternet
         CloseHandle hFile
         Erase Buffer
         Debug.Print "Done"
     End Sub
    

    It works fine for some servers and not others (not sure why - I'm thinking it may have to do with the type of server involved - Windows vs LINUX, but that's just a guess at this point in time).

    There are also FTP procedure that you might be able to employ.


    -- Daniel Pineault, 2010-2015 Microsoft MVP Professional Support: http://www.cardaconsultants.com MS Access Tips and Code Samples: http://www.devhut.net



    Sunday, September 18, 2016 10:58 PM

All replies

  • You could try:

    'Source: https://www.experts-exchange.com/questions/26397034/VB6-Downloading-file-with-progress-bar-and-KBP-S.html

    Private Const BUF_SIZE        As Long = 4096  ' allocation buffer
     Private Const INVALID_HANDLE_VALUE As Long = (-1)
     Private Const CREATE_ALWAYS   As Long = &H2&
     Private Const GENERIC_WRITE   As Long = &H40000000
     Private Const INTERNET_OPEN_TYPE_PRECONFIG As Long = 1
     Private Const INTERNET_FLAG_NO_CACHE_WRITE As Long = &H4000000
     Private Const INTERNET_FLAG_RELOAD As Long = &H80000000
     Private Const INTERNET_FLAG_RESYNCHRONIZE As Long = &H800&
     Private Const HTTP_QUERY_CONTENT_LENGTH As Long = &H5&
     Private Const HTTP_QUERY_FLAG_NUMBER As Long = &H20000000
     Private Const WININET_API_FLAG_SYNC As Long = &H4&
    
    Private Declare Function CreateFileW Lib "Kernel32.dll" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
     Private Declare Function WriteFile Lib "Kernel32.dll" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
     Private Declare Function CloseHandle Lib "Kernel32.dll" (ByVal hObject As Long) As Long
     Private Declare Function InternetOpenW Lib "Wininet.dll" (ByVal lpszAgent As Long, ByVal dwAccessType As Long, ByVal lpszProxyName As Long, ByVal lpszProxyBypass As Long, ByVal dwFlags As Long) As Long
     Private Declare Function InternetOpenUrlW Lib "Wininet.dll" (ByVal hInternet As Long, ByVal lpszUrl As Long, ByVal lpszHeaders As Long, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
     Private Declare Function InternetReadFile Lib "Wininet.dll" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal dwNumberOfBytesToRead As Long, lpdwNumberOfBytesRead As Long) As Long
     Private Declare Function InternetCloseHandle Lib "Wininet.dll" (ByVal hInternet As Long) As Long
     Private Declare Function HttpQueryInfoW Lib "Wininet.dll" (ByVal hRequest As Long, ByVal dwInfoLevel As Long, ByRef lpvBuffer As Long, ByRef lpdwBufferLength As Long, ByRef lpdwIndex As Long) As Long
    
    
     Private Function GetContentLength(ByVal url As String) As Long
         Dim hInternet             As Long
         Dim hRequest              As Long
         Dim dwFileSize            As Long
         Dim dwLength              As Long
         Dim dwIndex               As Long
    
        dwLength = 4    ' DWORD 32 bit value buffer length.
         hInternet = InternetOpenW(0, 1, 0, 0, WININET_API_FLAG_SYNC)
         hRequest = InternetOpenUrlW(hInternet, StrPtr(url), 0, 0, 0, 0)
    
        If HttpQueryInfoW(hRequest, HTTP_QUERY_CONTENT_LENGTH Or HTTP_QUERY_FLAG_NUMBER, _
                           dwFileSize, dwLength, dwIndex) Then
             GetContentLength = dwFileSize
         Else
             GetContentLength = (-1)
         End If
    
        InternetCloseHandle hRequest
         InternetCloseHandle hInternet
     End Function
    
    Public Sub DownloadFile(ByVal url As String, ByVal filePath As String)
         Dim Buffer(BUF_SIZE)      As Byte
         Dim hInternet             As Long
         Dim hRequest              As Long
         Dim hFile                 As Long    'file handle
         Dim dwBytesWritten        As Long    'bytes written
         Dim dwBytesRead           As Long    'bytes read
         Dim dwFileSize            As Long
         Dim dwStatus              As Long
         Dim dwPercent             As Long
    
        ' Returns requested size of the file on the server in bytes.
         dwFileSize = GetContentLength(url)
    
        If dwFileSize = (-1) Then
             Debug.Print "Content-Length couldn't be determined."
             Exit Sub
         End If
    
        ' Create the file, always overwriting any existing file
         hFile = CreateFileW(StrPtr("\\?\" & filePath), GENERIC_WRITE, 0, 0, CREATE_ALWAYS, 0, 0)
         If hFile = INVALID_HANDLE_VALUE Then
             Debug.Print "CreateFile error"; Err.LastDllError
             Exit Sub    ' _leave
         End If
    
        ' Initialize request
         hInternet = InternetOpenW(0, INTERNET_OPEN_TYPE_PRECONFIG, 0, 0, WININET_API_FLAG_SYNC)
         If hInternet = 0 Then
             CloseHandle hFile
             Debug.Print "InternetOpen error"; Err.LastDllError
             Exit Sub
         End If
    
        ' The requested url
         hRequest = InternetOpenUrlW(hInternet, StrPtr(url), 0, 0, _
                                     INTERNET_FLAG_NO_CACHE_WRITE Or _
                                     INTERNET_FLAG_RELOAD Or _
                                     INTERNET_FLAG_RESYNCHRONIZE, 0)
         If hRequest = 0 Then
             InternetCloseHandle hInternet
             CloseHandle hFile
             Debug.Print "InternetOpenUrl error"; Err.LastDllError
             Exit Sub
         End If
    
        ' Request the bytes and write them to the file.
         Do
             If InternetReadFile(hRequest, VarPtr(Buffer(0)), BUF_SIZE, dwBytesRead) Then
                 If WriteFile(hFile, VarPtr(Buffer(0)), dwBytesRead, dwBytesWritten, 0) Then
                     ' TODO:// calculate progress
                     dwStatus = (dwStatus + dwBytesWritten)
                     dwPercent = (dwStatus / dwFileSize) * 100
                     '            Form1.Caption = dwPercent '<-- change this
                     Debug.Print dwPercent
                 Else
                     Debug.Print "WriteFile error"; Err.LastDllError
                     Exit Do
                 End If
             Else
                 Debug.Print "InternetReadFile error"; Err.LastDllError
                 Exit Do    ' _leave
             End If
             DoEvents
         Loop Until dwBytesRead = 0
    
        ' cleanup
         InternetCloseHandle hRequest
         InternetCloseHandle hInternet
         CloseHandle hFile
         Erase Buffer
         Debug.Print "Done"
     End Sub
    

    It works fine for some servers and not others (not sure why - I'm thinking it may have to do with the type of server involved - Windows vs LINUX, but that's just a guess at this point in time).

    There are also FTP procedure that you might be able to employ.


    -- Daniel Pineault, 2010-2015 Microsoft MVP Professional Support: http://www.cardaconsultants.com MS Access Tips and Code Samples: http://www.devhut.net



    Sunday, September 18, 2016 10:58 PM
  • Also, I tested your original code, and it seems to work for me without any issue.  I've try several downloads from various sources and it always returned the Size correctly.

    The GetFileType would need to be modified from

    Function GetFiletype(URL As String) As Long

    to:

    Function GetFiletype(URL As String) As String

    as it returns a textual value and not a numeric one, but beside that it does seem to work.

    What error(s) are you getting?  Can you post a sample of your db for closer review.


    -- Daniel Pineault, 2010-2015 Microsoft MVP Professional Support: http://www.cardaconsultants.com MS Access Tips and Code Samples: http://www.devhut.net

    Sunday, September 18, 2016 11:06 PM
  • Also, I tested your original code, and it seems to work for me without any issue.  I've try several downloads from various sources and it always returned the Size correctly.

    The GetFileType would need to be modified from

    Function GetFiletype(URL As String) As Long

    to:

    Function GetFiletype(URL As String) As String

    as it returns a textual value and not a numeric one, but beside that it does seem to work.

    What error(s) are you getting?  Can you post a sample of your db for closer review.


    -- Daniel Pineault, 2010-2015 Microsoft MVP Professional Support: http://www.cardaconsultants.com MS Access Tips and Code Samples: http://www.devhut.net

    well i will tell you

    about getfilesize

    some links is worked good and some links get me 0 byte but it is not  and some links give me same size and some links give me type mismatch error

      note - i take links for test from internet download manger

    about getfiletype

    give me type mismatch error

    look

    -----------------------------------------------------

    lets talk about your function

    if i have that  in my access database

    1- Url_textbox

    2-Saveto_texbox

    3-progressbar1

    4-button1

    how i linked progressbar1 with my download

    and ask allah make your live is happy more than what you want

    Monday, September 19, 2016 7:44 AM
  • its worked verrrrrrrrry goood my friends   thanks to you verrry match

    but i need something

    about save to 

    your function

    i must write destention who i save my file  in it like

    "E:\New folder\dsa.rar"

    it should be

    "E:\New folder"

    have any idea about that ??

    and i linked progresspar with down load  goood thanks to  you

    Monday, September 19, 2016 9:46 AM
  • hello can any one help me about last question

    PLZ

    Tuesday, September 20, 2016 9:53 PM
  •  

    Hi,

    I am very glad that your original issue has been resolved.

    For the new issue, I suggest you post a new thread, so that more community members would help you to focus on the new specific issue.

    Besides, I suggest you make us clear that how do you want to return the path.

    Thanks for your understanding.

    Regards,

    Celeste

    Wednesday, September 21, 2016 8:13 AM
    Moderator
  •  

    Hi,

    I am very glad that your original issue has been resolved.

    For the new issue, I suggest you post a new thread, so that more community members would help you to focus on the new specific issue.

    Besides, I suggest you make us clear that how do you want to return the path.

    Thanks for your understanding.

    Regards,

    Celeste

    okay my friend ... thanks to allllll

    i will write anew post about my problem

    Wednesday, September 21, 2016 10:17 AM