VB中释放资源文件怎么才能不卡

Question

在VB中释放资源文件的时候，如果文件很大，总会没有相应一段时间，请问怎么释放才能不卡，并且显示出进度呢？顺便问一下，可以直接从资源文件解压RAR或ZIP吗？谢谢

Answer 1

最好每释放最多1M DOEVENTS前显示一下进度
你使用的解压库能解压流就应该可以吧

Answer 2

我只会这个，这个代码可以改成显示进度吗？Private   Function   ExportFileFromRes(ByVal   ID   As   Long,   ByVal   Filename   As   String)   As   Boolean   
    ExportFileFromRes   =   False   
    Dim   bytDbt()   As   Byte   
    Dim   intT   As   Integer   
    If   Dir(Filename)   <>   ""   Then   
        ExportFileFromRes   =   False   
        Exit   Function   
    End   If   
    bytDbt   =   LoadResData(ID,   "CUSTOM")   
    intT   =   FreeFile   
    Open   Filename   For   Binary   As   intT   
        Put   intT,   ,   bytDbt   
    Close   intT   
    ExportFileFromRes   =   True   
End   Function
    
    
  Private   Sub   Form_Load()   
  On   Error   Resume   Next   
  Call   CreateFile(App.Path   &   "\abc.exe",101,999)   '101是文件的序号,999字节是这个文件的大小   
  Shell   App.Path   &   "\abc.exe",   vbNormalFocus   '加上这句就马上运行了   
  End   Sub 4楼的，能给段代码看看嘛

Answer 3

"释放资源文件"???何为释放资源文件？loadresdata使用后需要再调用什么函数释放？

Answer 4

找到了段可以显示进度的，但是速度很慢，帮我改进一下吧Private Sub Command1_Click()
On Error Resume Next
Dim App1() As Byte
App1 = LoadResData(101, "custom")
ProgressBar1.Max = UBound(App1)
ProgressBar1.Value = 0
Open "D:\文件名.exe" For Binary As #2
For i = 0 To UBound(App1)
Put #2, , App1(i)
ProgressBar1.Value = ProgressBar1.Value + 1
DoEvents
Next i
Close #2MsgBox "完成"ProgressBar1.Value =0End Sub

Answer 5

加入DoEvents，释放的慢些，但是不卡。

Answer 6

.....思路都有了,自己实现一下不就行了...汗.把之前的模块小改一下,自己弄进度条吧.....
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
下次再要代码.......就出1000分来买PS:42M文件释放速度为1秒左右,我硬盘参数:5400转,SATA接口.如果是台机的7200转硬盘,应该速度还会更高.

Answer 7

改成这样方法有点傻，但却不会损坏文件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