求 URLOpenStream 的用法

URLOpenStream
HRESULT URLOpenStream(
    LPUNKNOWN pCaller,
    LPCWSTR szURL,
    DWORD dwReserved,
    LPBINDSTATUSCALLBACK lpfnCB
);URLOpenStream creates a push-type stream object from a URL. The data is downloaded from the Internet as fast as possible. When data is available, it is "pushed" at the client through a notification callback. pCaller
Pointer to the controlling IUnknown of the calling ActiveX component (if the caller is an ActiveX component). If the caller is not an ActiveX component, this value may be set to NULL. Otherwise, the caller is a COM object that is contained in another component (such as an ActiveX Control within the context of an HTML page). This parameter represents the outermost IUnknown of the calling component. The function will attempt the download within the context of the ActiveX client framework and allow the caller's container to receive callbacks on the progress of the download.
szURL
The URL to be converted to a stream object. Cannot be NULL.
dwReserved
Reserved for future use. Must be zero.
lpfnCB
Pointer to the caller's IBindStatusCallback interface, on which URLOpenStream calls OnDataAvailable when data arrives from the Internet. OnDataAvailable can return E_ABORT to abort the download. When the callback is invoked and the pstm member of the STGMEDIUM structure is not NULL, the caller can read from the stream the amount of data specified in the dwSize argument passed with the OnDataAvailable call. If the caller does not read the full amount or does not call pstm Read at all, OnDataAvailable will still be called the next time data arrives if the grfBSCF flags do not indicate BINDF_LASTDATANOTIFICATION. In that case, no more data will be downloaded. Any data that is not read at any given time will still be available the next time OnDataAvailable is called.
The logic in the following code fragment is a typical implementation of OnDataAvailable as it is used by the URLOpenStream function:
HRESULT MyBindStatusCallback::OnDataAvailable (DWORD grfBSCF,
    DWORD dwSize, ..., STGMEDIUM * pstgmed)
{    if( dwSize &lt  sizeof(BITMAPINFOHEADER) )
        return(NOERROR);  // not enough has been read yet, just return    if( !g_bGotInfoHeader ) {   // did we get info before?
        // No, go ahead, read now...        DWORD dwRead;
        HRESULT hr = pstgmed->pstm->Read( &bmih, sizeof(bmih), &dwRead);
        if( SUCCEEDED(hr) ) {
            // now we got it... we can return
            g_bGotInfoHeader = TRUE;
            return(hr);
        }
    }
}

This class allows to download files from internet asynchronously using the following APIs: URLOpenStream, URLOpenBlockingStream, URLDownloadToFile and URLDownloadToCacheFile. It also allow downloading from secure sites using HTTPS and autentication.The class has the following members:Methods:AbortDownload method: Aborts the current download.
Download: starts the download.
Properties:Data: Returns the downloaded data if it was downloaded to a byte array.
Downloading: Returns wheter the class is already downloading a file.
ParentWindow: Sets the parent window for error and other dialogs. By default the desktop window is used. --------------------------------------------------------------------------------
Option Explicit' Implement IBindStatusCallback to receive
' the data and progress notification
Implements IBindStatusCallback' Implement IAuthenticate to
' query for user name and password
Implements IAuthenticate' Implement IHttpNegotiate to send and
' receive HTTP headers
Implements IHttpNegotiate' Implement IWindowForBindingUI to
' allow error messages to be shown
Implements IWindowForBindingUI' ==== Enums ====
Enum adlFlags
   adlAsynchronous = BINDF_ASYNCHRONOUS
   adlOffLine = BINDF_OFFLINEOPERATION
   adlFromCacheIfAvailable = BINDF_FWD_BACK
   adlFromCacheIfNetFail = BINDF_GETFROMCACHE_IF_NET_FAIL
   adlGetNewest = BINDF_GETNEWESTVERSION
   adlResync = BINDF_RESYNCHRONIZE
   adlNoWriteCache = BINDF_NOWRITECACHE
   adlWriteCache = BINDF_NEEDFILE
   adlIgnoreSecurityProblem = BINDF_IGNORESECURITYPROBLEM ' UNSAFE
   adlFormsSubmit = BINDF_FORMS_SUBMIT
   adlDefaultProtocolHandler = BINDF_PREFERDEFAULTHANDLER
