<% 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

O2, Wasser, Sauerstoff, sauerstoffangereichert, Juzu 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

biopuster, biobooster, rotte, deponie 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

free asp cms, download, freeware 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

Anwaltskanzlei Linz, Anwälte, Anwalt 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

CVJM Freilassing 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 %>