Intelligent Keyword Phrases Analizer

Ищу помошника для разработки более интелектуальной залинковки keyword phrases

к примеру в этом блоге

http://costadelnerja-info.blogspot.com/2010/04/summit-holiday-destinations-spain_1879.html

можно увидеть работу этого кода

надо сделать умнее и луче для СЕО =)

Public Class frmTextAnal

Dim frase As String

Dim ifrases As Integer

Dim curblogurl As String

Dim curblogposturl As String

Dim nextblog As String

Dim nextlinkwheel As String

Dim frases5(99) As String

Dim frases4(99) As String

Dim frasesarray(99) As String

Dim linksinjector(3) As String

Dim icur As Integer

Dim injector_current_frase As Integer

Dim injector_current_link As Integer

Dim frasesstring As String

Private Sub log(ByVal dbg As String)

txtdbg.Text = Format(Now, "yyyy-mmm-dd HH:mm:ss") & ";" & dbg & vbCrLf & txtdbg.Text

End Sub

Private Sub button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles button1.Click

parser(numericUpDown1.Value)

End Sub

Private Function parser(ByVal wordscount As Integer)

If icur >= 20 Then

Return True

End If

Dim uniqueWords As New HashSet(Of String)()

Dim expressions As New HashSet(Of String)()

Dim duplicationExpressions As New ArrayList()

Dim inputtext As String = Me.txtInnerText.Text

'log(inputtext)

inputtext = inputtext.Replace(vbCr & vbLf, " ")

inputtext = inputtext.Replace(vbTab, " ")

'inputtext = inputtext.Replace(".", "")

inputtext = inputtext.Replace("?", "")

inputtext = inputtext.Replace("(", "")

inputtext = inputtext.Replace(")", "")

inputtext = inputtext.Replace("-", "")

inputtext = inputtext.Replace(":", "")

'inputtext = inputtext.Replace(",", "")

inputtext = inputtext.Replace("!", "")

'inputtext = inputtext.Replace(".", " ")

'inputtext = inputtext.Replace("?", " ")

'inputtext = inputtext.Replace("(", " ")

'inputtext = inputtext.Replace(")", " ")

'inputtext = inputtext.Replace("-", " ")

'inputtext = inputtext.Replace(":", " ")

'inputtext = inputtext.Replace(",", " ")

'inputtext = inputtext.Replace("!", " ")

Dim wordcount As Integer = CInt(wordscount) 'CInt(Me.numericUpDown1.Value)

' calculate toltal words

Dim separators As String() = New String(1) {}

separators(0) = " "

Dim allWords As String() = inputtext.Split(separators, StringSplitOptions.RemoveEmptyEntries)

'Dim TotalCount As Integer = allWords.Length

'Dim TotalCount As Integer = findAllWordCount(allWords, 3)

separators(1) = ","

Dim onlyAllWords As String() = inputtext.Split(separators, StringSplitOptions.RemoveEmptyEntries)

Dim selectedWords As New ArrayList()

Dim TotalCount As Integer = 0

selectedWords = findAllWordCount(allWords, 1)

TotalCount = selectedWords.Count

onlyAllWords = Nothing

onlyAllWords = CType(selectedWords.ToArray(GetType(String)), String())

Dim exp As String = ""

For i As Integer = 0 To (onlyAllWords.Length - wordcount)

exp = ""

For j As Integer = 0 To wordcount - 1

exp += onlyAllWords(i + j)

If j

exp += " "

End If

Next

expressions.Add(exp)

duplicationExpressions.Add(exp)

uniqueWords.Add(onlyAllWords(i))

'expressions.Add(exp.ToLower())

'duplicationExpressions.Add(exp.ToLower())

'uniqueWords.Add(onlyAllWords(i).ToLower())

Next

Me.listView1.Items.Clear()

For Each s As String In expressions

Dim count As Integer = calculateNoOfOccurrence(s, duplicationExpressions)

Dim positionSum As Integer = calculateSumOfPosition(s, duplicationExpressions)

Dim frequency As Double = calculateFrequency(CDbl(count), CDbl(TotalCount))

Dim prominence As Double = calculateProminence(count, positionSum, TotalCount)

If count > 1 Then

Me.listView1.Items.Add(New ListViewItem(New String() {s, count.ToString(), frequency.ToString() + "%", prominence.ToString()}))

frasesstring = frasesstring & s & "|"

icur = icur + 1

End If

Next

Return listView1.Items.Count

End Function

Private Function calculateFrequency(ByVal wordOccurrence As Double, ByVal totalWords As Double) As Double

Return Math.Round(((wordOccurrence / totalWords) * 100), 1)

End Function

Private Function calculateProminence(ByVal positionCount As Integer, ByVal positionSum As Integer, ByVal totalWords As Integer) As Double

' Formula to calculate prominence

' Prominence = ($totalwords - (($positionsum - 1) / $positionsnum)) * (100 / $totalwords)

Dim prominence As Double = (totalWords - (CDbl((positionSum - 1)) / CDbl(positionCount))) * (CDbl(100) / CDbl(totalWords))

Return Math.Round(prominence, 1)

End Function

Private Function calculateNoOfOccurrence(ByVal expression As String, ByVal duplicateExpressions As ArrayList) As Integer

Dim count As Integer = 0

