📄 frmsplit.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmSplit
BorderStyle = 1 'Fixed Single
Caption = "文件分割"
ClientHeight = 3870
ClientLeft = 45
ClientTop = 330
ClientWidth = 5415
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3870
ScaleWidth = 5415
StartUpPosition = 3 '窗口缺省
Begin MSComDlg.CommonDialog dlgOpen
Left = 4560
Top = 1320
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Frame fraAssemble
Caption = "合并"
Height = 1695
Left = 120
TabIndex = 6
Top = 2040
Width = 5175
Begin VB.CommandButton cmdSelect
Caption = "选择(&S)..."
Height = 375
Left = 3960
TabIndex = 13
Top = 195
Width = 1095
End
Begin VB.TextBox txtOutputFile
Height = 285
Left = 1080
TabIndex = 10
Top = 720
Width = 3735
End
Begin VB.CommandButton cmdAssemble
Caption = "开始合并（&S）"
Height = 495
Left = 1440
TabIndex = 8
Top = 1080
Width = 1335
End
Begin VB.TextBox txtTemplateName
Height = 285
Left = 1080
Locked = -1 'True
TabIndex = 7
Top = 240
Width = 2415
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "输出文件："
Height = 180
Index = 2
Left = 120
TabIndex = 11
Top = 720
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "模版文件："
Height = 180
Index = 3
Left = 120
TabIndex = 9
Top = 240
Width = 900
End
End
Begin VB.Frame fraSplit
Caption = "分割"
Height = 1815
Left = 120
TabIndex = 0
Top = 120
Width = 5175
Begin VB.CommandButton cmdOpen
Caption = "打开(&O)..."
Height = 375
Left = 3840
TabIndex = 12
Top = 195
Width = 1095
End
Begin VB.TextBox txtFileName
Height = 285
Left = 1080
Locked = -1 'True
TabIndex = 3
Top = 240
Width = 2535
End
Begin VB.CommandButton cmdSplit
Caption = "开始分割（&S）"
Height = 495
Left = 1440
TabIndex = 2
Top = 1200
Width = 1455
End
Begin VB.TextBox txtFileLength
Height = 285
Left = 1080
TabIndex = 1
Text = "512"
Top = 720
Width = 1215
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "分割单位："
Height = 180
Index = 1
Left = 120
TabIndex = 5
Top = 720
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "文件名："
Height = 180
Index = 0
Left = 120
TabIndex = 4
Top = 240
Width = 720
End
End
End
Attribute VB_Name = "frmSplit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'定义访问文件的结构变量
Private Type FileSection
Bytes() As Byte
FileLen As Long
End Type
Private Type SectionedFile
Files() As FileSection
NumberOfFiles As Long
End Type
Private Type FileInfo
OrigProjSize As Long
OrigFileName As String
FileCount As Integer
FileStartNum As Long
End Type
Private Sub cmdOpen_Click()
dlgOpen.Filter = "所有文件(*.*)|*.*"
dlgOpen.ShowOpen
If dlgOpen.FileName <> "" Then
txtFileName = dlgOpen.FileTitle
End If
End Sub
Private Sub cmdSelect_Click()
dlgOpen.Filter = "模版文件(*.tpl)|*.tpl|所有文件(*.*)|*.*"
dlgOpen.ShowOpen
If dlgOpen.FileName <> "" Then
txtTemplateName = dlgOpen.FileTitle
End If
End Sub
Private Sub cmdSplit_Click()
Dim msg As String
If Not SplitFile(txtFileName.Text, msg, CLng(txtFileLength.Text)) Then
MsgBox msg, vbCritical, "错误"
Else
MsgBox "文件分割成功！", vbInformation, "成功"
End If
End Sub
Private Sub cmdAssemble_Click()
If Not AssembleFile(txtTemplateName.Text, txtOutputFile.Text) Then
MsgBox "组合错误", vbCritical, "错误"
Else
MsgBox "文件组合成功！", vbInformation, "成功"
End If
End Sub
Private Sub Form_Load()
Dim strPath As String
strPath = App.Path
If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"
'初始化各个文本框的内容
txtFileName.Text = strPath & "example.jpg"
txtTemplateName.Text = strPath & "example.jpg.tpl"
txtOutputFile.Text = strPath & "example_a.jpg"
End Sub
Public Function SplitFile(strFileToSplit As String, strErrMsg As String, Optional lPerUnit As Long = 1439865) As Boolean
On Error GoTo errHandler
Dim strSaveName As String, nFileNumber As Integer
SplitFile = True '假设成功
Dim lFileLen As Long
lFileLen = FileLen(strFileToSplit) '取得文件的长度
If lFileLen <= lPerUnit + 1 Then
'如果所要分割的文件大小不超过分割单位，则返回分割错误
SplitFile = False
strErrMsg = "文件太小！"
Exit Function
End If
nFileNumber = FreeFile '调用FreeFile函数来取得可以的文件号
Open strFileToSplit For Binary As nFileNumber '以二进制的方式打开文件
Dim lFileNum As Long
'根据文件的长度FilesLen和每个分割单位的比较，得出被分割之后的子文件个数
If CInt(lFileLen / lPerUnit) >= lFileLen / lPerUnit Then
lFileNum = CInt(lFileLen / lPerUnit)
Else
lFileNum = CInt(lFileLen / lPerUnit) + 1
End If
Dim CurrentFile As SectionedFile
ReDim CurrentFile.Files(1 To lFileNum)
Dim i As Long
For i = 1 To lFileNum - 1
ReDim CurrentFile.Files(i).Bytes(1 To lPerUnit)
CurrentFile.Files(i).FileLen = UBound(CurrentFile.Files(i).Bytes)
Next
For i = 1 To lFileNum
Get #nFileNumber, , CurrentFile.Files(i).Bytes '读取文件内容
Next
'重新定义最后一个子文件的大小
ReDim CurrentFile.Files(lFileNum).Bytes(1 To lFileLen - ((lFileNum - 1) * lPerUnit))
CurrentFile.NumberOfFiles = lFileNum
Get #nFileNumber, , CurrentFile.Files(lFileNum).Bytes
CurrentFile.Files(lFileNum).FileLen = UBound(CurrentFile.Files(lFileNum).Bytes)
Close #nFileNumber '关闭文件
'将所取得的内容，分别存储到各个子文件中
For i = 1 To CurrentFile.NumberOfFiles
strSaveName = strFileToSplit & "." & Format(i - 1, "00#")
nFileNumber = FreeFile
Open strSaveName For Binary As nFileNumber
Put #nFileNumber, 1, CurrentFile.Files(i)
Close #nFileNumber
Next
'将文件分割情况，存储到自定义的结构类型FileInfoFile中
Dim FileInfoFile As FileInfo
FileInfoFile.FileCount = lFileNum
FileInfoFile.OrigFileName = strFileToSplit
FileInfoFile.OrigProjSize = FileLen(strFileToSplit)
FileInfoFile.FileStartNum = 0
'将文件分割的情况，存入到模版文件中
strSaveName = strFileToSplit & ".tpl"
nFileNumber = FreeFile
Open strSaveName For Binary As #nFileNumber
Put #nFileNumber, , FileInfoFile
Close #nFileNumber
Exit Function
errHandler:
strErrMsg = Err.Description
SplitFile = False
End Function
Public Function AssembleFile(strTemplateFile As String, strOutFile As String) As Boolean
Dim FileInfo As FileInfo, File As SectionedFile, nFileNumber As Integer
AssembleFile = True '刚开始时，假设文件合并成功
'打开模版文件，并取得分割文件时的信息
nFileNumber = FreeFile
Open strTemplateFile For Binary As #nFileNumber
Get #nFileNumber, , FileInfo
Close #nFileNumber
'从各个子文件中读取内容
ReDim File.Files(1 To FileInfo.FileCount)
Dim strOpeNname As String
Dim i As Long
For i = 1 To FileInfo.FileCount
strOpeNname = FileInfo.OrigFileName & "." & Format((FileInfo.FileStartNum - 1 + i), "00#")
nFileNumber = FreeFile
Open strOpeNname For Binary As #nFileNumber
Get #nFileNumber, 1, File.Files(i)
Close #nFileNumber
Next
'创建输出文件，并将子文件的内容写入到输出文件中
nFileNumber = FreeFile
Open strOutFile For Binary As #nFileNumber
For i = 1 To FileInfo.FileCount
Put #nFileNumber, , File.Files(i).Bytes
Next
Close #nFileNumber
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -