'------------------------------------------------ - -------------------------
'Funktion: HTML-Code abschirmen
'Parameter: StrInput-Benutzereingabeinformationen
'------------------------------------------------ - -------------------------
Funktion FunInput(StrInput)
wenn nicht isnull(Str), dann
StrInput=RePlace(StrInput,<,<)
StrInput=replace(StrInput,>,>)
StrinPut=replace(Strinput,chr(32), )
stringinput=replace(strinput,chr(34),)
stringinput=replace(strinput,chr(39),')
stringinput=replace(strinput,chr(13),)
FunInput=string
Ende wenn
Endfunktion
'------------------------------------------------ - -------------------------
'Funktion: SQL-Injection verhindern
'Parameter: StrValue vom Benutzer übermittelte Daten
'BloType-Datentyp
'Parameterwert: echte numerische Daten
' falsche Zeichendaten
'------------------------------------------------ - -------------------------
Funktion FunSQL(StrValue,BloType)
wenn BloType dann
if Isnumeric(StrValue) then
FunSQL=clng(StrValue)
anders
StrValue=0
Ende wenn
anders
Wenn nicht, ist esnull(StrValue), dann
StrValue=lcase(StrValue)
StrValue=Replace(StrValue,','')
StrValue=replace(StrValue,select,)
StrValue=replace(StrValue,update,)
StrValue=replace(StrValue,insert,)
StrValue=replace(StrValue,delete,)
StrValue=replace(StrValue,;,)
StrValue=replace(StrValue, ,)
StrValue=replace(StrValue,chr(255),)
StrValue=replace(StrValue,*,)
StrValue=replace(StrValue,%,)
Ende wenn
Ende wenn
FunSQL=StrValue
Endfunktion
'------------------------------------------------ - ----------------------
'Funktion: Gemeinsame Typkonvertierung
' Parameter: _Type-Datentyp
' _Wertdaten
'Parameterwert: _Type 1: In numerische Daten konvertieren
' _Type 2: In Zeichendaten konvertieren
' _Typ 3: In boolesche Daten konvertieren
'------------------------------------------------ - ----------------------
Funktion FunSwitch(Value_,Type_)
Bei Fehler als nächstes fortfahren
Falltyp auswählen_
Fall 1
wenn isnumeric(Value_), dann
wenn nicht isnull(Value_), dann
FunSwitch=clng(Value_)
anders
FunSwitch=0
Ende wenn
anders
FunSwitch=0
Ende wenn
Fall 2
wenn nicht isnull(Value_), dann
FunSwitch=cstr(Value_)
anders
FunSwitch=
Ende wenn
Fall 3
wenn nicht isnull(Value_) und isnumeric(Value_), dann
FunSwitch=cbool(Value_)
anders
FunSwitch=false
Ende wenn
Fall anders
Response.redirect(Error.asp?err=Bitte geben Sie den zu übertragenden Datentyp in FunSwitch an!)
Ende auswählen
wenn err.number<>0 dann
Response.redirect(Error.asp?err=Bei der Datenkonvertierung ist ein unbekannter Fehler aufgetreten!)
irr.klar
Ende wenn
Endfunktion
''------------------------------------------------ ---------
' Funktion: Überprüfen Sie, ob die Daten von außen stammen
' Parameter: Keine
'------------------------------------------------ - -------------------------
Funktion checkfrom()
server_v1=Cstr(Request.ServerVariables(HTTP_REFERER))
server_v2=Cstr(Request.ServerVariables(SERVER_NAME))
if mid(server_v1,8,len(server_v2))<>server_v2 dann
checkfrom=true
anders
checkfrom=false
Ende wenn
Endfunktion
''------------------------------------------------ ---------
'Funktion: JS-Eingabeaufforderungsfeld
' Parameter: StrURL: Die Seitenadresse, zu der nach dem Klicken auf „OK“ zurückgekehrt werden soll
'StrMSG: Eingabeaufforderungsinformationen im Dialogfeld
'------------------------------------------------ - -------------------------
Funktion FunMsg(StrURL,StrMSG)
Response.write <script language='javascript'>&_
Vbcrlf&alert(&StrMSG&);&_
Vbcrlf&window.location=&StrURL&;&_
Vbcrlf&</script>
Funktion beenden
'------------------------------------------------ - ----------------------
Funktion: Universelles Paging
'Parameter: Intpagecount Gesamtzahl der Seiten
'Intmypage aktuelle Seitennummer
'Intrecordcount Gesamtzahl der Datensätze
'Intpagesize Die Anzahl der auf jeder Seite angezeigten Datensätze
'------------------------------------------------ - ----------------------
Funktion funpage(Intpagecount,Intmypage,Intrecordcount,Intpagesize)
'Bei Fehler als nächstes fortfahren
dim Intfor,Intlist,intlist_b
Dim-Abfrage, a, x, temp
action = http:// & Request.ServerVariables(HTTP_HOST) & Request.ServerVariables(SCRIPT_NAME)
query = Split(Request.ServerVariables(QUERY_STRING), &)
Für jede x In-Abfrage
a = Split(x, =)
Wenn StrComp(a(0), page, vbTextCompare) <> 0 dann
temp = temp & a(0) & = & a(1) & &
Ende wenn
Nächste
wenn intmypage>1 dann
funpage=funpage & <a href='&action&?&temp&page=1' title='Top page' class='no'><font face='Webdings'>9</font></a>
funpage=funpage&<a href='&action&?&temp&page=&Intmypage-1 & ' title='Vorherige Seite' class='no'><font face='Webdings'>7</font></a>
anders
funpage=funpage &<font face='Webdings'>9</font>
funpage=funpage&<font face='Webdings'>7</font>
Ende wenn
wenn Intlist<>0 dann
wenn cintmypage= Intlist dann
Intlist=Intlist+5
Ende wenn
anders
Intlist=Intmypage+5
Ende wenn
wenn intlist-9<1 dann
intlist_b=1
anders
intlist_b=intlist-9
Ende wenn
für Intfor=intlist_b zu Intlist
if intfor<=Intpagecount then
if intfor=Intmypage then '-------machen Sie den Text auf der aktuellen Seite rot und nicht anklickbar
funpage =funpage & strMode& <font color='#FF0000'><b>& Intfor & </b></font>
anders
funpage=funpage & strMode & <a href='&action&?&temp&page= & Intfor &' class='no'> & Intfor & </a>
Ende wenn
Ende wenn
strMode= <font color='#BBBBBB'>|</font>
nächste
if intmypage<intpagecount then
funpage=funpage& <a href='&action&?&temp&page=& Intmypage+1 &' title='Nächste Seite' class='no'><font face='Webdings'>8</font></a>
funpage=funpage &<a href='&action&?&temp&page=& Intpagecount & ' title='Last Page' class='no'><font face='Webdings'>:</font></a>
anders
funpage=funpage& <font face='Webdings'>8</font>
funpage=funpage &<font face='Webdings'>:</font></a>
Ende wenn
funpage=<table width='100%' border='0' cellspacing='0' cellpadding='0'><tr>&_
vbcrlf&<td width='40%' style=font:14px> Aktuelle &Intmypage& Seite&Intpagesize& Datensätze/Seite insgesamt &Intpagecount& Seiten/&Intrecordcount& Datensätze</td>&_
vbcrlf&<td width='60%' align='right'>&_
vbcrlf&<table width='360' border='0' cellspacing='0' cellpadding='0'><tr>&_
vbcrlf&<td align='right' style=font:14px>&funpage& </td>&_
vbcrlf&</tr></table></td></tr>&_
vbcrlf&</table>
wenn err.number<>0 dann
irr.klar
Response.redirect(error.asp?err=Bei der Paging-Funktion ist ein Fehler aufgetreten, bitte wenden Sie sich an den Administrator!|)
Ende wenn
Endfunktion
'************************************************** * *
'Funktionsname: Hervorheben
Funktion: Die gesuchten Schlüsselwörter werden farblich hervorgehoben angezeigt
'Der Parameter strText ist die Zeichenfolge oder Variable, die die hervorzuhebende Zeichenfolge oder Variable enthält
'strFind ist die Zeichenfolge oder Variable, die hervorgehoben werden soll,
'strBeforeDas hervorgehobene HTML-Code-Präfix lautet: <font color=red>
'strAfterDas Suffix des hervorgehobenen HTML-Codes:</font>
'************************************************** * ***
Funktion Highlight(strText, strFind, strBefore, strAfter)
DimPos
Dim nLen
Dim nLenAll
nLen = Len(strFind)
nLenAll = nLen + Len(strBefore) + Len(strAfter) + 1
Highlight = strText
Wenn nLen > 0 und Len(Highlight) > 0, dann
nPos = InStr(1, Highlight, strFind, 1)
Tun Sie dies, solange nPos > 0 ist
Hervorheben = Links(Hervorheben, nPos - 1) & _
strBefore & Mid(Highlight, nPos, nLen) & strAfter & _
Mitte (Highlight, nPos + nLen)
nPos = InStr(nPos + nLenAll, Highlight, strFind, 1)
Schleife
Ende wenn
Funktion beenden