VB文件分割与合并

以下代码由PHP站长网 52php.cn收集自互联网

现在PHP站长网小编把它分享给大家，仅供参考

'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,adSaveCreateNotExist)
End If
If ShowFinishMessage Then
   MsgBox "Finished!"
End If
End Sub

Public Sub StreamRestore(SourceFile As String,Chunks As Long,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,adSaveCreateNotExist)
If ShowFinishMessage Then
   MsgBox "Finished!"
End If
End Sub

'VB 实现大文件的分割与恢复,采用读写二进制数据的传统经典代码:
Public Sub FileSplit(SourceFile As String,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,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
    End If
    Close #FileNumberS
Next i
Close #FileNumberT
If ShowFinishMessage Then
   MsgBox "Finished!"
End If
End Sub

以上内容由PHP站长网【52php.cn】收集整理供大家参考研究

如果以上内容对您有帮助，欢迎收藏、点赞、推荐、分享。

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!