Загрузка png на диск создает испорченный файл - PullRequest
Новая
       20

Загрузка png на диск создает испорченный файл

1 голос
/ 10 января 2020

В моем проекте я хочу загрузить png-файл с URL-адреса и сохранить его на диске.

У меня есть URL-адрес изображения, и я могу без проблем загрузить его в свой веб-браузер. Но когда я использую Access, чтобы загрузить этот файл и сохранить его, он сохраняет «a» файл, но, похоже, у него нет изображения. Каждый создаваемый файл имеет размер 167 КБ, и я не могу просмотреть их с помощью графических программ просмотра (например, XnViewMP).

Когда я загружаю созданный файл в PE Studio, он говорит, что подпись MZ отсутствует (я не уверен, что это что-то значит).

Я пробовал это с файлом .ico на моем локальном веб-сервере, и у меня та же проблема.

Вот код, который я использую чтобы загрузить файл изображения. 

Public Function DownloadFile(whaturl As String, whatdestination As String) As Boolean

    Dim newfilepath
    Dim success As Boolean

    Dim WinHttpReq: Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
    WinHttpReq.Open "GET", whaturl, False
    WinHttpReq.Send

     If WinHttpReq.Status = 200 Then
        Dim oStream: Set oStream = CreateObject("ADODB.Stream")
        oStream.type = 1    '1 is binary
        oStream.Open
        oStream.Write WinHttpReq.ResponseBody

        oStream.SaveToFile whatdestination, 2 ' 1 = no overwrite, 2 = overwrite
        oStream.Close
        success = True
    Else
        success = False
    End If

    DownloadFile = success

End Function

Может быть, кто-то может сказать мне, почему этот код кажется не удается загрузить файл PNG? Я тоже пробовал с файлом .ico, и у меня такая же проблема. Может быть, кто-то может помочь мне с этим кодом?

1 Ответ

1 голос
/ 10 января 2020

Вы делаете это слишком сложно. Используйте функцию, подобную этой: 

Option Compare Database
Option Explicit

' API declarations.
'
Private Declare Function URLDownloadToFile Lib "Urlmon" Alias "URLDownloadToFileA" ( _
    ByVal pCaller As Long, _
    ByVal szURL As String, _
    ByVal szFileName As String, _
    ByVal dwReserved As Long, _
    ByVal lpfnCB As Long) _
    As Long

' Download a file or a page with public access from the web. 
' Returns 0 if success, error code if not. 
' 
' If parameter NoOverwrite is True, no download will be attempted 
' if an existing local file exists, thus this will not be overwritten. 
' 
' Examples: 
' 
' Download a file: 
'   Url = "https://www.codeproject.com/script/Membership/ProfileImages/%7Ba82bcf77-ba9f-4ec3-bbb3-1d9ce15cae23%7D.jpg" 
'   FileName = "C:\Test\CodeProjectProfile.jpg" 
'   Result = DownloadFile(Url, FileName) 
' 
' Download a page: 
'   Url = "https://www.codeproject.com/Tips/1022704/Rounding-Values-Up-Down-By-Or-To-Significant-Figur?display=Print" 
'   FileName = "C:\Test\CodeProject1022704.html" 
'   Result = DownloadFile(Url, FileName) 
' 
' Error codes: 
' -2146697210   "file not found". 
' -2146697211   "domain not found". 
' -1            "local file could not be created." 
' 
' 2004-12-17. Gustav Brock, Cactus Data ApS, CPH. 
' 2017-05-25. Gustav Brock, Cactus Data ApS, CPH. Added check for local file. 
' 2017-06-05. Gustav Brock, Cactus Data ApS, CPH. Added option to no overwrite the local file. 
' 
Public Function DownloadFile( _ 
    ByVal Url As String, _ 
    ByVal LocalFileName As String, _ 
    Optional ByVal NoOverwrite As Boolean) _ 
    As Long 

    Const BindFDefault  As Long = 0 
    Const ErrorNone     As Long = 0 
    Const ErrorNotFound As Long = -1

    Dim Result  As Long

    If NoOverwrite = True Then 
        ' Page or file should not be overwritten. 
        ' Check that the local file exists. 
        If Dir(LocalFileName, vbNormal) <> "" Then 
            ' File exists. Don't proceed. 
            Exit Function 
        End If 
    End If     

    ' Download file or page. 
    ' Return success or error code. 
    Result = URLDownloadToFile(0, Url & vbNullChar, LocalFileName & vbNullChar, BindFDefault, 0)   

    If Result = ErrorNone Then 
        ' Page or file was retrieved. 
        ' Check that the local file exists. 
        If Dir(LocalFileName, vbNormal) = "" Then 
            Result = ErrorNotFound 
        End If 
    End If   

    DownloadFile = Result 

End Function

взято из моей статьи: Показывать картинки прямо с URL-адресов в формах и отчетах Access

(Если у вас нет учетную запись, перейдите по ссылке: Прочитать статью полностью)

Полный код также на GitHub : VBA.PictureUrl

...