关于文件内容的搜索

Question

现有文本格式文件一批(内容全为英文),大小为1-3MB左右
现要求:
1.针对某一关键字进行搜索
2.列出所有搜索到的关键字的约100单词左右的上下文
3.统计关键字的匹配总数希望各位给点建议!

Answer 1

简单到要死！1、将文件读为Byte数组tBytes()。用Open pFileName For Binary和Get语句。2、将tBytes()转换为字符串，用StrConv函数。获得文本pText3、搜索关键字：tStrings()=Replace(pText,关键字)。tStrings()是以关键字为间隔获得的字符串数组。UBound(tStrings())就是匹配数量。4、tS=InStr(pText,关键字)，tS是关键字第一次出现的位置。你求100单词有点困难，但是求前后指定数量（比如100个）字符却容易：Mid(pText,tS-((100-Len(关键字))\2),100)

Answer 2

求100单词的算法是这样的：1、求关键字第一次出现的位置。tS=InStr(pText,关键字)2、假设一个值tL，tL是取tS前后字符串的总长度。3、在tS前后取tL个字符。分三种情况：
（1）关键字前后都有足够的字符。这时候，取得的字符是Mid(pText,tS-((tL-Len(关键字))\2),tL)
（2）前面没有足够的字符。Mid(pText,1,tL)
（3）后面没有足够的字符。Mid(pText,Len(pText),tL)4、循环进行算法3，将tL长度的字符串tL_Get，做Replace(tL_Get," ")（英文单词以空格间隔），根据获得的数组计算空格数量。如果获得的数组元素不足100，扩展tL的长度重新去。至于tL每次扩展多长，最简单的方法是扩展一个字符。精确而高效的办法有两分法和模糊法。两分法以默认第一次扩展N个开始，如果第一次扩展的数量没有得到足够数量的元素则扩展增加量乘0.618。如果超过了100个单词，tL的增减量减0.618并以tL减其增减量，直到获得100个。模糊法是统计单词的平均长度。获得每个单词的数组Replace(pText," ")，统计所有单词（或者间隔N个抽样）。获得单词的平均长度（更精确一些可以将pText分为若干段，每段统计一个长度）。然后，以两分法循环取tL个字符。tL初始值为单词平均长度*100+1。

Answer 3

更正一下：上面的函数用错了，应该是Split函数，而不是Replace函数。另外，还有一个办法，比较简单：从3开始：
3、搜索关键字：tStrings()=Replace(pText,关键字)。tStrings()是以关键字为间隔获得的字符串数组。UBound(tStrings())就是匹配数量。然后，将tStrings(0)+关键字+tStrings(1)获得字符串tOutStr，如果Split(tOutStr," ")获得的数组不足100个，则tOutStr=tOutStr+tStrings(1+i)，直到大于100个为止。如果需要精确100个，则将Split(tOutStr," ")前100个元素以组合为一个字符串就可以了。

Answer 4

下面是这个程序，但是还有点问题没解决。
Private Sub Command1_Click()
  Dim tText As String
  
  tText = TextGetByFile("TECHINFO.txt")
  tText = TextFilterEnter(tText)
  Text1.Text = WordsGetByFind(tText, "Quake", 12) ' WordsGetByCount(tText, 12)
End SubFunction WordsGetByFind(ByVal pText As String, ByVal pFindStr As String, Optional ByVal pGetCount As Long) As String
  Dim tText As String
  Dim tText_Front As String
  Dim tText_Front_Start As Long
  Dim tText_Back As String
  Dim tText_Back_Start As Long
  
  Dim tFindStr_Start As Long
  
  tText = TextFilterEnter(pText)
  
  tFindStr_Start = InStr(tText, pFindStr)
  
  If CBool(tFindStr_Start) Then
      
    tText_Front_Start = tFindStr_Start - 1
    
    If CBool(tText_Front_Start) Then
      tText_Front = Left(tText, tText_Front_Start)
    End If
    
    tText_Back_Start = Len(tText) - (tFindStr_Start + Len(pFindStr))
    
    tText_Back = Right(tText, tText_Back_Start)
  
    WordsGetByFind = WordsGetByCountRev(tText_Front, pGetCount \ 2) & " " & pFindStr & " " & WordsGetByCountRev(tText_Back, pGetCount \ 2)
  
  End If
  
End FunctionFunction WordsGetByCountRev(ByVal pText As String, ByVal pCount As Long) As String
  Dim tOutText As String
  Dim tWords() As String
  Dim tCount_Out As Long
  Dim tCount_All As Long
  Dim tIndex As Long
  Dim tIndex_Start As Long
  tCount_All = WordsCountGetByText(pText)
  tCount_Out = ((tCount_All >= pCount) And pCount) + ((tCount_All < pCount) And tCount_All)
  
  tIndex_Start = (tCount_All - tCount_Out) + 1
  
  tWords() = Split(pText, " ")
  
  For tIndex = tIndex_Start To tCount_All
    If tIndex = 1 Then
        tOutText = tWords(tIndex)
      Else
        tOutText = tOutText & " " & tWords(tIndex)
     End If
  Next
  
  WordsGetByCountRev = tOutText
End FunctionFunction WordsGetByCount(ByVal pText As String, ByVal pCount As Long) As String
  Dim tOutText As String
  Dim tWords() As String
  Dim tCount_Out As Long
  Dim tCount_All As Long
  Dim tIndex As Long
  tCount_All = WordsCountGetByText(pText)
  tCount_Out = ((tCount_All >= pCount) And pCount) + ((tCount_All < pCount) And tCount_All)
  
  tWords() = Split(pText, " ")
  
  For tIndex = 1 To tCount_Out
    If tIndex = 1 Then
        tOutText = tWords(tIndex)
      Else
        tOutText = tOutText & " " & tWords(tIndex)
     End If
  Next
  
  WordsGetByCount = tOutText
End FunctionFunction WordsCountGetByText(ByVal pText As String) As Long
  Dim tOutCount As Long
  
  Dim tWords() As String
  
  tWords() = Split(pText, " ")
  tOutCount = UBound(tWords())
  
  WordsCountGetByText = tOutCount
End FunctionFunction TextFilterEnter(ByVal pText As String) As String
  Dim tOutText As String
  
  tOutText = pText
  
  tOutText = Replace(tOutText, vbCrLf & " ", " ")
  tOutText = Replace(tOutText, " " & vbCrLf, " ")
  tOutText = Replace(tOutText, vbCrLf, " ")
  Do
    tOutText = Replace(tOutText, "  ", " ")
  Loop Until Not CBool(InStr(tOutText, "  "))
  
  TextFilterEnter = tOutText
End FunctionFunction TextGetByFile(ByVal pFileName As String) As String
  '从文件获得多行文本。
  Dim tOutText As String
  Dim tFileNumber As Integer
  Dim tBytes() As Byte
  tFileNumber = FreeFile
  Open pFileName For Binary As #tFileNumber
    If CBool(LOF(tFileNumber)) Then
        ReDim tBytes(LOF(tFileNumber) - 1)
        Get tFileNumber, 1, tBytes()
        tOutText = StrConv(tBytes, vbUnicode)
      Else
        MsgBox "警告：文件" & pFileName & "是空的！", vbOKOnly, "文件无内容"
    End If
  Close #tFileNumber
  TextGetByFile = tOutText
End Function

Answer 5

呵呵，好像我结过了，后来csdn调整，怎么数据丢掉了！