好不容易在网上搜到一段代码,分割功能很正常,
但是合并出来的文件却是错误的,
如将一个文件test.txt分割,里面内容如下
1
2
3
4
5
6
执行分割后生成两个对半文件
1_test.txt
1
2
3
2_test.txt
4
5
6
可是再执行合并却乱套了,得到文件内容是
1
2
3
1
2
3
不是想要的结果,
用copy /b 1_test.txt + 2_test.txt test.txt却是可以还原了,但我不想用这个命令
望各位高手帮我找下原因
另外我试过用这程序分割图片和程序再用copy /b命令合并都没问题.但下面合并代码哪里错了????
Option Explicit
Private Declare Function SHBrowseForFolder _
Lib "shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList _
Lib "shell32.dll" _
(ByVal pidl As Long, _
pszPath As String) As Long
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlage As Long
lpfn As Long
lparam As Long
iImage As Long
End Type
Private fnum As Integer
Private Function ShowDir(MehWnd As Long, _
DirPath As String, _
Optional Title As String = "请选择文件夹:", _
Optional flage As Long = &H1, _
Optional DirID As Long) As Long
Dim BI As BROWSEINFO
Dim TempID As Long
Dim TempStr As String
TempStr = String$(255, Chr$(0))
With BI
.hOwner = MehWnd
.pidlRoot = 0
.lpszTitle = Title + Chr$(0)
.ulFlage = flage
End With
TempID = SHBrowseForFolder(BI)
DirID = TempID
If SHGetPathFromIDList(ByVal TempID, ByVal TempStr) Then
DirPath = Left$(TempStr, InStr(TempStr, Chr$(0)) - 1)
ShowDir = -1
Else
ShowDir = 0
End If
End Function
Private Function OperateFile(ByVal vFile As String, _
ByVal vSplit As Boolean _
) As Long
Dim ItemSize As Long
Dim FileSize As Long
Dim ReadSize As Long
Dim i As Long
Dim vArr() As Byte
Dim fnum2 As Integer
Dim FileName As String
Dim SplitFiles As Long
If vSplit Then
分割
ItemSize = cmbSplitSize.ItemData(cmbSplitSize.ListIndex)
ItemSize = FileLen(txtSourceFile) / 2
Me.Caption = ItemSize
取得当前选择的分析尺寸.
ReDim vArr(1 To ItemSize) As Byte
重定义缓冲数组.
FileName = Right(vFile, InStr(StrReverse(vFile), "\") - 1)
取得文件名.
fnum = FreeFile()
Open vFile For Binary As fnum
FileSize = LOF(fnum)
取得文件大小
While FileSize > 0
ReadSize = ItemSize
If ReadSize > FileSize Then
如果文件所剩余大小比当前选择的小,就使用剩余大小.
ReadSize = FileSize
ReDim vArr(1 To ReadSize)
End If
Get fnum, i * ItemSize + 1, vArr
i = i + 1
fnum2 = FreeFile()
Open Trim(txtObject.Text) & "\" & Trim(Str(i)) & "_" & FileName For Binary As fnum2
If i = 1 Then Put fnum2, , SplitFiles
Put fnum2, , vArr
Close fnum2
FileSize = FileSize - ReadSize
文件总大小减少.
Wend
Close fnum
MsgBox "分割成功.", vbOKCancel, "提示信息"
Else
合并
Dim FindFile As Boolean
Dim FilePath As String
是否还有后继文件标志
FindFile = True
FileName = Right(vFile, InStr(StrReverse(vFile), "\") - 3)
FilePath = Left(vFile, Len(vFile) - InStr(StrReverse(vFile), "\") + 1)
求原始文件名称
MsgBox FileName & FilePath
fnum = FreeFile()
Open Trim(txtObject.Text) & "\" & FileName For Binary As fnum
While FindFile
fnum2 = FreeFile()
Open vFile For Binary As fnum2
FileSize = LOF(fnum2)
If FileSize > 0 Then
ReDim vArr(1 To FileSize)
Get fnum2, 1, vArr
Put fnum, , vArr
Close fnum2
End If
i = i + 1
vFile = FilePath & Trim(Str(i)) & "_" & FileName
If Dir(Trim(Str(i + 1)) & "_" & FileName) = "" Then FindFile = False
MsgBox vFile
Wend
Close fnum
MsgBox "合并成功.", vbOKOnly, "提示信息"
End If
End Function
Private Sub cmdFind_Click()
Dim TmpPath As String
ShowDir Me.hWnd, TmpPath
If Trim(TmpPath) <> "" Then
txtObject.Text = Trim(TmpPath)
End If
End Sub
Private Sub cmdSelectFile_Click()
If optSplit.Value Then
cdgFindFile.Filter = "全部文件(*.*)|*.*|文本文件(*.txt)|*.txt"
Else
cdgFindFile.Filter = "全部文件(1_*.*)|1_*.*"
End If
cdgFindFile.DialogTitle = "选择要分割的文件"
cdgFindFile.ShowOpen
If Trim(cdgFindFile.FileName) <> "" Then
txtSourceFile.Text = cdgFindFile.FileName
End If
End Sub
Private Sub cmdSplit_Click()
If Trim(txtSourceFile.Text) = "" Then MsgBox "请选择要分割的文件."
OperateFile txtSourceFile.Text, True
End Sub
Private Sub cmdUnit_Click()
OperateFile txtSourceFile.Text, False
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = 6 Then
If Not txtCode.Visible Then
frmMain.Height = 7260
txtCode.Visible = True
Else
frmMain.Height = 3300
txtCode.Visible = False
End If
End If
End Sub
Private Sub Form_Load()
cmbSplitSize.AddItem "1.4M"
cmbSplitSize.ItemData(0) = 1400000
cmbSplitSize.AddItem "1.0M"
cmbSplitSize.ItemData(1) = 1000000
cmbSplitSize.AddItem "0.8M"
cmbSplitSize.ItemData(2) = 800000
cmbSplitSize.AddItem "0.6M"
cmbSplitSize.ItemData(3) = 600000
cmbSplitSize.AddItem "0.3M"
cmbSplitSize.ItemData(4) = 400000
cmbSplitSize.AddItem "0.1M"
cmbSplitSize.ItemData(5) = 100000
cmbSplitSize.ListIndex = 1
End Sub
Private Sub optSplit_Click()
cmdStart.Enabled = True
cmbSplitSize.Enabled = True
cmdUnit.Enabled = False
End Sub
Private Sub optUnit_Click()
cmdStart.Enabled = False
cmbSplitSize.Enabled = False
cmdUnit.Enabled = True
End Sub
vFile = FilePath & Trim(Str(i)) & "_" & FileName
==>
vFile = FilePath & Trim(Str(i + 1)) & "_" & FileName
呵呵,自然是有的了
Option Explicit
#################################################################
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" ( _
ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long _
) As Long
Private Const GENERIC_ALL As Long = &H10000000
Private Const GENERIC_CHAIN_CERTTRUST_FUNCTION As String = "GenericChainCertificateTrust"
Private Const GENERIC_CHAIN_FINALPOLICY_FUNCTION As String = "GenericChainFinalProv"
Private Const GENERIC_EXECUTE As Long = &H20000000
Private Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000
Private Const FILE_SHARE_DELETE As Long = &H4
Private Const FILE_SHARE_READ As Long = &H1
Private Const FILE_SHARE_WRITE As Long = &H2
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Const CREATE_NEW As Long = 1
Private Const CREATE_ALWAYS As Long = 2
Private Const OPEN_EXISTING As Long = 3
Private Const OPEN_ALWAYS As Long = 4
Private Const TRUNCATE_EXISTING As Long = 5
Private Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20
Private Const FILE_ATTRIBUTE_COMPRESSED As Long = &H800
Private Const FILE_ATTRIBUTE_DEVICE As Long = &H40
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
Private Const FILE_ATTRIBUTE_ENCRYPTED As Long = &H4000
Private Const FILE_ATTRIBUTE_HIDDEN As Long = &H2
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const FILE_ATTRIBUTE_NOT_CONTENT_INDEXED As Long = &H2000
Private Const FILE_ATTRIBUTE_OFFLINE As Long = &H1000
Private Const FILE_ATTRIBUTE_READONLY As Long = &H1
Private Const FILE_ATTRIBUTE_REPARSE_POINT As Long = &H400
Private Const FILE_ATTRIBUTE_SPARSE_FILE As Long = &H200
Private Const FILE_ATTRIBUTE_SYSTEM As Long = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY As Long = &H100
###############################################################
Private Declare Function CreateFileMapping Lib "kernel32" Alias "CreateFileMappingA" ( _
ByVal hFile As Long, _
ByVal lpFileMappigAttributes As Long, _
ByVal flProtect As Long, _
ByVal dwMaximumSizeHigh As Long, _
ByVal dwMaximumSizeLow As Long, _
ByVal lpName As String _
) As Long
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const PAGE_READONLY As Long = &H2
Private Const PAGE_READWRITE As Long = &H4
Private Const PAGE_WRITECOPY As Long = &H8
#################################################################
Private Declare Function MapViewOfFile Lib "kernel32" ( _
ByVal hFileMappingObject As Long, _
ByVal dwDesiredAccess As Long, _
ByVal dwFileOffsetHigh As Long, _
ByVal dwFileOffsetLow As Long, _
ByVal dwNumberOfBytesToMap As Long _
) As Long
Private Const SECTION_ALL_ACCESS As Long = STANDARD_RIGHTS_REQUIRED Or SECTION_QUERY Or SECTION_MAP_WRITE Or SECTION_MAP_READ Or SECTION_MAP_EXECUTE Or SECTION_EXTEND_SIZE
Private Const SECTION_MAP_EXECUTE As Long = &H8
Private Const SECTION_MAP_READ As Long = &H4
Private Const SECTION_MAP_WRITE As Long = &H2
Private Const SECTION_QUERY As Long = &H1
Private Const FILE_MAP_ALL_ACCESS As Long = SECTION_ALL_ACCESS
Private Const FILE_MAP_COPY As Long = SECTION_QUERY
Private Const FILE_MAP_READ As Long = SECTION_MAP_READ
Private Const FILE_MAP_WRITE As Long = SECTION_MAP_WRITE
##################################################################
Private Declare Function UnmapViewOfFile Lib "kernel32" (lpBaseAddress As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Sub GetSystemInfo Lib "kernel32" ( _
lpSystemInfo As SYSTEM_INFO)
Private Type SYSTEM_INFO
dwOemID As Long
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOrfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
dwReserved As Long
End Type