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

王朝vb·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

'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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有 導航