发布网友
共1个回答
热心网友
'注:本例字节流的处理是关键,哪位有识别字节流更好办法的欢迎交流
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'自定义函数
Public Function getname(link As String) As String '获取FileTitle函数
Dim i As Integer
link = Trim(link)
For i = Len(link) To 1 Step -1
If Mid(link, i, 1) = "\" Then getname = Mid(link, i + 1): Exit For
Next i
End Function
Private Sub Form_Click()
On Error Resume Next
Dim n As Integer
Dim te() As String '数组,存放文件列表
Dim patha As String '目录名
Dim fname As String '文件名
patha = InputBox("请输入路径(如:d:\我的文档\)") '原目录*****
If patha = "" Then Exit Sub
If Right(patha, 1) <> "\" Then patha = patha & "\" '路径容错
MkDir patha & "new" '新目录,处理后文件
'获取文件列表
fname = Dir(patha, vbDirectory)
Do While fname <> "" '遍历目录
If LCase(Right(fname, 4)) = ".txt" Then
ReDim Preserve te(n): te(n) = patha & fname: n = n + 1
End If
fname = Dir()
Loop
'依次处理文件
Dim s_now As Byte, s_head As Byte '当前字节,前一字节
Dim llen As Long '长度
On Error Resume Next
For i = 0 To UBound(te)
Me.Print "正在处理 " & te(i) '显示进度
DoEvents
Open te(i) For Binary As #121 '读
Open patha & "new\" & getname(te(i)) For Binary As #122 '写
Do While Not EOF(121)
Get #121, , s_now '读字节
llen = llen + 1 'Len(s1) '累计长度
Put #122, , s_now '写字节
If llen > 300 And s_now = 163 And s_head = 161 And Asc(s_now) = 49 _
And Asc(s_head) = 49 Then '分界处(注:此处llen应取600,1字符=2字节)
Put #122, , vbNewLine '写入换行符
Put #122, , vbNewLine & String(80, "*") & vbNewLine '此句测试效果,可删去
llen = 0 '重置长度
End If
s_head = s_now
Loop
Close #122
Close #121
Me.Cls '清屏
Next i 'for语句
ShellExecute 0, "open", patha & "new", 0, 0, 1
End Sub