快速加载文件到流对象

(声明：魏滔序原创，转贴请注明出处。)

引用olelib.tlb (可以从http://www.mvps.org/emorcillo/download/vb6/tl_ole.zip下载)
' Global Memory Flags
Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_ZEROINIT = &H40
Private Const GENERIC_READ = &H80000000
Private Const FILE_SHARE_READ = &H1
Private Const OPEN_EXISTING = &H3
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const S_OK = &H0
Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type
Private Type OVERLAPPED
    Internal As Long
    InternalHigh As Long
    offset As Long
    OffsetHigh As Long
    hEvent As Long
End Type
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalSize 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 Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Long) As Long    'OVERLAPPED
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long

Sub LoadStreamFromFile(ByVal bstrFileName As String, ByRef pStream As IStream)
    Dim hr As Long
    Dim bReaded As Long
    Dim hFile As Long
    Dim dwFileSize As Long
    Dim dwBytesRead As Long
    Dim hGlobal As Long
    Dim pvData As Long
    Dim sa As SECURITY_ATTRIBUTES
   
    With sa
    .bInheritHandle = 0
    .lpSecurityDescriptor = 0
    .nLength = 0
    End With
   
    On Error Resume Next

    hFile = CreateFile(bstrFileName, GENERIC_READ, FILE_SHARE_READ, sa, OPEN_EXISTING, FILE_ATTRIBUTE_TEMPORARY, 0)

    If (hFile > 0) Then
        dwFileSize = GetFileSize(hFile, 0)
        If (dwFileSize > -1) Then
            hGlobal = GlobalAlloc(GMEM_MOVEABLE, dwFileSize)
        End If
    End If

    If (hGlobal > 0) Then
        pvData = GlobalLock(hGlobal)
        If (pvData > 0) Then
            bReaded = ReadFile(hFile, ByVal pvData, dwFileSize, dwBytesRead, 0&)
            If (bReaded <> 0) Then
                Set pStream = CreateStreamOnHGlobal(hGlobal, True)
                pStream.Seek 0, 0
            End If
            GlobalUnlock (hGlobal)
        End If

        If (hr <> S_OK) Then
            GlobalFree (hGlobal)
            Set pStream = Nothing
        End If
    End If

    If (hFile > 0) Then
        CloseHandle (hFile)
    End If
End Sub