將自定義資源中的文件釋放出來(大文件)

 

.....思路都有了,自己實現一下不就行了...汗.

把之前的模塊小改一下,自己弄進度條吧.....

VB code

Option Explicit
'*************************************************************************
'**模 塊 名:GetResFile
'**說    明:將自定義資源中的文件釋放出來
'**創 建 人:嗷嗷叫的老馬
'**描    述:紫水晶工作室 http://www.m5home.com
'**日    期:2007年5月24日
'**版    本:V3.0
'*************************************************************************

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
     ByVal Destination As Long, _
     ByVal Source As Long, _
     ByVal Length As Long)

Public Function GetResFile(ByVal ResID As Long, ByVal FileName As String) As Boolean
    Dim bFile() As Byte, lFileLen As Double, bTmp() As Byte
    Dim I As Long
    Const lBlockLen As Long = 1048576           '默認一次1M長度
   
    GetResFile = False
   
    bFile = LoadResData(ResID, "CUSTOM")    '將自定義資源中資源讀入數組
    lFileLen = UBound(bFile) + 1            '自定義資源的字節數
   
    If Dir(FileName) = "" Then              '只有文件不存在時,才釋放
        Open FileName For Binary As #1
            Do
                If I + lBlockLen < lFileLen Then
                    ReDim bTmp(lBlockLen - 1)
                    Call CopyMemory(VarPtr(bTmp(0)), VarPtr(bFile(I)), lBlockLen)
                    I = I + lBlockLen
                    Put #1, , bTmp()
                Else
                    ReDim bTmp(UBound(bFile) - I - 1)
                    Call CopyMemory(VarPtr(bTmp(0)), VarPtr(bFile(I)), lFileLen - 1 - I)
                    Put #1, , bTmp()
                End If
                Debug.Print (Seek(1) / lFileLen#) * 100# & "%"      '輸出進度
                DoEvents
            Loop While Seek(1) < lFileLen
        Close #1
        GetResFile = True
    End If
End Function

 

 

 

 

________________________________________________________________________________________________

改成這樣方法有點傻,但卻不會損壞文件
VB code

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
     ByVal Destination As Long, _
     ByVal Source As Long, _
     ByVal Length As Long)

Private Function GetResFile(ByVal ResID As Long, ByVal FileName As String) As Boolean
    Dim bFile() As Byte, lFileLen As Double, bTmp() As Byte
    Dim I As Long
    Const lBlockLen As Long = 1048576          '默認一次1M長度
   
    GetResFile = False
   
    bFile = LoadResData(ResID, "CUSTOM")    '將自定義資源中資源讀入數組
    lFileLen = UBound(bFile)            '自定義資源的字節數
   
        Open FileName For Binary As #1
            Do
                If I + lBlockLen < lFileLen Then
                    ReDim bTmp(lBlockLen)
                    Call CopyMemory(VarPtr(bTmp(0)), VarPtr(bFile(I)), lBlockLen)
                    I = I + lBlockLen
                    Put #1, , bTmp()
                Else
                    ReDim bTmp(UBound(bFile) - I - 1)
                    Call CopyMemory(VarPtr(bTmp(0)), VarPtr(bFile(I)), lFileLen - 1 - I)
                    Put #1, , bTmp()
                End If
                ProgressBar1.Value = Format((Seek(1) / lFileLen) * 100, 0#)     '輸出進度
                DoEvents
            Loop While Seek(1) < lFileLen
        Close #1
        I = 0
        Open FileName For Binary As #1
            Do
                If I + lBlockLen < lFileLen Then
                    ReDim bTmp(lBlockLen - 1)
                    Call CopyMemory(VarPtr(bTmp(0)), VarPtr(bFile(I)), lBlockLen)
                    I = I + lBlockLen
                    Put #1, , bTmp()
                Else
                    ReDim bTmp(UBound(bFile) - I - 1)
                    Call CopyMemory(VarPtr(bTmp(0)), VarPtr(bFile(I)), lFileLen - 1 - I)
                    Put #1, , bTmp()
                End If
                ProgressBar1.Value = Format((Seek(1) / lFileLen) * 100, 0#)     '輸出進度
                DoEvents
            Loop While Seek(1) < lFileLen
        Close #1
        GetResFile = True
End Function
 

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章