分 析 文 本

jp0077777 2008-04-06 12:24:58
想 对 TXT文 件 进 行 字 符 分 析 ,并 提 取 其 中 需 要 的 内 容
例 子 :文 件 中 有 如 下 内 容 :

aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
bbbbbbbbbbbbbbbbbbbbbbbbbb
ccccccccccccccccccccccccc
dddddddddddddddddddddddddd [fdfdfds]
eeeeeeeeeeeeeeeee [fdsfsdf ]
fffffffffffffff uuuuu[ghghg] *******
ggggggggggggggggggggg uuuuu [gggggg] *******
bbbbb [rewreererwerwrewr] ******
sdsadsadsadsadsad
dsadsadsadsdsa mmmmm[yyyy] *****
fsdfdsfdsfdsf mmmmm[tttt] *******
dfdsfsdfdsfdsf
dfsdfsdfsdfdsfdfdf

aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
bbbbbbbbbbbbbbbbbbbbbbbbbb
ccccccccccccccccccccccccc
dddddddddddddddddddddddddd [fdfdfds]
eeeeeeeeeeeeeeeee [fdsfsdf ]
ggggggggggggggggggggg uuuuu [gggggg] *******
bbbbb [rewrewrererewrewr] ******
sdsadsadsadsadsad
dsadsadsadsdsa mmmmm[yyyy] *****
dfdsfsdfdsfdsf
dfsdfsdfsdfdsfdfdf

aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
bbbbbbbbbbbbbbbbbbbbbbbbbb
ccccccccccccccccccccccccc
dddddddddddddddddddddddddd [fdfdfds]
eeeeeeeeeeeeeeeee [fdsfsdf ]
ggggggggggggggggggggg uuuuu [gggggg] *******
bbbbb [rewrewrererewrewr] ******
sdsadsadsadsadsad
dsadsadsadsdsa mmmmm[yyyy] *****
dfdsfsdfdsfdsf
dfsdfsdfsdfdsfdfdf

aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
bbbbbbbbbbbbbbbbbbbbbbbbbb
ccccccccccccccccccccccccc
dddddddddddddddddddddddddd [fdfdfds]
eeeeeeeeeeeeeeeee [fdsfsdf ]
ggggggggggggggggggggg uuuuu [gggggg] *******
bbbbb [ererew] ******
sdsadsadsadsadsad
dsadsadsadsdsa mmmmm[yyyy] *****
dfdsfsdfdsfdsf
dfsdfsdfsdfdsfdfdf

一 共 有 4 个 段落 , 我 想 取 得 每 个 段落 中 uuuuu bbbbb mmmmm 后 []内 的 内 容 , 也 就 是 打 了 星 号 行 []中 的 内 容 ,
实 际 文 件 中 没 有 *号 。 然 后 将 每 个 段落中 取 得 的 UUUUU BBBBB MMMMM后 []内 的 内 容 保 存 在 一 行
并 显 示 在 另 外 一 个 文 件 中 , 这 样 4个 段落 中 共 有 4行 数 据 要 保 存 在 另 外 一 个 文 件 中 。
并 且 还 要 加 一 个 条 件 BBBBB后 的 []中 的 内 容 长 度 要 大 于 22 , UUUUU BBBBB MMMMM后 []中 的 内 容 才 保 存
这 只 是 一 个 例 子 , 真实 际 文 件 中 的 段落 比 这 个 例 子 多 很 多 。, 文 件 很 大 , 所 以 程 序 最 好 是 通 用 的 。 谢 了 。 急 用 。
最 好 有 源 程 序 。
...全文
92 点赞 收藏 13
写回复
13 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
东方之珠 2008-04-06
执行大文件,程序会死掉!小文件肯定没问题,我反复测试过!
那肯定是计算那些S,S过于复杂了,把S拆开,分别计算:

S = Mid(cTXTValue, InStr(1, cTXTValue, LCase(U)) + Len(LCase(U)), Len(cTXTValue) - InStr(1, cTXTValue, LCase(U)) - Len(LCase(U)))
S = Mid(S, InStr(1, S, "[") + 1, InStr(1, S, "]") - InStr(1, S, "[") - 1)

改为:
在ReadFile_GetWord开头再定义2个变量 Dim V1%, V2

V1 = InStr(1, cTXTValue, LCase(U)) + Len(LCase(U))
V2 = Len(cTXTValue) - InStr(1, cTXTValue, LCase(U)) - Len(LCase(U))
S = Mid(cTXTValue, V1, V2)
V1 = InStr(1, S, "[") + 1
V2 = InStr(1, S, "]") - InStr(1, S, "[") - 1
S = Mid(S, V1, V2)

这是改的LCase(U),其他B、M作相应调整。再试看!
回复
jasonXiaoSQL 2008-04-06
程序用上Doevents但不要去考虑多线程.
多线程控制内存有问题.