End EnumEnum adlDownloadType
   adlByteArray      ' Returns the URL data in a byte array
   adlFile           ' Saves the URL to a file
   adlStream         ' Returns an IStream object (download is synchronous)
   adlCache          ' Downloads the file to the IE cache
   adlGetObject      ' Downloads the file and instanties an object
                     ' using the registered mime type
End EnumEnum adlErrors
   adlErrDownloading = vbObjectError
End EnumEnum adlQI
   adlMimeVersion = HTTP_QUERY_MIME_VERSION
   adlContentType = HTTP_QUERY_CONTENT_TYPE
   adlContentTransferEncoding = HTTP_QUERY_CONTENT_TRANSFER_ENCODING
   adlContentID = HTTP_QUERY_CONTENT_ID
   adlContentLength = HTTP_QUERY_CONTENT_LENGTH
   adlContentLanguage = HTTP_QUERY_CONTENT_LANGUAGE
   adlAllow = HTTP_QUERY_ALLOW
   adlPublic = HTTP_QUERY_PUBLIC
   adlData = HTTP_QUERY_DATE
   adlExpires = HTTP_QUERY_EXPIRES
   adlLastModified = HTTP_QUERY_LAST_MODIFIED
   adlURI = HTTP_QUERY_URI
   adlPragma = HTTP_QUERY_PRAGMA
   adlVersion = HTTP_QUERY_VERSION
   adlStatusCode = HTTP_QUERY_STATUS_CODE
   adlStatusText = HTTP_QUERY_STATUS_TEXT
   adlRawHeaders = HTTP_QUERY_RAW_HEADERS
   adlRawHeadersCRLF = HTTP_QUERY_RAW_HEADERS_CRLF
   adlConnection = HTTP_QUERY_CONNECTION
   adlAccept = HTTP_QUERY_ACCEPT
   adlAcceptCharset = HTTP_QUERY_ACCEPT_CHARSET
   adlAcceptEncoding = HTTP_QUERY_ACCEPT_ENCODING
   adlAcceptLanguage = HTTP_QUERY_ACCEPT_LANGUAGE
   adlAuthorization = HTTP_QUERY_AUTHORIZATION
   adlContentEncoding = HTTP_QUERY_CONTENT_ENCODING
   adlFrom = HTTP_QUERY_FROM
   adlIfModifiedSince = HTTP_QUERY_IF_MODIFIED_SINCE
   adlLocation = HTTP_QUERY_LOCATION
   adlReferer = HTTP_QUERY_REFERER
   adlRetryAfter = HTTP_QUERY_RETRY_AFTER
   adlServer = HTTP_QUERY_SERVER
   adlUserAgent = HTTP_QUERY_USER_AGENT
   adlWWWAuthenticate = HTTP_QUERY_WWW_AUTHENTICATE
   adlProxyAuthenticate = HTTP_QUERY_PROXY_AUTHENTICATE
   adlAcceptRanges = HTTP_QUERY_ACCEPT_RANGES
   adlSetCookie = HTTP_QUERY_SET_COOKIE
   adlCookie = HTTP_QUERY_COOKIE
   adlRequestMethod = HTTP_QUERY_REQUEST_METHOD
   adlAge = HTTP_QUERY_AGE
   adlCacheControl = HTTP_QUERY_CACHE_CONTROL
   adlContentBase = HTTP_QUERY_CONTENT_BASE
   adlContentLocation = HTTP_QUERY_CONTENT_LOCATION
   adlContentMD5 = HTTP_QUERY_CONTENT_MD5
   adlContentRange = HTTP_QUERY_CONTENT_RANGE
   adlETag = HTTP_QUERY_ETAG
   adlHost = HTTP_QUERY_HOST
   adlIfMatch = HTTP_QUERY_IF_MATCH
   adlIfNoneMatch = HTTP_QUERY_IF_NONE_MATCH
   adlIfRange = HTTP_QUERY_IF_RANGE
   adlIfUnmodifiedSince = HTTP_QUERY_IF_UNMODIFIED_SINCE
   adlMaxForwards = HTTP_QUERY_MAX_FORWARDS
   adlProxyAuthorization = HTTP_QUERY_PROXY_AUTHORIZATION
   adlRange = HTTP_QUERY_RANGE
   adlTransferEncoding = HTTP_QUERY_TRANSFER_ENCODING
   adlUpgrade = HTTP_QUERY_UPGRADE
   adlVary = HTTP_QUERY_VARY
   adlVia = HTTP_QUERY_VIA
   adlWarning = HTTP_QUERY_WARNING
   adlExpect = HTTP_QUERY_EXPECT
   adlProxyConnection = HTTP_QUERY_PROXY_CONNECTION
   adlUnlessModifiedSince = HTTP_QUERY_UNLESS_MODIFIED_SINCE
   adlProxySupport = HTTP_QUERY_PROXY_SUPPORT
   adlAuthenticationInfo = HTTP_QUERY_AUTHENTICATION_INFO
   adlPassportURLs = HTTP_QUERY_PASSPORT_URLS
   adlPassportConfig = HTTP_QUERY_PASSPORT_CONFIG
