Keskustelu: Ohjelmointikysymykset: VB.NET: [VB2008]Tiettyjen sanojen määrä merkkijonossa

Private Sub Button1_Click(ByVal sender As System.Object, _
ByVal e As System. EventArgs) Handles Button1.Click

   MessageBox.Show(GetInStrCount( _
   Me.TextBox1.Text, Me.TextBox2.Text).ToString)

End Sub

Private Function GetInStrCount( _
ByVal txt1 As String, ByVal txt2 As String) As Integer

   Dim cnt As Integer = 0

   If txt1.Length < txt2.Length And txt1 <> "" Then

      For i As Integer = 0 To TextBox2.Text.Length - TextBox1.Text.Length
         If i < TextBox2.Text.Length - TextBox1.Text.Length _
         And Not CheckBox1.Checked Then
            If TextBox2.Text.Substring(i, TextBox1.Text.Length + 1) _
            .IndexOf(TextBox1.Text + " ") > -1 Then
               cnt += 1
            End If
         Else
            If TextBox2.Text.Substring(i, _
            TextBox1.Text.Length).IndexOf(TextBox1.Text) > -1 Then
               cnt += 1
            End If
         End If
      Next
   End If

   Return cnt

End Function

Private Sub Button1_Click(ByVal sender As System.Object, _
ByVal e As System. EventArgs) Handles Button1.Click

   'TextBox1-tekstiruudussa on vain yksi hakusana

   '   CheckBox1-valintaruutu ei ole valittuna:
   '   funktio etsii TextBox2-tekstiruudun tekstistä
   '   kaikki kokonaiset, hakusanaa vastaavat sanat...
   '   esim. hakusana: moi
   '   TexBox2-tekstiruudun teksti: moi moikka tuommoinen
   '   funktion palaute: "moi" löytyi 1 kpl"

   '   CheckBox1-valintaruutu on valittuna:
   '   funktio etsii TextBox2-tekstiruudun merkkijonosta
   '   kaikki hakusanaa vastaavat merkkijonot...
   '   esim. hakusana: moi
   '   TexBox2-tekstiruudun teksti: moi moikka tuommoinen
   '   funktion palaute: "moi" löytyi 3 kpl"

   'TextBox1-tekstiruudussa on monta välilyönnein erotettua hakusanaa

   '   CheckBox1-valintaruutu ei ole valittuna:
   '   funktio etsii TextBox2-tekstiruudun tekstistä
   '   kaikki kokonaiset, hakusanoja vastaavat sanat...
   '   esim. hakusanat: moi moikka
   '   TexBox2-tekstiruudun teksti: moi moikka moikkaa tuommoinen
   '   funktion palaute: "moi" löytyi 1 kpl

   '                     "moikka" löytyi 1 kpl

   '   CheckBox1-valintaruutu on valittuna:
   '   funktio etsii TextBox2-tekstiruudun merkkijonosta
   '   kaikki hakusanoja vastaavat merkkijonot...
   '   esim. hakusanta: moi moikka
   '   TexBox2-tekstiruudun teksti: moi moikka moikkaa tuommoinen

   '   funktion palaute: "moi" löytyi 4 kpl"

   '                   : "moikka" löytyi 2 kpl

   'TextBox1-tekstiruudussa on lainausmerkkien sisällä lause
   '
   '  CheckBox1-valintaruutu ei ole valittuna:
   '  funktio etsii TextBox2-tekstiruudun tekstistä
   '  kaikki kokonaiset, hakulausetta vastaavat lauseet - lauseen osat
   '  esim. hakulause: "terve moro hei"
   '  TexBox2-tekstiruudun teksti: hän sanoi terve moro hei
   '                             : ja terve moro heippa...

   '  funktion palaute: "terve moro hei" löytyi 1 kpl

   '  CheckBox1-valintaruutu on valittuna:
   '  funktio etsii TextBox2-tekstiruudun merkkijonosta
   '  kaikki hakulausetta vastaavat merkkijonot
   '  esim. hakulause: "terve moro hei"
   '  TexBox2-tekstiruudun teksti: hän sanoi terve moro hei
   '                             : ja terve moro heippa...

   '  funktion palaute: "terve moro hei" löytyi 2 kpl


   Dim InfoStr As String = _
   GetInStrCount(Me.TextBox1.Text, _
   Me.TextBox2.Text, Me.CheckBox1.Checked)
   If InfoStr <> "" Then
      MessageBox.Show(InfoStr,"InStrCount", _
      MessageBoxButtons.Ok, MessageBoxIcon.Information)
   End If
   InfoStr = Nothing

