.....思路都有了,自己實現一下不就行了...汗.
把之前的模塊小改一下,自己弄進度條吧.....
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