'------------------------------------------------ - -------------------------
'Fonction : Protéger le code HTML
'Paramètre : informations d'entrée utilisateur StrInput
'------------------------------------------------ - -------------------------
fonction FunInput(StrInput)
sinon isnull(Str) alors
StrInput=RePlace(StrInput,<,<)
StrInput=remplacer(StrInput,>,>)
StrinPut=remplacer(Strinput,chr(32), )
stringinput=replace(strinput,chr(34),)
stringinput=replace(strinput,chr(39),')
stringinput=replace(strinput,chr(13),)
FunInput=chaîne
finir si
fonction de fin
'------------------------------------------------ - -------------------------
'Fonction : Empêcher l'injection SQL
'Paramètre : données soumises par l'utilisateur StrValue
'Type de données BloType
'Valeur du paramètre : données numériques vraies
'données de faux caractères
'------------------------------------------------ - -------------------------
fonction FunSQL(StrValue,BloType)
si BloType alors
si Isnumeric (StrValue) alors
FunSQL=clng(StrValue)
autre
ValeurStre=0
finir si
autre
sinon isnull (StrValue) alors
StrValue=lcase(StrValue)
StrValue=Remplacer(StrValue,','')
StrValue=remplacer(StrValue,select,)
StrValue = remplacer (StrValue, mettre à jour,)
StrValue=remplacer(StrValue,insérer,)
StrValue = remplacer (StrValue, supprimer,)
StrValue=remplacer(StrValue,;,)
StrValue=remplacer(StrValue, ,)
StrValue=remplacer(StrValue,chr(255),)
StrValue=remplacer(StrValue,*,)
StrValue=remplacer(StrValue,%,)
finir si
finir si
FunSQL=StrValeur
fonction de fin
'------------------------------------------------ - ----------------------
'Fonction : Conversion de type commune
' Paramètre : _Type de données
'_Données de valeur
'Valeur du paramètre : _Type 1 : Convertir en données numériques
' _Type 2 : Convertir en données de caractères
' _Type 3 : Convertir en données booléennes
'------------------------------------------------ - ----------------------
fonction FunSwitch (Valeur_,Type_)
en cas d'erreur, reprendre ensuite
sélectionner le type de cas_
cas 1
si est numérique (Valeur_) alors
sinon isnull (Value_) alors
FunSwitch=clng(Valeur_)
autre
FunSwitch=0
finir si
autre
FunSwitch=0
finir si
cas 2
sinon isnull (Value_) alors
FunSwitch=cstr(Valeur_)
autre
FunSwitch=
finir si
cas 3
sinon isnull(Value_) et isnumeric(Value_) alors
FunSwitch=cbool(Valeur_)
autre
FunSwitch = faux
finir si
cas d'autre
réponse.redirect(Error.asp?err=Veuillez spécifier le type de données à transférer dans FunSwitch !)
fin de la sélection
si numéro d'erreur <>0 alors
réponse.redirect(Error.asp?err=Une erreur inconnue s'est produite lors de la conversion des données !)
err.clear
finir si
fonction de fin
''------------------------------------------------ -----------------------
' Fonction : Vérifier si les données proviennent de l'extérieur
' Paramètres : Aucun
'------------------------------------------------ - -------------------------
fonction checkfrom()
server_v1=Cstr(Request.ServerVariables(HTTP_REFERER))
server_v2=Cstr(Request.ServerVariables(SERVER_NAME))
si mid(server_v1,8,len(server_v2))<>server_v2 alors
checkfrom = vrai
autre
checkfrom = faux
finir si
fonction de fin
''------------------------------------------------ -----------------------
'Fonction : boîte d'invite JS
' Paramètres : StrURL : L'adresse de la page à laquelle revenir après avoir cliqué sur OK
'StrMSG : informations sur l'invite de la boîte de dialogue
'------------------------------------------------ - -------------------------
Fonction FunMsg(StrURL,StrMSG)
Réponse.write <script language='javascript'>&_
Vbcrlf&alert(&StrMSG&);&_
Vbcrlf&window.location=&StrURL&;&_
Vbcrlf&</script>
Fonction de fin
'------------------------------------------------ - ----------------------
'Fonction : radiomessagerie universelle
'Paramètre : Intpagecount nombre total de pages
'Numéro de la page actuelle de Intmypage
'Intrecordcount nombre total d'enregistrements
'Intpagesize Le nombre d'enregistrements affichés sur chaque page
'------------------------------------------------ - ----------------------
fonction funpage (Intpagecount, Intmypage, Intrecordcount, Intpagesize)
'en cas d'erreur, reprendre ensuite
dim Intfor, Intlist, intlist_b
Requête Dim, a, x, temp
action = http:// & Request.ServerVariables(HTTP_HOST) & Request.ServerVariables(SCRIPT_NAME)
requête = Split (Request.ServerVariables (QUERY_STRING), &)
Pour chaque requête x In
une = Diviser (x, =)
Si StrComp(a(0), page, vbTextCompare) <> 0 Alors
temp = temp & a(0) & = & a(1) & &
Fin si
Suivant
si intmapage>1 alors
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='Page précédente' class='no'><font face='Webdings'>7</font></a>
autre
funpage=funpage &<font face='Webdings'>9</font>
funpage=funpage&<font face='Webdings'>7</font>
finir si
si Intliste<>0 alors
si cintmypage= Liste internationale alors
Liste internationale=Liste internationale+5
finir si
autre
Liste internationale=Intmapage+5
finir si
si intlist-9<1 alors
intlist_b=1
autre
intlist_b=intlist-9
finir si
pour Intfor=intlist_b vers Intlist
si intfor<=Intpagecount alors
if intfor=Intmypage then '-------rendre le texte de la page actuelle rouge et non cliquable
funpage =funpage & strMode& <font color='#FF0000'><b>& Intfor & </b></font>
autre
funpage=funpage & strMode & <a href='&action&?&temp&page= & Intfor &' class='no'> & Intfor & </a>
finir si
finir si
strMode= <font color='#BBBBBB'>|</font>
suivant
si intmypage<intpagecount alors
funpage=funpage& <a href='&action&?&temp&page=& Intmypage+1 &' title='Page suivante' class='no'><font face='Webdings'>8</font></a>
funpage=funpage &<a href='&action&?&temp&page=& Intpagecount & ' title='Dernière page' class='no'><font face='Webdings'> :</font></a>
autre
funpage=funpage& <font face='Webdings'>8</font>
funpage=funpage &<font face='Webdings'> :</font></a>
finir si
funpage=<table width='100%' border='0' cellpacing='0' cellpadding='0'><tr>&_
vbcrlf&<td width='40%' style=font:14px> &Intmypage& page&Intpagesize& enregistrements/page total &Intpagecount& pages/&Intrecordcount& enregistrements</td>&_
vbcrlf&<td width='60%' align='right'>&_
vbcrlf&<table width='360' border='0' cellpacing='0' cellpadding='0'><tr>&_
vbcrlf&<td align='right' style=font:14px>&funpage& </td>&_
vbcrlf&</tr></table></td></tr>&_
vbcrlf&</table>
si numéro d'erreur <>0 alors
err.clear
réponse.redirect(error.asp?err=Une erreur s'est produite dans la fonction de pagination, veuillez contacter l'administrateur !|)
finir si
fonction de fin
'************************************************ * *
'Nom de la fonction : Mettre en surbrillance
'Fonction : Les mots-clés recherchés sont affichés dans des couleurs surlignées
'Le paramètre strText est la chaîne ou la variable contenant la chaîne ou la variable à mettre en évidence
'strFind est la chaîne ou la variable à mettre en évidence,
'strBeforeLe préfixe du code HTML en surbrillance est : <font color=red>
'strAfterLe suffixe du code HTML en surbrillance :</font>
'************************************************ * ***
Fonction Highlight (strText, strFind, strBefore, strAfter)
DimPos
Dim nLen
Dim nLenTout
nLen = Len(strFind)
nLenAll = nLen + Len(strAvant) + Len(strAprès) + 1
Surbrillance = strText
Si nLen > 0 Et Len(Highlight) > 0 Alors
nPos = InStr(1, Highlight, strFind, 1)
Faire pendant que nPos > 0
Highlight = Gauche (Highlight, nPos - 1) & _
strBefore & Mid (Highlight, nPos, nLen) & strAfter & _
Milieu (surbrillance, nPos + nLen)
nPos = InStr(nPos + nLenAll, Highlight, strFind, 1)
Boucle
Fin si
Fonction de fin