VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1
Caption
=
"Form1"
ClientHeight
=
8655
ClientLeft
=
120
ClientTop
=
450
ClientWidth
=
16005
LinkTopic
=
"Form1"
ScaleHeight
=
8655
ScaleWidth
=
16005
StartUpPosition =
3
'窗口缺省
Begin Command2
Caption
=
"关闭"
Height
=
495
Left
=
14520
TabIndex
=
4
Top
=
8040
Width
=
1335
End
Begin Command1
Caption
=
"拆分"
Height
=
495
Left
=
12720
TabIndex
=
3
Top
=
8040
Width
=
1335
End
Begin MSComctlLib.ListView ListView1
Height
=
7695
Left
=
3000
TabIndex
=
2
Top
=
120
Width
=
12855
_ExtentX
=
22675
_ExtentY
=
13573
View
=
3
LabelEdit
=
1
LabelWrap
=
-1
'True
HideSelection
=
-1
'True
FullRowSelect
=
-1
'True
GridLines
=
-1
'True
_Version
=
393217
ForeColor
=
-2147483640
BackColor
=
-2147483643
BorderStyle
=
1
Appearance
=
1
NumItems
=
5
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text
=
"序号"
Object.Width
=
1411
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex
=
1
Text
=
"文件"
Object.Width
=
8819
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex
=
2
Text
=
"文件大小"
Object.Width
=
2540
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex
=
3
Text
=
"拆分"
Object.Width
=
1411
EndProperty
BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex
=
4
Object.Width
=
2540
EndProperty
End
Begin VB.DirListBox Dir1
Height
=
8070
Left
=
120
TabIndex
=
1
Top
=
480
Width
=
2775
End
Begin VB.DriveListBox Drive1
Height
=
300
Left
=
120
TabIndex
=
0
Top
=
120
Width
=
2775
End
Begin VB.Label Label1
BorderStyle
=
1
'Fixed Single
Height
=
375
Left
=
3000
TabIndex
=
5
Top
=
8040
Width
=
9255
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const FileSize = 1024
'每段限制长度，以字节为单位的常量。1024是调试用的
'Const FileSize = 60*1024*1024
'每段限制长度，以字节为单位的常量
Const EndStr = "此段到此结束"
Private Sub Command1_Click()
Dim i As Long
Dim p As String
Dim s As String
Dim j As Long
Dim item As ListItem
p = Dir1.Path
If Right(p, 1) <> "\" Then
p = p & "\"
End If
'不使用临时文件，尽量多占内存
For i = 1 To ListView1.ListItems.Count
j = ListView1.ListItems(i).SubItems(2)
If j < FileSize Then
ListView1.ListItems(i).SubItems(3) = "不拆分"
Else
Call 拆分(p & ListView1.ListItems(i).SubItems(1))
End If
Next i
End Sub
Private Sub Dir1_Change()
Dim i As Long
Dim p As String
Dim s As String
Dim j As Single
Dim item As ListItem
i = 0
ListView1.ListItems.Clear
p = Dir1.Path
If Right(p, 1) <> "\" Then
p = p & "\"
End If
s = Dir(p & "*.txt")
Do While Len(s) > 0
Set item = ListView1.ListItems.Add
i = i + 1
item.Text = i
item.SubItems(1) = Left(s, Len(s) - 4)
j = FileLen(p & s)
item.SubItems(2) = j
s = Dir
Loop
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub Form_Resize()
Dim i As Long
Dim j As Long
For i = 1 To 4
j = j + ListView1.ColumnHeaders(i).Width
Next i
ListView1.ColumnHeaders(5).Width = ListView1.Width - j - 128
End Sub
Public Sub 拆分(s As String)
'写到这个函数时，VB6崩溃了。郁闷之极，啊啊啊
'这些说明还是用记事本写的。
'读一行，保存到数组里，数组每次重定义大小，计算数组长度，每行长度 +2。英文长度为1 ，汉字长度为2
'判断该行是否以 标志字符开头
'是，记录该行行数，统计到该行为止的长度。
'
判断是否超过长度。如果超过长度，判断是否有上一次的记录结束位置
'
有上一次的记录结束位置，从数组开头，保存到上一次的结束位置为新文件
'
把从上一次结束位置的数据，放到数组开头，然后缩小数组大小为恰当值，重新计算数组大小
'
在上一次结束位置变量中保存当前结束位置
'
无上一次的记录结束位置，说明本段就已超过限制
'
保存所有的数据为新文件
'
清空数组，上一次结束位置继续为零
'
结束上一次记录结束位置判断
'
未超长度，记录为上一次记录结束位置
'不是标志字符，读下一行
'继续循环
End Sub
范例.rar
(1.8 KB)
