qqcf_myfunction.asp

1.40种记数器图片样式自由选择

<%
'==================================
' 乘风多用户计数器v3.4
' 制　作：乘　风
' 网　站：http://www.qqcf.com
' 系统演示：http://www.qqcf.com/?action=try
' 最新版本下载：http://www.qqcf.com/?action=down
' 声 明:	
' 本软件系免费程序,提供给个人免费使用,但不提供服务和升级。
' 付费版提供升级服务和技术支持。
' 未经作者许可禁止用于任何商业用途。
' 乘风其它作品：乘风多用户计数器MsSql版、乘风多用户记数器php版、乘风免费电影程序、
'　　　　　　　 乘风网站推广系统、乘风网址程序，乘风广告管理、系统乘风论坛等。
' 此段版权注释不会影响网页打开速度，请勿删除!
'　　　　　　　　　　　2005年11月27日									
'===================================
%>
<%'以下为公用函数
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,"xp_cmdshell")>0 Then
  InputStr_2=Replace(InputStr_2,"xp_cmdshell","")
  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(TalbeName,FieldNmae,Fieldvalues,FieldType,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)
	end if
	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 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 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,100)
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&" "
  else
  deStr=deStr&c
  end if
  end if
  next
  URLDecode=deStr
  end function

  function isvalidhex(str)
  isvalidhex=true
  str=ucase(str)
  if len(str)<>3 then isvalidhex=false:exit function
  if left(str,1)<>"%" then isvalidhex=false:exit function
  c=mid(str,2,1)
  if not (((c>="0") and (c<="9")) or ((c>="A") and (c<="Z"))) then isvalidhex=false:exit function
  c=mid(str,3,1)
  if not (((c>="0") and (c<="9")) or ((c>="A") and (c<="Z"))) then isvalidhex=false:exit function
  end function
  

'解码出始
function UTF2GB(byval UTFStr) 
for Dig=1 to len(UTFStr) 
if mid(UTFStr,Dig,1)="%" then 
if len(UTFStr) >= Dig+8 then 
GBStr=GBStr & ConvChinese(mid(UTFStr,Dig,9)) 
Dig=Dig+8 
else 
GBStr=GBStr & mid(UTFStr,Dig,1) 
end if 
else 
GBStr=GBStr & mid(UTFStr,Dig,1) 
end if 
next 
UTF2GB=GBStr 
end function 

function ConvChinese(x) 
A=split(mid(x,2),"%") 
i=0 
j=0 

for i=0 to ubound(A) 
A(i)=c16to2(A(i)) 
next 

for i=0 to ubound(A)-1 
DigS=instr(A(i),"0") 
Unicode="" 
for j=1 to DigS-1 
if j=1 then 
A(i)=right(A(i),len(A(i))-DigS) 
Unicode=Unicode & A(i) 
else 
i=i+1 
A(i)=right(A(i),len(A(i))-2) 
Unicode=Unicode & A(i) 
end if 
next 

if len(c2to16(Unicode))=4 then 
ConvChinese=ConvChinese & chrw(int("&H" & c2to16(Unicode))) 
else 
ConvChinese=ConvChinese & chr(int("&H" & c2to16(Unicode))) 
end if 
next 
end function 

function c2to16(x) 
i=1 
for i=1 to len(x) step 4 
c2to16=c2to16 & hex(c2to10(mid(x,i,4))) 
next 
end function 

function c2to10(x) 
c2to10=0 
if x="0" then exit function 
i=0 
for i= 0 to len(x) -1 
if mid(x,len(x)-i,1)="1" then c2to10=c2to10+2^(i) 
next 
end function 

function c16to2(x) 
i=0 
for i=1 to len(trim(x)) 
tempstr= c10to2(cint(int("&h" & mid(x,i,1)))) 
do while len(tempstr)<4 
tempstr="0" & tempstr 
loop 
c16to2=c16to2 & tempstr 
next 
end function 

function c10to2(x) 
mysign=sgn(x) 
x=abs(x) 
DigS=1 
do 
if x<2^DigS then 
exit do 
else 
DigS=DigS+1 
end if 
loop 
tempnum=x 

i=0 
for i=DigS to 1 step-1 
if tempnum>=2^(i-1) then 
tempnum=tempnum-2^(i-1) 
c10to2=c10to2 & "1" 
else 
c10to2=c10to2 & "0" 
end if 
next 
if mysign=-1 then c10to2="-" & c10to2 
end function 
'解码结束

Function connclose()
Conn.Close
If IsObject(Rs)=True Then
 Rs.Close
 Set Rs=Nothing
End If

If IsObject(Rs2)=True Then
 Rs2.Close
 Set Rs2=Nothing
End If

If IsObject(qqcf)=True Then
 qqcf.Close
 Set qqcf=Nothing
End If

End Function
%>