建议加上DoEvents再配上正则.
你这个用正则应该很容易
回复
vbman2003 2008-04-06
用正则试试
回复
Sandrer 2008-04-06
在三楼的代码中增加一个“DoEvents”
就在Do While Not EOF(FileNumber)下面加

这样的话程序不会死掉,不过所需时间会增加!
回复
jp0077777 2008-04-06
文 件 大 于 700K,程 序 没 有 死 掉 .但 执 行 很 慢 .要 5分 钟 以 上 .我 先 还 以 为 死 掉 了 .
当 文 件 为 1.25M时 死程 序 死 掉 了 .
回复
jp0077777 2008-04-06
有 个 问 题 ,当 文 件 比 较 大 时 程 序 会 死 掉 ,比 如 文 件 大 于 500K以 上
回复
jp0077777 2008-04-06
有 个 问 题 ,当 文 件 比 较 大 时 程 序 会 死 掉 .比 如 文 件 大 于 500K以 上
回复
东方之珠 2008-04-06
'在Form1上添加两个文本框Text1、Text2,一个命令按钮command1
'在设计程序时,将以下设置好。设计时才有效。不能在运行时设置。
'Text1.MultiLine = true
'Text2.MultiLine = true
'Text1.ScrollBars = 3
'Text2.ScrollBars = 3

Option Explicit

Private Sub Command1_Click()
Text1.Text = ""
Text2.Text = ""
ReadFile_GetWord ("d:\cjl.txt")
End Sub

'传送TXT文件,取得“[]”中的内容,并保存为文件
Private Function ReadFile_GetWord(cFile As String) As Boolean

Dim FileCount% ', cFileCount%
Dim cTXTValue$, FileNumber&, U$, B$, M$
Dim S$, ARR$()
Dim IsBBBBB22 As Boolean, TT%