End Sub

Function GetInStrCount(ByVal Str1 As String, _
ByVal Str2 As String, ByVal Checked As Boolean) As String

   Str2 = Str2.Replace(Environment.NewLine," ")

   Str1 = Str1.Trim: Str2 = Str2.Trim

   If str1 = String.Empty Or Str2 = String.Empty Then
      Return String.Empty: Exit Function
   End If

   Dim ArrayExists As Boolean = False
   Dim IsSentence As Boolean = False
   Dim StrArray() As String
   Dim ReturnStr As String = String.Empty

   If Not Checked Then
      Str2 = " " + Str2 + " "
   End If

   If Str1.IndexOf(Chr(34)) > -1 Then
      If Str1.Substring(0, 1) = Chr(34) And _
      Str1.Substring(Str1.Length - 1, 1) = Chr(34) Then
         IsSentence = True
         Str1 = Str1.Substring(1, Str1.Length - 2)
      End If
   End If

   If Str1.IndexOf(" ") > -1 And Not IsSentence Then
      ArrayExists = True
   Else
      If Not Checked Then
         Str1 = " " + Str1 + " "
      End If
      If Str1.Length > Str2.Length Then
         ArrayExists = Nothing: IsSentence = Nothing
         StrArray = Nothing: Return ReturnStr
         ReturnStr = Nothing: Exit Function
      End If
   End If

   IsSentence = Nothing

   If Not ArrayExists Then

      Dim cnt As Integer = 0
      For i As Integer = 0 To Str2.Length - Str1.Length
         If Str2.Substring(i, Str1.Length).IndexOf(Str1) > -1 Then
            cnt += 1
         End If
      Next
      ReturnStr = "'" + Str1.Trim + "' löytyi " + CStr(cnt) + " kpl"
      cnt = Nothing: Return ReturnStr: ReturnStr= Nothing
      StrArray = Nothing: ArrayExists = Nothing: Exit Function

   Else

      StrArray = Str1.Split(" ")
      If Not Checked Then
         For i As Integer = 0 To StrArray.GetupperBound(0)
            StrArray(i) = " " + StrArray(i) + " "
         Next
      End If

      Dim InfoArray(1, 0) As Object
      InfoArray(0, 0) = ""
      InfoArray(1, 0) = 0
      For i As Integer = 0 To StrArray.GetUpperbound(0)
         If Not StrArray(i).Length > Str2.Length Then
            For j As Integer = 0 To Str2.Length - StrArray(i).Length
               Dim IsAllreadyInArray As Boolean = False
               If Str2.Substring(j, StrArray(i). _
               Length).IndexOf(StrArray(i)) > -1 Then
                  For k As Integer = 0 To InfoArray.GetUpperbound(1)
                     If InfoArray(0, k) = StrArray(i) Then
                        IsAllreadyInArray = True
                        InfoArray(1, k) += 1: Exit For
                     End If
                  Next k
                  If Not IsAllreadyInArray Then
                     InfoArray(1, k) += 1
                     InfoArray(0, InfoArray. _
                     GetUpperBound(1)) = StrArray(i)
                     InfoArray(1, InfoArray. _
                     GetUpperBound(1)) += 1
                     If InfoArray.GetUpperBound(1) < _
                     StrArray.GetUpperBound(0) Then
                        ReDim Preserve InfoArray(1, _
                        InfoArray.GetUpperBound(1) + 1)
                     End If
                  End If
               End If: IsAllreadyInArray = Nothing
            Next j
         End If
      Next i

      If InfoArray(0, 0) = String.Empty Then
         ReturnStr = String.Empty
      Else
         For i As Integer = 0 To InfoArray.GetUpperBound(1)
            If Not InfoArray(0, i) Is Nothing Then
               ReturnStr +=  "''" + InfoArray(0, i).Trim + _
               "'' löytyi " + InfoArray(1, i).ToString + " kpl" + _
               Environment.NewLine + Environment.NewLine
            End If
         Next
      End If
      InfoArray = Nothing

   End If

   Return ReturnStr: ReturnStr = Nothing
   StrArray = Nothing: ArrayExists = Nothing

End Function