%
Response.End
Dim referer, isBadIP, ipaddress, page, searchparam, searchterm, tmp, cnt, cnt2, cnt3, pageFromSearchstring
Dim arr_badIP, pageGoodwords(99), pageBadwords(99), pageUrl(99), findings(99)
arr_badIP=array("193.178.208.6", "")
'**** Suchbegriffdefinitionen
'--- O2ALIVE
pageGoodwords(1)= "o2alive, o2, wasser, sauerstoff, juzu, sauerstoffangereichert, bionic, Tafelwasser"
pageBadwords(1) = "deponie, rotte, müll, kontaminiert, muell, gift, mbu, biopuster, bio-puster"
pageUrl(1) = "http://www.o2alive.com"
'--- BIOPUSTER
pageGoodwords(2)= "deponie, rotte, müll, muell, gift, mbu, biopuster, bio-puster"
pageBadwords(2) = "o2alive, o2alife, floimair"
pageUrl(2) = "http://www.mbu.at/deponietechnik_biopuster.asp"
'--- ONLINO
pageGoodwords(3)= "free, asp, cms, content management system, iis, wysiwyg, online editor, download"
pageBadwords(3) = "muell, müll"
pageUrl(3) = "http://www.onlino.net"
'--- RAKANZLEI-GKP
pageGoodwords(4)= "Anwalt, Linz, Anwälte Linz, Linzer Anwälte, Rechtsanwalt, Rechtsanwaltskanzlei, Gabl, Papesch, Kogler, Leitner, Kanzlei"
pageBadwords(4) = "muell, müll"
pageUrl(4) = "http://www.rakanzlei-gkp.com"
'--- CVJM-BGL
pageGoodwords(4)= "CVJM, christlich, Christlicher Verein Junger Menschen, Freilassing, Jesus, Alpha Kurs, BGL, Deutschland, Bibel, Hauskreis, Glauben, Hauskreise"
pageBadwords(4) = "muell, müll, deponie, rotte, müll, kontaminiert, gift"
pageUrl(4) = "http://www.cvjm-bgl.de"
'**** Receive Request Parameters
referer = UCase(Request.ServerVariables("HTTP_REFERER"))
ipaddress = Request.ServerVariables("REMOTE_ADDR")
page = Request("p") : If Not IsNumeric(page) Or page="" Then page=0 Else page=CInt(page)
'//referer="http://www.google.at/search?q=o2alive+wasser&start=0&ie=utf-8&oe=utf-8&client=firefox-a&rls=org.mozilla:en-US:official" : referer=UCase(referer)
'**** Wurde diese Seite über eine Suchmaschine erreicht? Wenn ja Suchstring auswerten
If referer<>"" Then
If Instr(referer,".GOOGLE.")>0 Then searchparam="q="
If Instr(referer,".YAHOO.")>0 Then searchparam="p="
If Instr(referer,".MSN.")>0 Then searchparam="q="
If Instr(referer,".ASK.")>0 Then searchparam="q="
If Instr(referer,".NEOMO.DE")>0 Then searchparam="q="
If Instr(referer,".MIVA.COM")>0 Then searchparam="mt="
If Instr(referer,".GIGABLAST.")>0 Then searchparam="q="
End If
If searchparam<>"" Then
tmp = RegExpFilter(referer, "[\?|\&]" & searchparam & "([^&]*)&?.*", 0)
searchterm = tmp(0)
tmp = RegExpFilter(searchterm, "(%)([0-9]*)", 1)
For Each item In tmp
searchterm=Replace(searchterm,"%" & item,chr(hex2dec(item)))
Next
searchterm = Replace(searchterm,"+"," ")
End If
'**** Testen ob Suchstring in ein Seitenschema passt
If searchterm<>"" Then
searchterm=searchterm & " "
tmp=Split(searchterm," ")
'*** Test for "goodWords"
For cnt=0 To Upperbound(tmp)
For cnt2=0 To Upperbound(pageGoodwords)
If Trim(LCase(tmp(cnt)))<>"" And LCase(pageGoodwords(cnt2))<>"" Then
If Instr(LCase(pageGoodwords(cnt2)), Trim(LCase(tmp(cnt))))>0 Then
findings(cnt2)=findings(cnt2)+1
End If
End If
Next
Next
For cnt=100 To 1 Step -1
cnt2=find(findings,cnt)
If cnt2>=0 Then
tmp=Split(searchterm," ")
'*** Test for "badWords"
For cnt3=0 To Upperbound(tmp)
If Trim(LCase(tmp(cnt3)))<>"" And LCase(pageBadwords(cnt2))<>"" Then
If Instr(LCase(pageBadwords(cnt2)), Trim(LCase(tmp(cnt3))))>0 Then
'shit - this word is a badword. Lets try the definition
cnt3=999999999
pageFromSearchstring=-1
Else
'Yeah - this word is not listed in badwords
pageFromSearchstring=cnt2
End If
End If
Next
If cnt3<9999999 Then Exit For
End If
Next
End If
'**** Testen ob die IP des Users auf der Blacklist steht - wenn ja, redirect auf ranner.de
If ipIsBad(Request.ServerVariables("REMOTE_ADDR")) Then
Response.Redirect ("http://www.ranner.de")
End If
'**** Redirect auf die jeweilige Seite, die in Google gesucht und gefunden wurde.
If pageFromSearchstring>=0 Then
tmp=pageUrl(pageFromSearchstring)
If tmp<>"" Then Response.Redirect(tmp)
End If
'***********************************************************************************************
'**** Some Functions ***************************************************************************
'***********************************************************************************************
Private Function RegExpFilter(instrg, strPattern, submatch)
Dim FNergebnisArray(), FNi, objRegAusdr, myResult, tmpErgebnis
Set objRegAusdr = New RegExp
objRegAusdr.Pattern = strPattern
objRegAusdr.IgnoreCase = True
objRegAusdr.global = true 'Do not stop after first match
Set myResult=objRegAusdr.Execute(instrg)
For FNi=0 To myResult.Count-1
If submatch>=0 Then
tmpErgebnis = myResult(FNi).SubMatches.Item(submatch)
Else
tmpErgebnis = myResult(FNi).value
End If
Redim Preserve FNergebnisArray(FNi)
FNergebnisArray(FNi)=tmpErgebnis
Next
RegExpFilter=FNergebnisArray
End Function
Function Hex2Dec(ByVal Hex)
Dim hexLen 'lenth of Hex
Dim hexCheck 'string containing valid hex digits
Dim hexErrorTF 'true/false value flagging an invalid digit
Dim x 'loop variable
'make sure that Hex is a string variant
Hex = CStr(Hex)
hexLen = len(Hex)
hexCheck = "0123456789ABCDEF"
'make sure Hex is a valid hexidecimal number
hexErrorTF = False
For x = 1 To hexLen
If (inStr(hexCheck, uCase(mid(Hex, x, 1))) = 0) Then hexErrorTF = True
Next
If (hexErrorTF) Then
Hex2Dec = CDbl(0)
Else
If (hexLen = 1) Then
'return decimal number for hex digit
If (isNumeric(Hex)) Then
Hex2Dec = CDbl(hex)
Else
'figure out the decimal equivilent of the hex digit
Select Case uCase(Hex)
Case "A" : Hex2Dec = CDbl(10)
Case "B" : Hex2Dec = CDbl(11)
Case "C" : Hex2Dec = CDbl(12)
Case "D" : Hex2Dec = CDbl(13)
Case "E" : Hex2Dec = CDbl(14)
Case "F" : Hex2Dec = CDbl(15)
Case Else : Hex2Dec = CDbl(0)
End Select
End If
Else
'convert hex to decimal digit by digit using recursion
For x = 1 To hexLen
Hex2Dec = Hex2Dec + (Hex2Dec(mid(Hex, ((hexLen + 1) - x), 1)) * (16 ^ (x - 1)))
Next
End If
End If
End Function
Function find(ByVal inArray, ByVal strSearch)
Dim FNi
find=-1
If Not isArray(inArray) Then
If Instr(LCase(strSearch),LCase(inArray))>0 Then find=0
Exit Function
End If
For FNi=0 To UpperBound(inArray)
If Instr(LCase(Trim(inArray(FNi))), LCase(Trim(strSearch)))>0 Then
find=FNi
Exit For
End If
Next
End Function
Function upperBound(inArray)
On Error Resume Next
upperBound=UBound(inArray)
If err.number<>0 Then
upperBound=-1
End If
On Error Goto 0
End Function
Function ipIsBad(ipaddr)
Dim FNresult, FNitem
FNresult=False
For Each FNitem In arr_badIP
If Trim(FNitem)<>"" Then
If Trim(FNitem)=Trim(Ucase(ipaddr)) Then FNresult=True
End If
Next
ipIsBad=FNresult
End Function
%>
Projects
<% If referer="" Then page=1000 %>
<% If page=0 Then %><% End If %>
<% If page=100 Then %><% End If %>
Sauerstoff Wasser O2 angereichtert
Biopuster MBU
free ASP CMS
Anwalt Linz
CVJM BGL
<% If page=1 Or page=1000 Then %>
o2alive - Das starke Wasser mit Sauerstoff |
|
o2alive ist ein sauerstoffangereichertes Wasser - ein Getränk mit
Sauerstoff in den Varianten regular less und juzu.
Das Unternehmen bionic (bionic.co.at) (Entwicklung und Vertrieb) entwickelte und vertreibt dieses Wasser!
Wie wäre es mit einem Test? Kaufen und testen Sie o2alive - sie werden begeistert sein! Ein Wohltat für Gesundeheit, Körper, Seele und Geist.
o2 alife oder o2alife - so schreibt man das Sauerstoffgetränk nicht :-)
This Oxygen Water is a product from Austria (Europe). Read more about this Power Water at http://www.o2alive.com.
O2 angereichert wurde das hochwertige Tafelwasser zum Livestyle Getränk.
|
<%=pageGoodwords(1)%>
<% End If %>
<% If page=2 Or page=1000 Then %>
Biopuster - MBU - Bio-Puster |
|
Der Biopuster ist ein patentiertes Produkt von MBU Salzburg Österreich zur Deponie Altlast Sanierung. Müllentsorgung ist ein akutes Problem, gerade im Umkreis der Stadt.
Der Abbauvorgang von Müll Deponien ist anaerob und biochemisch. Folge: geruchsintensive Geruchsbelästigung. Zum Teil hochgiftig, enthält explosive Gase uns sind Altlasten. Kontaminierter Boden, Sickerwässer gefährden das kostbare Grundwasser.
Mensch und Umwelt benötigen Abbau, Kompostierung und Entkontaminierung der Deponie. MBU hat ein Verfahren entwickeln, mit dem dieses Problem ohne weitere Belastung von Mensch und Umwelt in wirtschaftlicher Weise gelöst werden kann.
Das patentierte BIO-PUSTER VERFAHREN, schreibweise auch biopuster, biobooster oder bio-booster hilft dabei.
Die Deponie wird mit speziellen Lanzen, den Bio-Puster Lanzen, abgesteckt.
Durch die intermittierende, explosionsartige Zufuhr von Luft und Sauerstoff durch die Bio-Puster Lanzen wird der Müllkörper vollständig vom
anaeroben in den aeroben Zustand übergeführt. Das Mülldeponie Biopuster Verfahren verwendet Einzelimpulse/ Druckstöße, die mit Schallgeschwindigkeit an der speziell geformten Drucklanzenspitze entweichen.
|
<%=pageGoodwords(2)%>
<% End If %>
<% If page=3 Or page=1000 Then %>
Onlino - free asp cms |
|
Onlino ist ein gratis CMS für ASP - Download und auf Microsoft IIS ASP installieren. Einfach, schnell und sehr effektiv.
Test: hier können Sie onlino gleich testen: Onlino ASP CMS. Onlino ist ein
free asp cms - freeware, also gratis. Open source ist Onlino hinsichtlich seiner
offenen Programmierung - also reine Skripts, an einer passenden Lizenz a la GNU GPL wird noch gearbeitet. Download free ASP CMS for free.
|
<%=pageGoodwords(3)%>
<% End If %>
<% If page=4 Or page=1000 Then %>
Linzer Anwälte |
|
Ihr Anwalt in Linz. Ein motiviertes Anwälte Team von derzeit 4 Rechtsanwälte in Linz mit spezialisiert auf Gebeiten des Notariat, Forderungsbetreibung, Zivilgerichtsbarkeit. Rechtsbeistand österreichisches Wirtschaftsrecht.
Strafsache wie Liegenschaftsrecht Verkehrsrecht, Schadensersatzrecht Gewährleistungsrecht Familienrecht, Scheidungsrecht und auch im Erbrecht. Garantie und Gewährleistung und auch Scheidung - Rechtsbeistand durch Rechtsanwaltskanzlei GKP.
Gabl Papesch Kogler Leitner.
|
<%=pageGoodwords(4)%>
<% End If %>
<% If page=5 Or page=1000 Then %>
CVJM-BGL |
|
Der CVJM BGL Berchtesgadener Land ist ein "Christlicher Verein Junger Menschen". Er ist überkonfessionell und geprägt vom Glauben an Jesus Christus.
Bibelkreise, Hauskreise, Hauskreis aber auch Alpha Kurs und Wanderungen und andere Freizeitaktivitäten sowie Jugendarbeit, Jungschar, Freizeit für Kinder und Bibelkurs.
Der CVJM Freilassing hat für jeden - von Jung bis Alt, Männer, Frauen, Mädchen, Jungs - etwas zu bieten. Alle Veranstaltungen sind für Besucher offen und prinzipiell gratis. Mitglieder und Mitgliedschaft ist kein muss, aber erwünscht.
Besuchen Sie uns in der Martin Oberndorfer Strasse 3.
Das Engagement für eine christliche Lebensgestaltung aus dem Glauben an Jesus Christus und der Dienst an Menschen in unserer Region sind die wesentlichen Ziele des CVJM.
|
<%=pageGoodwords(5)%>
<% End If %>