您的位置:首页 > 编程语言 > VB

VB 实现大文件的分割与恢复,引用 ADODB.Stream 提供一个过程

2008-05-19 17:30 811 查看
VB 实现大文件的分割与恢复,引用 ADODB.Stream 提供一个过程: ´要引用 Microsoft ActiveX Data Objects 2.5 Libary ´或 Microsoft ActiveX Data Objects 2.6 Libary Public Sub StreamSplit(SourceFile As String, DestinationFile As String, ChunkSize As Long, Optional BufferSize As Long = 64# * 1024#, Optional ShowFinishMessage As Boolean) ´ChunkSize 为 BufferSize 的倍数 Dim adoStreamS As New ADODB.Stream adoStreamS.Type = adTypeBinary adoStreamS.Open adoStreamS.LoadFromFile SourceFile Dim lFileSize As Long lFileSize = adoStreamS.Size Dim i As Long Dim adoStreamT As New ADODB.Stream adoStreamT.Type = adTypeBinary Do While lFileSize >= ChunkSize * BufferSize adoStreamT.Open adoStreamT.Write adoStreamS.Read(ChunkSize * BufferSize) adoStreamT.SaveToFile DestinationFile & "." & Format(i, "000"), IIf(Len(Trim(Dir(DestinationFile & "." & Format(i, "000")))) > 0, adSaveCreateOverWrite, adSaveCreateNotExist) adoStreamT.Close lFileSize = lFileSize - ChunkSize * BufferSize i = i + 1 Loop If lFileSize > 0 Then adoStreamT.Open adoStreamT.Write adoStreamS.Read(lFileSize) adoStreamT.SaveToFile DestinationFile & "." & Format(i, "000"), IIf(Len(Trim(Dir(DestinationFile & "." & Format(i, "000")))) > 0, adSaveCreateOverWrite, adSaveCreateNotExist) End If If ShowFinishMessage Then MsgBox "Finished!" End If End Sub Public Sub StreamRestore(SourceFile As String, DestinationFile As String, Chunks As Long, Optional BufferSize As Long = 64# * 1024#, Optional ShowFinishMessage As Boolean) Dim lFileSize As Long Dim adoStreamT As New ADODB.Stream adoStreamT.Type = adTypeBinary adoStreamT.Open Dim adoStreamS As New ADODB.Stream adoStreamS.Type = adTypeBinary Dim i As Long For i = 0 To Chunks - 1 ´Chunks 块数 adoStreamS.Open adoStreamS.LoadFromFile SourceFile & "." & Format(i, "000") adoStreamT.Write adoStreamS.Read adoStreamS.Close Next i adoStreamT.SaveToFile DestinationFile, IIf(Len(Trim(Dir(DestinationFile))) > 0, adSaveCreateOverWrite, adSaveCreateNotExist) If ShowFinishMessage Then MsgBox "Finished!" End If End Sub ´VB 实现大文件的分割与恢复,采用读写二进制数据的传统经典代码: Public Sub FileSplit(SourceFile As String, DestinationFile As String, ChunkSize As Long, Optional BufferSize As Long = 64# * 1024#, Optional ShowFinishMessage As Boolean) ´ChunkSize 为 BufferSize 的倍数 Dim FileBuffer() As Byte Dim FileNumberS As Long Dim FileNumberT As Long FileNumberS = FreeFile Open SourceFile For Binary Access Read As #FileNumberS Dim lFileLen As Long lFileLen = FileLen(SourceFile) FileNumberT = FreeFile Dim i As Long Dim j As Long ReDim FileBuffer(1 To (BufferSize)) As Byte Open DestinationFile & "." & Format(i, "000") For Binary Access Write As #FileNumberT Do While lFileLen >= BufferSize Get #FileNumberS, , FileBuffer If i = ChunkSize Then i = 0 j = j + 1 Close #FileNumberT FileNumberT = FreeFile Open DestinationFile & "." & Format(j, "000") For Binary Access Write As #FileNumberT End If i = i + 1 Put #FileNumberT, , FileBuffer lFileLen = lFileLen - BufferSize Loop If lFileLen > 0 Then ReDim FileBuffer(1 To lFileLen) As Byte Get #FileNumberS, , FileBuffer Put #FileNumberT, , FileBuffer End If Close #FileNumberT If ShowFinishMessage Then MsgBox "Finished!" End If End Sub Public Sub FileRestore(SourceFile As String, DestinationFile As String, Chunks As Long, Optional BufferSize As Long = 64# * 1024#, Optional ShowFinishMessage As Boolean) Dim FileBuffer() As Byte Dim FileNumberS As Long Dim FileNumberT As Long Dim i As Long Dim lFileLen As Long FileNumberT = FreeFile Open DestinationFile For Binary Access Write As #FileNumberT For i = 0 To Chunks - 1 FileNumberS = FreeFile Open SourceFile & "." & Format(i, "000") For Binary Access Read As #FileNumberS lFileLen = FileLen(SourceFile & "." & Format(i, "000")) ReDim FileBuffer(1 To BufferSize) As Byte Do While lFileLen >= BufferSize Get #FileNumberS, , FileBuffer Put #FileNumberT, , FileBuffer lFileLen = lFileLen - BufferSize Loop If lFileLen > 0 Then ReDim FileBuffer(1 To lFileLen) As Byte Get #FileNumberS, , FileBuffer Put #FileNumberT, , FileBuffer End If Close #FileNumberS Next i Close #FileNumberT If ShowFinishMessage Then MsgBox "Finished!" End If End Sub
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: 
相关文章推荐