End Enum' ==== Private members ====
Private m_oBinding As IBinding
Private m_abData() As Byte
Private m_bFirstTime As Boolean
Private m_bSync As Boolean
Private m_oMk As IMoniker
Private m_oBC As IBindCtx
Private m_sHeaders As String
Private m_sPostData As String
Private m_sMethod As String
Private m_lMsgWnd As Long' ==== Public members ====
Public Flags As adlFlags' ==== Events ====' StartingDownload. Raised when the download starts.
Event StartingDownload()' DownloadComplete. Raised when the download is complete.
Event DownloadComplete(ByVal ErrNum As Long)' Progress. Raised to notify download progress.
Event Progress(ByVal Percent As Long, _
               ByVal Status As BINDSTATUS, _
               ByVal StatusString As String)' DataAvailable. Raised when there's data available.
Event DataAvailable(ByVal Data As Variant)' ObjectAvailable. Raised when the download type is adlGetObject and
' the object is instantiated.
Event ObjectAvailable(ByVal Object As Object)' Authenticate. Raised by IAuthenticate interface when
' username and password is required to access the URL
Event Authenticate(User As String, Password As String)' HTTPResponse. Raised by IHttpNegotiate interface.
Event HTTPResponse(ByVal Response As Long, ByVal Headers As String)' ==== APIs ====
Private Declare Function GlobalAlloc Lib "kernel32" ( _
   ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" ( _
   ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" ( _
   ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" ( _
   ByVal hMem As Long) As LongPrivate Const GMEM_MOVEABLE = &H2
Private Const GMEM_ZEROINIT = &H40
Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)Private Declare Function GetDesktopWindow Lib "user32" () As LongPublic Property Get Downloading() As Boolean   Downloading = Not m_oBinding Is Nothing

End Property'
' ParentWindow
'
' Parent window handle for dialogs
'
Public Property Let ParentWindow(ByVal Value As Long)
   m_lMsgWnd = Value
End Property'
' ParentWindow
'
' Parent window handle for dialogs
'
Public Property Get ParentWindow() As Long
   ParentWindow = m_lMsgWnd
End Property

'续
'
' pvStr2Ptr
'
' Allocates a string using CoTaskMemAlloc
'
Private Function pvStr2Ptr(ByVal Str As String) As Long   pvStr2Ptr = CoTaskMemAlloc(LenB(Str) + 2)   ' Copy the string
   MoveMemory ByVal pvStr2Ptr, _
              ByVal StrPtr(Str), _
              LenB(Str) + 2End Function'
' AbortDownload
'
' Aborts the current download
'
Sub AbortDownload()   If Not m_oBinding Is Nothing Then
      m_oBinding.Abort
   End IfEnd Sub'
