qqcf_myfunction.asp

功 能： 1.系统分别为每个网站注册会员分配了一个推广链接

<%
'==================================
' 乘风网站推广系统v3.83 Access版
' 制　作：乘　风
' 开发网站：乘风原创程序
' 网站网址: http://www.qqcf.com
' 程序演示：http://www.qqcf.com/?action=try
' 最新版本下载：http://www.qqcf.com/?action=down
' 使用帮助：http://www.qqcf.com/?action=help&help=cfwztg
' 声 明:	
' 本软件系免费程序,提供给个人免费使用。
' Access免费版缺少防止用户作弊的功能,如需要此功能请购买正式版本。
' 作者为付费版用户提供全面升级服务和技术支持,免费版用户提供有限的升级服务和技术支持。
' 免费版用户在程序首页保留乘风原创程序版权和链接。
' 未经作者许可禁止用于任何商业用途。
' 乘风其它作品：乘风多用户计数器Access版、MsSql版、Php版、.Net版，乘风电影程序、
'　　　　　　　 乘风网站推广系统Mssql版、乘风网址程序，乘风广告管理系统、乘风论坛等。
' 此段版权注释不会影响网页打开速度，请勿删除!
'                       2006年9月14日									
'===================================
%>
<%'以下为公用函数
Function GoBack(Str,AlertStr) '为空时后退
 If Str="" Then 
  Response.Write "<script>" 
  Response.Write "alert('"&AlertStr&"');" 
  Response.Write "history.go(-1)" 
  Response.Write "</script>" 
  Response.End 
 Else
  GoBack=Str
 End If
End Function

Function AlertBack(AlertStr,BackNum) 
  Response.Write "<script>" 
  Response.Write "alert('"&AlertStr&"');" 
  Response.Write "history.go(-"&BackNum&")" 
  Response.Write "</script>" 
  Response.End 
End Function

Function AlertUrl(AlertStr,Url) 
 Response.Write "<script>" 
 Response.Write "alert('"&AlertStr&"');" 
 Response.Write "location.href='"&Url&"';" 
 Response.Write "</script>" 
 Response.end 
End Function

Function GotoUrl(Url) 
 Response.Write "<script>" 
 Response.Write "location.href='"&Url&"';" 
 Response.Write "</script>" 
 Response.End 
End Function

Function CheckInput_Letter(InputStr) '检查用户名输入的合法性
 For I = 1 To Len(InputStr)
  C = Lcase(Mid(InputStr, I, 1)) '------------分割成每个字母或数字------------------
  If InStr("abcdefghijklmnopqrstuvwxyz_", C) <= 0 And Not IsNumeric(C) Then
   Response.Write "<script language='javascript'>" & VbCRlf
   Response.Write "alert('请不要在用户名中输入中文,空格或其它非法字符,合法字符为大小写字母,下划线,数字!');" & VbCrlf
   Response.Write "history.go(-1);" & vbCrlf
   Response.Write "</script>" & VbCRLF
   Response.End
  end if
 Next
 CheckInput_Letter=InputStr
End Function

Function CheckInput_Blank(InputStr) '检查密码输入的合法性
 For I = 1 To Len(InputStr)
  c = Lcase(Mid(InputStr, I, 1)) '------------分割成每个字母或数字------------------
  If InStr(" ", c) > 0 Or InStr("　", c) > 0 Then
   Response.Write "<script language='javascript'>" & VbCRlf
   Response.Write "alert('请不要输入空格!');" & VbCrlf
   Response.Write "history.go(-1);" & vbCrlf
   Response.Write "</script>" & VbCRLF
   Response.End
  End If
 Next
  CheckInput_Blank=InputStr
End Function

Function ChkStr(InputStr) '过滤非法字符
 InputStr_2=Lcase(InputStr)
 I=0
 If Instr(InputStr_2,"'")>0 Then
  InputStr_2=Replace(InputStr_2,"'","")
  I=1
 End if
 If Instr(InputStr_2,"select")>0 Then
  InputStr_2=Replace(InputStr_2,"select","")
  I=1
 End if
 If Instr(InputStr_2,"insert")>0 Then
  InputStr_2=Replace(InputStr_2,"insert","")
  I=1
 End if
 If Instr(InputStr_2,"update")>0 Then
  InputStr_2=Replace(InputStr_2,"update","")
  I=1
 End if
 If Instr(InputStr_2,"delete")>0 Then
  InputStr_2=Replace(InputStr_2,"delete","")
  I=1
 End if
 If Instr(InputStr_2,"drop")>0 Then
  InputStr_2=Replace(InputStr_2,"drop","")
  I=1
 End if
 If Instr(InputStr_2,"truncate")>0 Then
  InputStr_2=Replace(InputStr_2,"truncate","")
  I=1
 End if
 If Instr(InputStr_2,"exec")>0 Then
  InputStr_2=Replace(InputStr_2,"exec","")
  I=1
 End if
 If Instr(InputStr_2,"from")>0 Then
  InputStr_2=Replace(InputStr_2,"from","")
  I=1
 End if
 
If I=0 Then
 ChkStr=InputStr
Else
 ChkStr=InputStr_2
End If
End Function

