Hallo!
Ich probiere es mal:
function GetAbitOfText(pTextToSearch, pMaxLength, pTextToFind)
dim lSearch: lSearch = split(pTextToSearch, " ")
dim lFind: lFind = split(pTextToFind, " ")
dim lFound(99), lResult
dim i, j, f, h: f = -1
' Fundstellen markieren (<b>...</b>)
for i = 0 to ubound(lSearch)
for j = 0 to ubound(lFind)
if strcomp(lSearch(i), lFind(i), vbTextCompare) = 0 then
lSearch(i) = "<b>" & lSearch(i) & </b>
f = f + 1: lFound(f) = i
end if
next
next
' Fundstellen sortieren
for i = 0 to f - 1
for j = i + 1 to f
if lFound(i) > lFound(j) then
h = lFound(i)
lFound(i) = lFound(j)
lFound(j) = j
end if
next
next
' Fundstellen filtern
for j = 0 to lFound(0) - 6: lSearch(j) = "...": next
for i = 1 to f
for j = lFound(i - 1) + 6 to lFound(i) - 6: lSearch(j) = "...":
next
next
for j = lFound(f) + 6 to ubound(lSearch): lSearch(j) = "...": next
' Fundstellen zusammensetzen und "..." reduzieren
lResult = join(lSearch, " ")
for i = 1 to 3
lResult = replace(lResult, "......", "...", 1, -1,
vbBinaryCompare)
next
GetAbitOfText = lResult
End function
Freundliche Gr��e
Joachim van de Bruck
> -----Urspr�ngliche Nachricht-----
> Von: [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED]]
> Gesendet: Freitag, 21. September 2001 08:16
> An: AspGerman Kaffeehaus
> Betreff: [aspdecoffeehouse] Google - Das Freitag Problem?
>
> Hi ihr alle,
>
> Kennt ihr den Suchmaschine Google? Tolle sache oder. Ich wurde so was
nicht nachbauen k�nnen nur
> ich wurde ganz gerne die Art von Suchergebnissen auch haben.
>
> Also wenn mann nach ein Wort in Texten, sollte der Teil des Satzes
anzeigt werden wo das wort sich
> in befindet. (plus minus 5 W�rter vom gefundene Wort), dann kommen ein
paar Punkchten .... und wenn
> das Wort noch mal vorkommt das 2. oder 3. Stuck Text wo das wort in
vorkommt. Nat�rlich sollte nach
> mehrer W�rter gesucht werden k�nnen.
>
> Die suche findet per SQL statt und es ist nur das Ergebniss was ich
aus einander schneiden werden.
> Daf�r habe ich folgende Routine geschrieben. Aber das Funktioniert
richtig schlecht.
>
> Ich habe mal geh�rt das mann solche Text Problem mit dem Library
Object l�sen soll nur da kenne ich
> mich nicht mit aus. Kann jemand mich helfen dabei? W�re super toll.
>
> gruss
>
> Gido
>
> 350 = maximale Menge von angezeigte text Pro ergebniss
>
> call getAbitOfText("Der text die durchsucht wird",350,"die gesuchte
w�rter")
>
>
> function getAbitOfText(text_temp,TextEnde,TextSuchWort)
> text_temp = replace(text_temp,"<br>","")
> dim ttt
> dim textSuchwort_temp
> dim text_temp2
> dim nn
> worttellen = 0
> dim worttellen
> textSuchwort_temp = split(textSuchwort)
> text_temp2 = Split(text_temp," ")
> redim foundWorts(1)
> dim gee
> m = 1
> for n = 0 to Ubound(text_temp2)
> for nn = 0 to Ubound(textSuchwort_temp)
> if instr((lcase(text_temp2(n))),(lcase(textSuchwort_temp(nn))))<>0
then
> foundWorts(m) = n
> m = m +1
> REDIM PRESERVE foundWorts(m)
> end if
> next
> next
> response.write "...."
> for n = 1 to Ubound(foundWorts)-1
> if int(foundWorts(n)-5) > 0 AND int(foundWorts(n)+5) <
int(Ubound(text_temp2)) AND
> int(foundworts(n))<>0 then
> response.write "...."
> for nn = (foundWorts(n)-5) to (foundWorts(n)+5)
>
> if
Instr((lcase(text_temp2(nn))),(lcase(text_temp2((foundWorts(n))))))<> 0
then
> response.write "<B>" & text_temp2((nn)) & "</B> "
> worttellen = worttellen + len(text_temp2(nn))
> else
> response.write text_temp2(nn) & " "
> worttellen = worttellen + len(text_temp2(nn))
> end if
>
> next
> response.write "...."
> else
> if int(foundWorts(n)) < 5 then
> for nn = 0 to (foundWorts(n)+10)
> if
Instr((lcase(text_temp2(nn))),(lcase(text_temp2((foundWorts(n))))))<> 0
then
> response.write "<B>" & text_temp2((nn)) & "</B> "
> worttellen = worttellen + len(text_temp2(nn))
> else
> response.write text_temp2(nn) & " "
> worttellen = worttellen + len(text_temp2(nn))
> end if
> next
> else
> if int(foundWorts(n)+4) > int(Ubound(text_temp2)) then
> for nn = (foundWorts(n)-5) to (Ubound(text_temp2))
> if
Instr((lcase(text_temp2(nn))),(lcase(text_temp2((foundWorts(n))))))<> 0
then
> response.write "<B>" & text_temp2((nn)) & "</B> "
> worttellen = worttellen + len(text_temp2(nn))
> else
> response.write text_temp2(nn) & " "
> worttellen = worttellen + len(text_temp2(nn))
> end if
>
> next
> end if
> end if
> end if
> if int(worttellen)> int(TextEnde) then exit Function
> next
> end Function
>
>
>
>
>
>
> | [aspdecoffeehouse] als [EMAIL PROTECTED] subscribed
> | http://www.aspgerman.com/archiv/aspdecoffeehouse/ = Listenarchiv
> | Sie k�nnen sich unter folgender URL an- und abmelden:
> |
http://www.aspgerman.com/aspgerman/listen/anmelden/aspdecoffeehouse.asp
| [aspdecoffeehouse] als [email protected] subscribed
| http://www.aspgerman.com/archiv/aspdecoffeehouse/ = Listenarchiv
| Sie k�nnen sich unter folgender URL an- und abmelden:
| http://www.aspgerman.com/aspgerman/listen/anmelden/aspdecoffeehouse.asp