For i As Integer = 0 To duplicateExpressions.Count - 1

If expression.ToUpper() = duplicateExpressions(i).ToString().ToUpper() Then

count += 1

End If

Next

Return count

End Function

Private Function calculateSumOfPosition(ByVal expression As String, ByVal duplicateExpressions As ArrayList) As Integer

Dim positionSum As Integer = 0

For i As Integer = 0 To duplicateExpressions.Count - 1

If expression.ToUpper() = duplicateExpressions(i).ToString().ToUpper() Then

positionSum += (i + 1)

End If

Next

Return positionSum

End Function

Private Function findAllWordCount(ByVal allWords As String(), ByVal minNoOfCharPerWord As Integer)

Dim wordCount As Integer = 0

Dim selectedWords As New ArrayList()

For i As Integer = 0 To allWords.Length - 1

If allWords(i).Length >= minNoOfCharPerWord Then

selectedWords.Add(allWords(i))

wordCount += 1

End If

Next

Return selectedWords

End Function

Private Sub txtText_Click(ByVal sender As Object, ByVal e As System.EventArgs)

txtInnerText.Text = vbNullString

End Sub

Private Sub txtText_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs)

End Sub

Private Sub textanal_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

End Sub

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click

'

Dim article_title As String

article_title = "NB! Protective Measures an Against a Bank? so Account Hacking ..."

addlinks()

End Sub

Private Sub injector()

On Error GoTo bug

If injector_current_frase > frasesarray.Count Then GoTo startposting

Dim innertext As String

Dim innerhtml As String

innerhtml = txtInnerHTML.Text

innertext = txtInnerText.Text

Dim frase As String = frasesarray(injector_current_frase)

Dim link As String = linksinjector(injector_current_link)

Dim skipnext As Boolean

skipnext = False

For i = 0 To injector_current_frase - 1

If InStr(frasesarray(i), frase) > 0 Then

skipnext = True

log("INJECTOR: found smilar frase above;frasesarray(i)=" & frasesarray(i) & " vs frase=" & frase & ";skipnext=" & skipnext)

Exit For

Else

'log("")

End If

Next

'Exit Sub

If InStr(innerhtml, frase) > 0 And skipnext = False Then

log("found InStr(LCase(innerhtml), frase)=" & InStr(innerhtml, frase) & ";frase=" & frase)

'innertext = Replace(innertext, frase, "" & frase & "", , 1)

innerhtml = Replace(innerhtml, frase, "" & frase & "", , 1)

'txthtmloutput.Text = innerhtml

txtInnerHTML.Text = innerhtml

injector_current_link = injector_current_link + 1

Else

log("not found frase=" & frase & "; trying again with next one injector_current_frase=" & frasesarray(injector_current_frase))

End If

injector_current_frase = injector_current_frase + 1

'log("INJECTOR:injector_current_link=" & injector_current_link & " vs linksinjector.Count=" & linksinjector.Count)

If injector_current_link >= linksinjector.Count Then

log("INJECTOR: I am done adding links, let's post in main.vb form, timer on")

GoTo startposting

Exit Sub

Else

injector()

End If

Exit Sub

startposting:

log("INJECTOR: startposting section here, frmPoster.timPoster.Enabled = True")

Dim zamena As String

zamena = txtInnerHTML.Text

zamena = Replace(zamena, "{currentblogurl}", frmPoster.current_blog_link)

zamena = Replace(zamena, "{nextblog}", frmPoster.next_blog)

zamena = Replace(zamena, "{currentblogposturl}", frmPoster.current_article_link)

zamena = frmPoster.current_article_header & zamena

txtInnerHTML.Text = zamena

frmPoster.current_article_innerhtml = zamena

frmPoster.timPoster.Enabled = True

Exit Sub

bug:

log("INJECTOR:ERROR=" & ErrorToString())

Resume Next

End Sub

Public Sub addlinks()

' log(listView1.Items(0).SubItems(0).Text)

' log(listView1.Items(1).SubItems(0).Text)

' Exit Sub

listView1.Refresh()

nextlinkwheel = "{nextlinkwheel}"

nextblog = "{nextblog}"

curblogposturl = "{currentblogposturl}"

curblogurl = "{currentblogurl}"

linksinjector(0) = curblogposturl

linksinjector(1) = nextlinkwheel

linksinjector(2) = curblogurl

linksinjector(3) = nextblog

icur = 0

injector_current_frase = 0

injector_current_link = 0

frasesstring = ""

' log("ifrases = " & ifrases & "; linksinjector.Count=" & linksinjector.Count)

'log(listView1.Items(0).SubItems(0).Text)

'Exit Sub

For i = 7 To 2 Step -1

ifrases = parser(i)

For x = 0 To ifrases - 1

'If listView1.Items(x).SubItems(0).Text

'icur = icur + 1

'If icur > 6 Then Exit For

Next

Next

log(frasesstring)

frasesarray = Split(frasesstring, "|")

For i = 0 To frasesarray.Count - 1

If frasesarray(i) = "" Then

ReDim Preserve frasesarray(i - 1)

Exit For

End If

log(frasesarray(i))

Next

log("now array is count=" & frasesarray.Count)

For i = 0 To linksinjector.Count - 1

log("link in array=" & linksinjector(i))

Next

injector()

Exit Sub

ender:

End Sub

End Class