Function GetFieldValues(ByVal TalbeName,ByVal FieldNmae,ByVal Fieldvalues,ByVal FieldType,ByVal GetFieldName)  '通用,通过一个表的字段，得到表中某个字段的值
 If FieldType=1 Then
  Sql="select "&GetFieldName&" from "& TalbeName &" where "& FieldNmae &"="& Fieldvalues
 ElseIf FieldType=2 Then
  Sql="select "&GetFieldName&" from "& TalbeName &" where "& FieldNmae &"='"& Fieldvalues &"'"
 End If
 Set FieldValues=Server.CreateObject("Adodb.RecordSet")
 FieldValues.Open Sql,Conn,1,1
 If Not FieldValues.Eof Then GetFieldValues=FieldValues(0)
 FieldValues.Close
End function

Function MyRate(snum,bnum)
 MyRate=Cstr((snum/bnum)*100)
 If Instr(MyRate,".")=0 Then
  MyRate=MyRate&".00"
 Else
  If Len(Mid(MyRate,Instr(MyRate,".")+1))=1 Then
   MyRate=MyRate&"0"
  Else
   MyRate=Left(MyRate,Instr(MyRate,".")+2)
  End If
 End If
 If Left(MyRate,Instr(MyRate,".")-1)=0 Then MyRate="0"&MyRate
End Function

Function MyRate_2(num)
 MyRate_2=num
 If Instr(MyRate_2,".")=0 Then
  MyRate_2=MyRate_2&".00"
 Else
  If Len(Mid(MyRate_2,Instr(MyRate_2,".")+1))=1 Then
   MyRate_2=MyRate_2&"0"
  Else
   MyRate_2=Left(MyRate_2,Instr(MyRate_2,".")+2)
  End If
 End If
 If Left(MyRate_2,Instr(MyRate_2,".")-1)=0 Then MyRate_2="0"&MyRate_2
End Function

Function HttpPath(Assort)
 Ser=Request.servervariables("SERVER_NAME")
 Scr=Request.servervariables("SCRIPT_NAME")
 Port=Request.Servervariables("SERVER_PORT")

 Scr_2=StrReverse(Mid(StrReverse(Scr),Instr(StrReverse(Scr),"/")))

 If Assort=1 Then
  HttpPath=Ser 
 ElseIf Assort=2 Then
  If Port="80" Then
   HttpPath="http://"&Ser&Scr_2
  Else
   HttpPath="http://"&Ser&":"&Port&Scr_2
  End If 
 ElseIf Assort=3 Then
  If Port="80" Then
   HttpPath="http://"&Ser&Scr
  Else
   HttpPath="http://"&Ser&":"&Port&Scr
  End If
 End If
End Function

Function GetCurrWeb()
 Url=HttpPath(3)&"?"&Request.QueryString&"&"&Request.Form
 If Mid(Url,Len(Url))="&" Then Url=Left(Url,Len(Url)-1)
 Session("Url")=Url
End Function


Function PxFilter(px,pxok)
 px=Lcase(px)
 pxok=Lcase(pxok)

 PxArrary=Split(Pxok,",")

 For I= 0 To Ubound(PxArrary)
  If PxArrary(I)=Px Then J=1
 Next

 If J<>1 Then Call AlertBack("禁止此类排序",1)
End Function

Function GetConVertStr(ByVal MyStr)
 If MyStr="-" Then MyStr=""
 GetConVertStr=MyStr
End Function

Function BreakUrl(ByVal Url,ByVal BreakType)
 Url=Lcase(Url)
 If Url<>"-" Then
  UrlArrary=Split(Url,"/")
  UrlHead=UrlArrary(2)
  UrlTail=UrlArrary(Ubound(UrlArrary))
  If BreakType=1 Then
   BreakUrl=UrlHead
  ElseIf BreakType=2 Then
   If UrlTail<>"" Then
    BreakUrl=UrlTail
   Else
    BreakUrl=UrlHead
   End if
  End if
 Else
  BreakUrl=Url
 End if
End Function

Function GetSearchKeyword(byval Url,byval KeyWordFlag)
 KeyWordFlag=KeyWordFlag&"="

 UrlArrary=Split(Url,KeyWordFlag)

 UrlTail=UrlArrary(1)
 If Instr(UrlTail,"&")=0 Then
  GetSearchKeyword=Mid(UrlTail,1,1000)
 Else
  GetSearchKeyword=Mid(UrlTail,1,Instr(UrlTail,"&")-1)
 End if
End Function


Function GetTurnTime(byval Num)
 Num=Cstr(Num)
 If Len(Num)=1 Then
  GetTurnTime="0"&Num
 Else
  GetTurnTime=Num
 End if
End Function


Function URLDecode(byval enStr)
  dim deStr
  dim c,i,v
  deStr=""
  for i=1 to len(enStr)
  c=Mid(enStr,i,1)
  if c="%" then
  v=eval("&h"+Mid(enStr,i+1,2))
  if v<128 then
  deStr=deStr&chr(v)
  i=i+2
  else
  if isvalidhex(mid(enstr,i,3)) then
  if isvalidhex(mid(enstr,i+3,3)) then
  v=eval("&h"+Mid(enStr,i+1,2)+Mid(enStr,i+4,2))
  deStr=deStr&chr(v)
  i=i+5
  else
  v=eval("&h"+Mid(enStr,i+1,2)+cstr(hex(asc(Mid(enStr,i+3,1)))))
  deStr=deStr&chr(v)
  i=i+3 
  end if 
  else 
  destr=destr&c
  end if
  end if
  else
  if c="+" then
  deStr=deStr&" "