U = "uuuuu": B = "bbbbb": M = "mmmmm" '每个段落中的标识符,字符数可自定
IsBBBBB22 = False: TT = 22 'BBBBB后面的[]内字符数大于22
'FileCount = 0
FileNumber = FreeFile
Open (cFile) For Input As #FileNumber '打开文件
Do While Not EOF(FileNumber)
Line Input #FileNumber, cTXTValue '读取一行文本到变量cTXTValue
cTXTValue = Trim(cTXTValue)
If Len(cTXTValue) = 0 And Len(Text1.Text) = 0 Then '迈开文件开头多余的空行
GoTo chenjl1031
Else
'开始读取每一段的内容
If Len(cTXTValue) = 0 And Len(Text1.Text) <> 0 Then '表示一段读取完毕
'FileCount = FileCount + 1 '统计段落数
Text1.Text = Text1.Text & vbCrLf '每显示完一个段落换行
Text2.Text = Text2.Text & vbCrLf '每一段规定内容显示完毕后换行
'Text2.Text = Text2.Text & "(第" & Trim(FileCount) & "段)" & vbCrLf '每一段规定内容显示完毕后换行
Else
Text1.Text = Text1.Text & cTXTValue & vbCrLf '每读一行都复制到文本框Text1
'以下6行是将uuuuu bbbbb mmmmm 后 []内 的 内 容保存到文本框Text2中
If InStr(1, cTXTValue, LCase(U)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
S = Mid(cTXTValue, InStr(1, cTXTValue, LCase(U)) + Len(LCase(U)), Len(cTXTValue) - InStr(1, cTXTValue, LCase(U)) - Len(LCase(U)))
S = Mid(S, InStr(1, S, "[") + 1, InStr(1, S, "]") - InStr(1, S, "[") - 1)
Text2.Text = Text2.Text & S & " "
End If
If InStr(1, cTXTValue, LCase(B)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
S = Mid(cTXTValue, InStr(1, cTXTValue, LCase(B)) + Len(LCase(B)), Len(cTXTValue) - InStr(1, cTXTValue, LCase(B)) - Len(LCase(B)))
S = Mid(S, InStr(1, S, "[") + 1, InStr(1, S, "]") - InStr(1, S, "[") - 1)
If Len(B) > TT Then IsBBBBB22 = True '标识符BBBBB后面[]内容长度大于22
Text2.Text = Text2.Text & S & " "
End If
If InStr(1, cTXTValue, LCase(M)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
S = Mid(cTXTValue, InStr(1, cTXTValue, LCase(M)) + Len(LCase(M)), Len(cTXTValue) - InStr(1, cTXTValue, LCase(M)) - Len(LCase(M)))
S = Mid(S, InStr(1, S, "[") + 1, InStr(1, S, "]") - InStr(1, S, "[") - 1)
Text2.Text = Text2.Text & S & " "
End If

If InStr(1, cTXTValue, UCase(U)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
S = Mid(cTXTValue, InStr(1, cTXTValue, UCase(U)) + Len(UCase(U)), Len(cTXTValue) - InStr(1, cTXTValue, UCase(U)) - Len(UCase(U)))
S = Mid(S, InStr(1, S, "[") + 1, InStr(1, S, "]") - InStr(1, S, "[") - 1)
Text2.Text = Text2.Text & S & " "
End If
If InStr(1, cTXTValue, UCase(B)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
S = Mid(cTXTValue, InStr(1, cTXTValue, UCase(B)) + Len(UCase(B)), Len(cTXTValue) - InStr(1, cTXTValue, UCase(B)) - Len(UCase(B)))
S = Mid(S, InStr(1, S, "[") + 1, InStr(1, S, "]") - InStr(1, S, "[") - 1)
If Len(B) > TT Then IsBBBBB22 = True '标识符BBBBB后面[]内容长度大于22
Text2.Text = Text2.Text & S & " "
End If
If InStr(1, cTXTValue, UCase(M)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
S = Mid(cTXTValue, InStr(1, cTXTValue, UCase(M)) + Len(UCase(M)), Len(cTXTValue) - InStr(1, cTXTValue, UCase(M)) - Len(UCase(M)))
S = Mid(S, InStr(1, S, "[") + 1, InStr(1, S, "]") - InStr(1, S, "[") - 1)
Text2.Text = Text2.Text & S & " "
End If
End If
End If
'cFileCount = cFileCount + 1
chenjl1031:
Loop
Close #FileNumber

Text2.Text = Text2.Text & vbCrLf '多加一回车换行
ARR = Split(Text2.Text, vbCrLf) '每一段规定内容转换到数组ARR中
'Debug.Print ARR(0), ARR(1), ARR(2), ARR(3)

If Dir("d:\cjl_1.txt") <> "" Then Kill ("d:\cjl_1.txt")
FileNumber = FreeFile
Open ("d:\cjl_1.txt") For Output Shared As #FileNumber '打开文件,准备保存
If IsBBBBB22 Then
For FileCount = 0 To UBound(ARR)
If Len(ARR(FileCount)) <> 0 Then Print #FileNumber, Trim(ARR(FileCount))
Next
End If
Close #FileNumber
End Function
回复
jp0077777 2008-04-06
也 没 有 死 掉 .就 是 很 慢 .5分 钟 以 上 .我 还 以 为 程 序 死 了 .
还 行 吧 .结 贴 .谢 了 .
回复
jp0077777 2008-04-06
88没 分 了 .换 77了
回复
forbearORfolie 2008-04-06
这77—7和88—8是不是一个集团的?
回复
东方之珠 2008-04-06
改成这样,肯定会快很多:


'在Form1上添加两个文本框Text1、Text2,一个命令按钮command1
'在设计程序时,将以下设置好。设计时才有效。不能在运行时设置。
'Text1.MultiLine = true
'Text2.MultiLine = true
'Text1.ScrollBars = 3
'Text2.ScrollBars = 3

Option Explicit

Private Sub Command1_Click()
Text1.Text = ""
Text2.Text = ""
ReadFile_GetWord ("d:\cjl.txt")
End Sub

'传送TXT文件,取得“[]”中的内容,并保存为文件
Private Function ReadFile_GetWord(cFile As String) As Boolean

Dim FileCount% ', cFileCount%
Dim cTXTValue$, FileNumber&, U$, B$, M$
Dim S$, ARR$()
Dim IsBBBBB22 As Boolean, TT%
Dim V1%, V2%

U = "uuuuu": B = "bbbbb": M = "mmmmm" '每个段落中的标识符,字符数可自定
IsBBBBB22 = False: TT = 22 'BBBBB后面的[]内字符数大于22
'FileCount = 0
FileNumber = FreeFile
Open (cFile) For Input As #FileNumber '打开文件
Do While Not EOF(FileNumber)
Line Input #FileNumber, cTXTValue '读取一行文本到变量cTXTValue
cTXTValue = Trim(cTXTValue)
If Len(cTXTValue) = 0 And Len(Text1.Text) = 0 Then '迈开文件开头多余的空行
GoTo chenjl1031
Else
'开始读取每一段的内容
If Len(cTXTValue) = 0 And Len(Text1.Text) <> 0 Then '表示一段读取完毕
'FileCount = FileCount + 1 '统计段落数
Text1.Text = Text1.Text & vbCrLf '每显示完一个段落换行
Text2.Text = Text2.Text & vbCrLf '每一段规定内容显示完毕后换行
'Text2.Text = Text2.Text & "(第" & Trim(FileCount) & "段)" & vbCrLf '每一段规定内容显示完毕后换行
Else
Text1.Text = Text1.Text & cTXTValue & vbCrLf '每读一行都复制到文本框Text1
'以下6行是将uuuuu bbbbb mmmmm 后 []内 的 内 容保存到文本框Text2中
If InStr(1, cTXTValue, LCase(U)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
V1 = InStr(1, cTXTValue, LCase(U)) + Len(LCase(U))
V2 = Len(cTXTValue) - InStr(1, cTXTValue, LCase(U)) - Len(LCase(U))
S = Mid(cTXTValue, V1, V2)
V1 = InStr(1, S, "[") + 1
V2 = InStr(1, S, "]") - InStr(1, S, "[") - 1
S = Mid(S, V1, V2)
Text2.Text = Text2.Text & S & " "
End If
If InStr(1, cTXTValue, LCase(B)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
V1 = InStr(1, cTXTValue, LCase(B)) + Len(LCase(B))
V2 = Len(cTXTValue) - InStr(1, cTXTValue, LCase(B)) - Len(LCase(B))
S = Mid(cTXTValue, V1, V2)
V1 = InStr(1, S, "[") + 1
V2 = InStr(1, S, "]") - InStr(1, S, "[") - 1
S = Mid(S, V1, V2)
If Len(B) > TT Then IsBBBBB22 = True '标识符BBBBB后面[]内容长度大于22
Text2.Text = Text2.Text & S & " "
End If
If InStr(1, cTXTValue, LCase(M)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
V1 = InStr(1, cTXTValue, LCase(M)) + Len(LCase(M))
V2 = Len(cTXTValue) - InStr(1, cTXTValue, LCase(M)) - Len(LCase(M))
S = Mid(cTXTValue, V1, V2)
V1 = InStr(1, S, "[") + 1
V2 = InStr(1, S, "]") - InStr(1, S, "[") - 1
S = Mid(S, V1, V2)
Text2.Text = Text2.Text & S & " "
End If

If InStr(1, cTXTValue, UCase(U)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
V1 = InStr(1, cTXTValue, UCase(U)) + Len(UCase(U))
V2 = Len(cTXTValue) - InStr(1, cTXTValue, UCase(U)) - Len(UCase(U))
S = Mid(cTXTValue, V1, V2)
V1 = InStr(1, S, "[") + 1
V2 = InStr(1, S, "]") - InStr(1, S, "[") - 1
S = Mid(S, V1, V2)
Text2.Text = Text2.Text & S & " "
End If
If InStr(1, cTXTValue, UCase(B)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
V1 = InStr(1, cTXTValue, UCase(B)) + Len(UCase(B))
V2 = Len(cTXTValue) - InStr(1, cTXTValue, UCase(B)) - Len(UCase(B))
S = Mid(cTXTValue, V1, V2)
V1 = InStr(1, S, "[") + 1
V2 = InStr(1, S, "]") - InStr(1, S, "[") - 1
S = Mid(S, V1, V2)
If Len(B) > TT Then IsBBBBB22 = True '标识符BBBBB后面[]内容长度大于22
Text2.Text = Text2.Text & S & " "
End If
If InStr(1, cTXTValue, UCase(M)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
V1 = InStr(1, cTXTValue, UCase(M)) + Len(UCase(M))
V2 = Len(cTXTValue) - InStr(1, cTXTValue, UCase(M)) - Len(UCase(M))
S = Mid(cTXTValue, V1, V2)
V1 = InStr(1, S, "[") + 1
V2 = InStr(1, S, "]") - InStr(1, S, "[") - 1
S = Mid(S, V1, V2)
Text2.Text = Text2.Text & S & " "
End If
End If
End If
'cFileCount = cFileCount + 1
chenjl1031:
Loop
Close #FileNumber

Text2.Text = Text2.Text & vbCrLf '多加一回车换行
ARR = Split(Text2.Text, vbCrLf) '每一段规定内容转换到数组ARR中
'Debug.Print ARR(0), ARR(1), ARR(2), ARR(3)

If Dir("d:\cjl_1.txt") <> "" Then Kill ("d:\cjl_1.txt")
FileNumber = FreeFile
Open ("d:\cjl_1.txt") For Output Shared As #FileNumber '打开文件,准备保存
If IsBBBBB22 Then
For FileCount = 0 To UBound(ARR)
If Len(ARR(FileCount)) <> 0 Then Print #FileNumber, Trim(ARR(FileCount))
Next
End If
Close #FileNumber
End Function
回复
silencenet 2008-04-06
这个问题用VB现有的函数执行效率上明显不足
建议用正则
参考例子:http://user.qzone.qq.com/241220652/blog/1203391650
-_-! 当年放到QQ空间了
速度绝对可以
这里还有测试效率:http://user.qzone.qq.com/241220652/blog/1203398032
回复
相关推荐
发帖
VB基础类
创建于2007-09-28

7491

社区成员

VB 基础类
申请成为版主
帖子事件
创建了帖子
2008-04-06 12:24
社区公告
暂无公告