用户登录  |  用户注册
首 页源码下载网络学院最新源码源码排行屏蔽广告
当前位置:新兴网络 > 网络学院 > 编程开发 > Visual Basic

VB 快速加载文件到流对象

减小字体 增大字体 作者:魏滔序  来源:本站整理  发布时间:2011-01-03 12:21:57
以下代码需引用olelib.tlb (下载 )
VBScript code复制代码
' 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
  • 好的评价 如果您觉得此文章好,就请您
      0%(0)
  • 差的评价 如果您觉得此文章差,就请您
      0%(0)

网络学院评论评论内容只代表网友观点,与本站立场无关!

   评论摘要(共 0 条,得分 0 分,平均 0 分) 查看完整评论