' Data
'
' Returns the downloaded data in a byte array
'
Public Property Get Data() As Variant   Data = m_abDataEnd Property'
' Download
'
' Downloads a file
'
' Parameters:
'
' URL: The file URL
' DownloadType: type of download
' FileName: Name of the destination file for adlFile download type
'
Function Download( _
   ByVal URL As String, _
   Optional ByVal DownloadType As adlDownloadType, _
   Optional ByVal FileName As String, _
   Optional ByVal Method As String = "GET", _
   Optional ByVal OptionalHeader As String, _
   Optional ByVal PostData As String) As Variant   If Not m_oBinding Is Nothing Then Err.Raise adlErrDownloading, _
         "AsyncDownload", _
         "A download operation is still running. Cannot start a new one."   m_bSync = False   ' Store the post data
   m_sPostData = StrConv(PostData, vbFromUnicode)
   If LenB(m_sPostData) > 0 And _
      InStr(1, OptionalHeader, "Content-Type:", vbTextCompare) = 0 Then
      OptionalHeader = "Content-Type: application/x-www-form-urlencoded" & _
                       vbCrLf & OptionalHeader
   End If

   ' Store the header
   m_sHeaders = OptionalHeader
   If Right$(m_sHeaders, 2) <> vbCrLf Then m_sHeaders = m_sHeaders & vbCrLf   ' Store the method
   m_sMethod = UCase$(Method)
   If Len(m_sMethod) = 0 Then m_sMethod = "GET"   Select Case DownloadType      Case adlByteArray         ' Erase the previous data
         Erase m_abData         ' Set the flags
         m_bFirstTime = True         ' Star the download
         URLOpenStreamW Me, URL, 0, Me      Case adlStream         Static oStream As IUnknown         m_bSync = True         ' Download to the stream
         URLOpenBlockingStreamW Me, URL, oStream, 0, Me         Set Download = oStream      Case adlFile         ' Start downloading
         URLDownloadToFileW Me, URL, FileName, 0, Me      Case adlCache         Dim sCachedFile  As String         sCachedFile = Space$(260)         ' Start downloading
         URLDownloadToCacheFileW Me, URL, StrPtr(sCachedFile), 260, 0, Me         ' Return the name of the file
         ' in the IE cache
         Download = Trim$(sCachedFile)      Case adlGetObject         Dim IID_Unk As UUID         m_bSync = True         ' Create a asynchronous bind context
         Set m_oBC = CreateAsyncBindCtx(0, Me, Nothing)         ' Create a URL moniker
         Set m_oMk = CreateURLMoniker(Nothing, URL)         ' Initialize the IID for IUnknown
         IID_Unk.Data4(0) = &HC0
         IID_Unk.Data4(7) = &H46         ' Start the download to
         ' get the object
         m_oMk.BindToObject m_oBC, Nothing, IID_Unk, Nothing   End SelectEnd Function

'续
' pvStreamFromPtr
'
' Returns a strong reference to IStream from a pointer
'
Private Function pvStreamFromPtr(ByVal Ptr As Long) As IStream
Dim oStrm As IStream   MoveMemory oStrm, Ptr, 4&
   Set pvStreamFromPtr = oStrm
   MoveMemory oStrm, 0&, 4&End FunctionPublic Function QueryInfo(ByVal Info As adlQI) As String
Dim oHTTPInfo As IWinInetHttpInfo
Dim abData() As Byte
Dim lLen As Long, lFlags As Long
Dim lData As Long   If m_oBinding Is Nothing Then Exit Function   On Error Resume Next

   Set oHTTPInfo = m_oBinding   If Err.Number = 0 Then

      ' Get info length
      oHTTPInfo.QueryInfo Info, ByVal 0&, lLen, lFlags, 0&

      If lLen Then

         ReDim abData(0 To lLen - 1)

         oHTTPInfo.QueryInfo Info, abData(0), lLen, lFlags, 0&

         QueryInfo = StrConv(abData, vbUnicode)

      End If

   End If

End FunctionPrivate Sub Class_Initialize()   ' Initialize the flags
   Flags = adlAsynchronous Or adlGetNewest Or adlResync

   ' Initialize the parent window
   ' for error and message windows
   ' to the desktop
   m_lMsgWnd = GetDesktopWindow()

End SubPrivate Sub Class_Terminate()   ' Reset the UA
   UrlMkSetSessionOption URLMON_OPTION_USERAGENT_REFRESH, ByVal 0&, 0, 0End SubPrivate Sub IAuthenticate_Authenticate( _
   phwnd As Long, _
   pszUsername As Long, _
   pszPassword As Long)Dim sUser As String
