分割文件并进行Base64编码

清华大佬耗费三个月吐血整理的几百G的资源,免费分享!....>>>

Option Explicit

Function IIF(judgement, a, b)
  If judgement Then
    IIF = a
  Else
    IIF = b
  End If
End Function

Function Base64Bytes()
    Dim xmldom, node
	Set xmldom = CreateObject("Microsoft.XMLDOM")
	Set node = xmldom.CreateElement("binary")
	node.DataType = "bin.base64"
	e.NodeTypedValue = Buf
	Base64Bytes = node.Text
	Set node = Nothing
	Set xmldom = Nothing
End Function

Function WriteBase64File(Filename, Words, Overwrite)
    Dim Base64File
	Set Base64File = objFSO.CreateTextFile(Filename, Overwrite)
	Base64File.Write CStr(Words)
	Base64File.Close
	Set Base64File = Nothing
End Function

Sub SplitFileBase64(SourceFile, DestinationFile, ChunkSize)
    Const BufferSize = 1024
	With CreateObject("ADODB.Stream")
	    .Mode = 3:.Type = 1:.Open:.LoadFromFile SourceFile
		Dim lFileSize
		lFileSize = .Size
		Dim i
		i = 1
		Do While lFileSize >= ChunkSize * BufferSize
		    Buf = Read(ChunkSize * BufferSize)
			WriteBase64File DestinationFile & "." & CStr(i) & ".b64.txt", Base64Bytes, objFSO.FileExists(DestinationFile & "." & CStr(i) & ".b64.txt")
			lFileSize = lFileSize - ChunkSize * BufferSize
			i = i + 1
		Loop
		If lFileSize >0 Then
		    Buf = .Read(lFileSize)
			WriteBase64File DestinationFile & "." & CStr(i) & ".b64.txt", Base64Bytes, objFSO.FileExists(DestinationFile & "." & CStr(i) & ".b64.txt")
		End If
		.Close
	End With
	MsgBox "Finished!"
End Sub

Dim objFSO, Buf
Set objFSO = CreateObject("Scripting.FileSystemObject")
SplitFileBase64 "D:\test.rar", "D:\test", 512
Set objFSO = Nothing