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

.Net 专栏收录该内容
44 篇文章 0 订阅

'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

  • 0
    点赞
  • 0
    评论
  • 0
    收藏
  • 一键三连
    一键三连
  • 扫一扫,分享海报

打赏
文章很值,打赏犒劳作者一下
相关推荐
©️2020 CSDN 皮肤主题: 大白 设计师:CSDN官方博客 返回首页

打赏

playyuer

你的鼓励将是我创作的最大动力

¥2 ¥4 ¥6 ¥10 ¥20
输入1-500的整数
余额支付 (余额:-- )
扫码支付
扫码支付:¥2
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、C币套餐、付费专栏及课程。

余额充值