Dim sPassword As String   ' Raise the event
   RaiseEvent Authenticate(sUser, sPassword)   ' Allocate memory
   pszUsername = pvStr2Ptr(sUser)
   pszPassword = pvStr2Ptr(sPassword)End SubPrivate Sub IBindStatusCallback_GetBindInfo( _
   grfBINDF As olelib.BINDF, _
   pbindinfo As olelib.BINDINFO)Dim lPtr As Long   ' Set the flags
   grfBINDF = Flags And Not (-BINDF_ASYNCHRONOUS * m_bSync)   With pbindinfo      ' Set the verb
      .dwBindVerb = BINDVERB_CUSTOM
      .szCustomVerb = pvStr2Ptr(m_sMethod)      If Len(m_sPostData) > 0 Then         ' Set the data length
         .cbstgmedData = LenB(m_sPostData)         ' Set the data type
         .stgmedData.TYMED = TYMED_HGLOBAL         ' Allocate global memory for the data
         .stgmedData.Data = GlobalAlloc(GHND, LenB(m_sPostData))         ' Get a pointer to the data
         lPtr = GlobalLock(.stgmedData.Data)         ' Copy the data to global memory
         MoveMemory ByVal lPtr, ByVal StrPtr(m_sPostData), LenB(m_sPostData)         ' Release the pointer
         GlobalUnlock .stgmedData.Data      End If   End WithEnd SubPrivate Function IBindStatusCallback_GetPriority() As LongEnd FunctionPrivate Sub IBindStatusCallback_OnDataAvailable( _
   ByVal grfBSCF As olelib.BSCF, _
   ByVal dwSize As Long, _
   pformatetc As olelib.FORMATETC, _
   pstgmed As olelib.STGMEDIUM)Dim oStream As olelib.IStream
Dim tSTATSTG As olelib.STATSTG
Dim abData() As Byte
Dim lUbound As Long   ' Get the stream object
   Set oStream = pvStreamFromPtr(pstgmed.Data)   ' Get the stream info
   oStream.Stat tSTATSTG, STATFLAG_NONAME   If tSTATSTG.cbSize > 0 Then      ' Allocate the array
      ReDim abData(1 To tSTATSTG.cbSize * 10000)      ' Read the data
      oStream.Read abData(1), tSTATSTG.cbSize * 10000      If m_bFirstTime Then         ReDim m_abData(1 To tSTATSTG.cbSize * 10000)         m_bFirstTime = False      Else         ' Get the upper bound
         lUbound = UBound(m_abData)         ' Allocate the array
         ReDim Preserve m_abData(1 To lUbound + tSTATSTG.cbSize * 10000)      End If      ' Copy the data to the array
      MoveMemory m_abData(lUbound + 1), abData(1), tSTATSTG.cbSize * 10000      RaiseEvent DataAvailable(abData)   End IfEnd SubPrivate Sub IBindStatusCallback_OnLowResource( _
   ByVal reserved As Long)
   ' Not used
End SubPrivate Sub IBindStatusCallback_OnObjectAvailable( _
   riid As olelib.UUID, _
   ByVal punk As stdole.IUnknown)   ' Send the object
   RaiseEvent ObjectAvailable(punk)End SubPrivate Sub IBindStatusCallback_OnProgress( _
   ByVal ulProgress As Long, _
   ByVal ulProgressMax As Long, _
   ByVal ulStatusCode As olelib.BINDSTATUS, _
   ByVal szStatusText As Long)Dim lPercent As Long   If ulProgressMax <> 0 Then
      lPercent = ulProgress * 100 / ulProgressMax
   End If   RaiseEvent Progress(lPercent, ulStatusCode, SysAllocString(szStatusText))   DoEventsEnd SubPrivate Sub IBindStatusCallback_OnStartBinding( _
   ByVal dwReserved As Long, _
   ByVal pib As olelib.IBinding)

   ' Save the IBinding reference
   Set m_oBinding = pib   RaiseEvent StartingDownloadEnd SubPrivate Sub IBindStatusCallback_OnStopBinding( _
   ByVal hresult As Long, ByVal szError As Long)   RaiseEvent DownloadComplete(hresult)   ' Release the IBinding reference
   Set m_oBinding = NothingEnd SubPrivate Sub IHttpNegotiate_BeginningTransaction( _
   ByVal szURL As Long, _
   ByVal szHeaders As Long, _
   ByVal dwReserved As Long, _
   pszAdditionalHeaders As Long)   ' Allocate memory for the
   ' additional headers
   pszAdditionalHeaders = pvStr2Ptr(m_sHeaders)End SubPrivate Sub IHttpNegotiate_OnResponse( _
   ByVal dwResponseCode As Long, _
   ByVal szResponseHeaders As Long, _
   ByVal szRequestHeaders As Long, _
   pszAdditionalRequestHeaders As Long)

   ' Raise the event
   RaiseEvent HTTPResponse(dwResponseCode, SysAllocString(szResponseHeaders))End SubPrivate Function IWindowForBindingUI_GetWindow( _
   rguidReason As olelib.UUID) As Long   IWindowForBindingUI_GetWindow = m_lMsgWndEnd Function

http://www.mvps.org/emorcillo/cod/inet/adl.htm

调试易

求 URLOpenStream 的用法

解决方案 »