<%
'乘风多用户计数器 MsSql版
'作者QQ：178575
'作者EMail：yliangcf@163.com
'作者网站：http://www.qqcf.com
'详细简介：http://www.qqcf.com/cfcount.htm
'上面有程序在线演示，安装演示，使用疑难解答，最新版本下载等内容
'因为这些内容可能时常更新，就没有放在程序里，请自己上网站上查看
'有完整版本的演示
%>
<%
'以下为公用函数

Function AlertRef(ByVal AlertStr)
	If InStr(AlertStr, "成功") > 0 Then
		AlertFlag = "success"
	ElseIf InStr(AlertStr, "请") > 0 Or InStr(AlertStr, "不能") > 0 Or InStr(AlertStr, "必须") > 0 Or InStr(AlertStr, "禁止") > 0 Or InStr(AlertStr, "只有") > 0 Or InStr(AlertStr, "输入") > 0 Or InStr(AlertStr, "填写") > 0 Or InStr(AlertStr, "错误") > 0 Or InStr(AlertStr, "有误") > 0 Or InStr(AlertStr, "不正常") > 0 Or InStr(AlertStr, "不存在") > 0 Or InStr(AlertStr, "不一致") > 0 Or InStr(AlertStr, "不一样") > 0 Or InStr(AlertStr, "不够") > 0 Then
		AlertFlag = "error"
	Else
		AlertFlag = "info"
	End If

	Response.Write("<!DOCTYPE HTML>")
	Response.Write("<link rel='stylesheet' href='css/BeAlert.css'>")
	Response.Write("<script src='js/jquery.min.js'></script>")
	Response.Write("<script src='js/BeAlert.js'></script>")

	Response.Write("<link rel='stylesheet' href='../css/BeAlert.css'>")
	Response.Write("<script src='../js/jquery.min.js'></script>")
	Response.Write("<script src='../js/BeAlert.js'></script>")

	Response.Write("<link rel='stylesheet' href='../../css/BeAlert.css'>")
	Response.Write("<script src='../../js/jquery.min.js'></script>")
	Response.Write("<script src='../../js/BeAlert.js'></script>")

		
	Response.Write("<script>")
	If AlertStr = "" Then
		If Request.ServerVariables("HTTP_REFERER") <> "" Then
			Response.Write("location.href='" & Request.ServerVariables("HTTP_REFERER") & "';")
		Else
			Response.Write("location.href='" & HttpPath(5) & "';")
		End If
	Else
		If Request.ServerVariables("HTTP_REFERER") <> "" Then
			Response.Write("$(function () { alert('" & AlertStr & "','', function () {location.href='" & Request.ServerVariables("HTTP_REFERER") & "';}, {type: '" & AlertFlag & "', confirmButtonText: '确定'});});")
		Else
			Response.Write("$(function () { alert('" & AlertStr & "','', function () {location.href='" & HttpPath(5) & "';}, {type: '" & AlertFlag & "', confirmButtonText: '确定'});});")
		End If
	End If
	Response.Write("</script>")
	Response.End()
End Function

Function GoBack(ByVal Str,ByVal AlertStr) '为空时后退
	If InStr(AlertStr, "成功") > 0 Then
		AlertFlag = "success"
	ElseIf InStr(AlertStr, "请") > 0 Or InStr(AlertStr, "不能") > 0 Or InStr(AlertStr, "必须") > 0 Or InStr(AlertStr, "禁止") > 0 Or InStr(AlertStr, "只有") > 0 Or InStr(AlertStr, "输入") > 0 Or InStr(AlertStr, "填写") > 0 Or InStr(AlertStr, "错误") > 0 Or InStr(AlertStr, "有误") > 0 Or InStr(AlertStr, "不正常") > 0 Or InStr(AlertStr, "不存在") > 0 Or InStr(AlertStr, "不一致") > 0 Or InStr(AlertStr, "不一样") > 0 Or InStr(AlertStr, "不够") > 0 Then
		AlertFlag = "error"
	Else
		AlertFlag = "info"
	End If
	
	If Str = "" Then
        Response.Write("<!DOCTYPE HTML>")
        Response.Write("<link rel='stylesheet' href='css/BeAlert.css'>")
        Response.Write("<script src='js/jquery.min.js'></script>")
        Response.Write("<script src='js/BeAlert.js'></script>")
		
        Response.Write("<link rel='stylesheet' href='../css/BeAlert.css'>")
        Response.Write("<script src='../js/jquery.min.js'></script>")
        Response.Write("<script src='../js/BeAlert.js'></script>")
		
        Response.Write("<link rel='stylesheet' href='../../css/BeAlert.css'>")
        Response.Write("<script src='../../js/jquery.min.js'></script>")
        Response.Write("<script src='../../js/BeAlert.js'></script>")

		Response.Write("<script>")
		If AlertStr = "" Then
			Response.Write("history.go(-1)")
		Else
			Response.Write("$(function () { alert('" & AlertStr & "','', function () {history.go(-1);}, {type: '" & AlertFlag & "', confirmButtonText: '确定'});});")
		End If
		Response.Write("</script>")
		Response.End()
	Else
		GoBack = Str
	End If
End Function

Function AlertBack(ByVal AlertStr,ByVal BackNum)
	If InStr(AlertStr, "成功") > 0 Then
		AlertFlag = "success"
	ElseIf InStr(AlertStr, "请") > 0 Or InStr(AlertStr, "不能") > 0 Or InStr(AlertStr, "必须") > 0 Or InStr(AlertStr, "禁止") > 0 Or InStr(AlertStr, "只有") > 0 Or InStr(AlertStr, "输入") > 0 Or InStr(AlertStr, "填写") > 0 Or InStr(AlertStr, "错误") > 0 Or InStr(AlertStr, "有误") > 0 Or InStr(AlertStr, "不正常") > 0 Or InStr(AlertStr, "不存在") > 0 Or InStr(AlertStr, "不一致") > 0 Or InStr(AlertStr, "不一样") > 0 Or InStr(AlertStr, "不够") > 0 Then
		AlertFlag = "error"
	Else
		AlertFlag = "info"
	End If
	
	Response.Write("<!DOCTYPE HTML>")
	Response.Write("<link rel='stylesheet' href='css/BeAlert.css'>")
	Response.Write("<script src='js/jquery.min.js'></script>")
	Response.Write("<script src='js/BeAlert.js'></script>")
	
	Response.Write("<link rel='stylesheet' href='../css/BeAlert.css'>")
	Response.Write("<script src='../js/jquery.min.js'></script>")
	Response.Write("<script src='../js/BeAlert.js'></script>")
	
	Response.Write("<link rel='stylesheet' href='../../css/BeAlert.css'>")
	Response.Write("<script src='../../js/jquery.min.js'></script>")
	Response.Write("<script src='../../js/BeAlert.js'></script>")

	Response.Write("<script>")
	If AlertStr = "" Then
		Response.Write("history.go(-" & BackNum & ");")
	Else
		Response.Write("$(function () { alert('" & AlertStr & "','', function () {history.go(-" & BackNum & ");}, {type: '" & AlertFlag & "', confirmButtonText: '确定'});});")
	End If
	Response.Write("</script>")
	Response.End()
End Function

Function AlertUrl(ByVal AlertStr,ByVal Url)
	If InStr(AlertStr, "成功") > 0 Then
		AlertFlag = "success"
	ElseIf InStr(AlertStr, "请") > 0 Or InStr(AlertStr, "不能") > 0 Or InStr(AlertStr, "必须") > 0 Or InStr(AlertStr, "禁止") > 0 Or InStr(AlertStr, "只有") > 0 Or InStr(AlertStr, "输入") > 0 Or InStr(AlertStr, "填写") > 0 Or InStr(AlertStr, "错误") > 0 Or InStr(AlertStr, "有误") > 0 Or InStr(AlertStr, "不正常") > 0 Or InStr(AlertStr, "不存在") > 0 Or InStr(AlertStr, "不一致") > 0 Or InStr(AlertStr, "不一样") > 0 Or InStr(AlertStr, "不够") > 0 Then
		AlertFlag = "error"
	Else
		AlertFlag = "info"
	End If
	
	Response.Write("<!DOCTYPE HTML>")
	Response.Write("<link rel='stylesheet' href='css/BeAlert.css'>")
	Response.Write("<script src='js/jquery.min.js'></script>")
	Response.Write("<script src='js/BeAlert.js'></script>")
	
	Response.Write("<link rel='stylesheet' href='../css/BeAlert.css'>")
	Response.Write("<script src='../js/jquery.min.js'></script>")
	Response.Write("<script src='../js/BeAlert.js'></script>")
	
	Response.Write("<link rel='stylesheet' href='../../css/BeAlert.css'>")
	Response.Write("<script src='../../js/jquery.min.js'></script>")
	Response.Write("<script src='../../js/BeAlert.js'></script>")

	Response.Write("<script>")
	If AlertStr = "" Then
		If Url <> "" Then
			Response.Write("location.href='" & Url & "';")
		Else
			Response.Write("location.href='" & HttpPath(5) & "';")
		End If
	Else
		If Url <> "" Then
			Response.Write("$(function () { alert('" & AlertStr & "','', function () {location.href='" & Url & "';}, {type: '" & AlertFlag & "', confirmButtonText: '确定'});});")
		Else
			Response.Write("$(function () { alert('" & AlertStr & "','', function () {location.href='" & HttpPath(5) & "';}, {type: '" & AlertFlag & "', confirmButtonText: '确定'});});")
		End If
	End If
	Response.Write("</script>")
	Response.End()
End Function

Function AlertClose(ByVal AlertStr)
	If InStr(AlertStr, "成功") > 0 Then
		AlertFlag = "success"
	ElseIf InStr(AlertStr, "请") > 0 Or InStr(AlertStr, "不能") > 0 Or InStr(AlertStr, "必须") > 0 Or InStr(AlertStr, "禁止") > 0 Or InStr(AlertStr, "只有") > 0 Or InStr(AlertStr, "输入") > 0 Or InStr(AlertStr, "填写") > 0 Or InStr(AlertStr, "错误") > 0 Or InStr(AlertStr, "有误") > 0 Or InStr(AlertStr, "不正常") > 0 Or InStr(AlertStr, "不存在") > 0 Or InStr(AlertStr, "不一致") > 0 Or InStr(AlertStr, "不一样") > 0 Or InStr(AlertStr, "不够") > 0 Then
		AlertFlag = "error"
	Else
		AlertFlag = "info"
	End If
	
	Response.Write("<!DOCTYPE HTML>")
	Response.Write("<link rel='stylesheet' href='css/BeAlert.css'>")
	Response.Write("<script src='js/jquery.min.js'></script>")
	Response.Write("<script src='js/BeAlert.js'></script>")
	
	Response.Write("<link rel='stylesheet' href='../css/BeAlert.css'>")
	Response.Write("<script src='../js/jquery.min.js'></script>")
	Response.Write("<script src='../js/BeAlert.js'></script>")
	
	Response.Write("<link rel='stylesheet' href='../../css/BeAlert.css'>")
	Response.Write("<script src='../../js/jquery.min.js'></script>")
	Response.Write("<script src='../../js/BeAlert.js'></script>")

	Response.Write("<script>")
	If AlertStr = "" Then
	 Response.Write("window.close();")
	Else
	 Response.Write("$(function () { alert('" & AlertStr & "','', function () {window.close();;}, {type: '" & AlertFlag & "', confirmButtonText: '确定'});});")
	End If
	
	Response.Write("</script>")
	Response.End() 
End Function

Function GotoUrl(ByVal url) 
  response.write "<script>" 
  response.write "location.href='"&url&"';" 
  response.write "</script>" 
  response.end 
End Function

Function CheckInput_Letter(ByVal InputStr) '检查用户名输入的合法性
	CheckInput_Letter = -1

	For I = 1 To Len(InputStr)
		C = LCase(Mid(InputStr, I, 1)) '------------分割成每个字母或数字------------------
		If InStr("abcdefghijklmnopqrstuvwxyz_", C) <= 0 And Not IsNumeric(C) Then
			CheckInput_Letter = 0
			Exit For
		End If
	Next
End Function

function checkinput_blank(ByVal 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(ByVal ParaValue,ByVal ParaType)
 If ParaType = 0 then
  ChkStr = Replace(ParaValue,"'","''")
 ElseIf ParaType = 1 then
  dim re,regex
  re="<[^>]*?>|^\+/v(8|9)|\bonmouse(over|move)=\b|\b(and|or)\b.+?(>|<|=|\bin\b|\blike\b)|/\*.+?\*/|<\s*script\b|\bEXEC\b|UNION.+?SELECT|UPDATE.+?SET|INSERT\s+INTO.+?VALUES|(SELECT|DELETE).+?FROM|(CREATE|ALTER|DROP|TRUNCATE)\s+(TABLE|DATABASE)"
  set regex = new regexp
  regex.ignorecase = true
  regex.global = true
  regex.pattern = re
  if regex.test(ParaValue) then
   Response.Write("字符类型参数传递的值有错误!")
   Response.end
  end if
  set regex = nothing
  ChkStr = Replace(ParaValue,"'","''")
 ElseIf ParaType = 2 then
  If ParaValue<>"" And (IsNumeric(ParaValue) = False) then
   Response.Write "数值类型参数传递的值有错误!"
   Response.End
  Else
   ChkStr = ParaValue
  End If
 ElseIf ParaType = 3 then
  If ParaValue<>"" And (IsDate(ParaValue) = False) then
   Response.Write "时间类型参数传递的值有错误!"
   Response.End
  Else
   ChkStr = ParaValue
  End If
 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)
	end if
	FieldValues.close
End function

Function FSOFileRead(ByVal filename)
Dim objFSO,objCountFile,FiletempData
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objCountFile = objFSO.OpenTextFile(Server.MapPath(filename),1,True)
FSOFileRead = objCountFile.ReadAll
objCountFile.Close
Set objCountFile=Nothing
Set objFSO = Nothing
End Function

Function MyRate(ByVal snum,ByVal bnum)
If snum>0 Then
 MyRate=formatnumber(snum/bnum*100,2,-1)
Else
 MyRate=0
End If
End Function

Function MyRate_2(ByVal 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

'--获取当前页的网址信息
'http://www.a.com:100/b/c.asp?aa=1&bb=2
'1.www.a.com
'2.http://www.a.com:100/b/
'3.http://www.a.com:100/b/c.asp
'4.http://www.a.com:100/b/c.asp?aa=1&bb=2
'5./b/
'6./b/c.asp
'7./b/c.asp?aa=1&bb=2
Function HttpPath(ByVal Assort)
 If Request.ServerVariables("HTTPS")="on" Then HttpStr="https://" else HttpStr="http://" end if
 If Request.ServerVariables("QUERY_STRING")<>"" Then UrlStr="?"&Request.ServerVariables("QUERY_STRING")
 
 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
  TempStr=Ser 
 ElseIf Assort=2 Then
  If Port="80" or Port = "443" Then
   TempStr=HttpStr&Ser&Scr_2
  Else   
   TempStr=HttpStr&Ser&":"&Port&Scr_2
  End If 
 ElseIf Assort=3 Then
  If Port="80" or Port = "443" Then
   TempStr=HttpStr&Ser&Scr
  Else
   TempStr=HttpStr&Ser&":"&Port&Scr
  End If
 ElseIf Assort=4 Then
  If Port="80" or Port = "443" Then
   TempStr=HttpStr&Ser&Scr&UrlStr
  Else
   TempStr=HttpStr&Ser&":"&Port&Scr&UrlStr
  End If
 ElseIf Assort=5 Then
  TempStr=Scr_2
 ElseIf Assort=6 Then
  TempStr=Scr
 ElseIf Assort=7 Then 
  TempStr=Scr&UrlStr
 End If
 
 HttpPath = ChkStr(TempStr,1)
End Function



Function PxFilter(ByVal px,ByVal 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<>"" And Instr(Url,"/")>0 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=Server.HTMLEncode(Mid(UrlTail,1,1000))
Else
 GetSearchKeyword=Server.HTMLEncode(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 GetOsType()

        AgentInfo = lcase(Request.ServerVariables("HTTP_USER_AGENT"))

         If InStr(AgentInfo, "micromessenger") > 0 Then
            OsType = "微信"

        ElseIf InStr(AgentInfo, "android") > 0 Then
            OsType = "安卓"

        ElseIf InStr(AgentInfo, "iphone") > 0 Then
            OsType = "iPhone"

        ElseIf InStr(AgentInfo, "ipad") > 0 Then
            OsType = "iPad"

        ElseIf InStr(AgentInfo, "nt 10") > 0 Then
            OsType = "Windows 10"

        ElseIf InStr(AgentInfo, "nt 6.4") > 0 Then
            OsType = "Windows 10"

        ElseIf InStr(AgentInfo, "nt 6.3") > 0 Then
            OsType = "Windows 8"

        ElseIf InStr(AgentInfo, "nt 6.2") > 0 Then
            OsType = "Windows 8"

        ElseIf InStr(AgentInfo, "nt 6.1") > 0 Then
            OsType = "Windows 7"

        ElseIf InStr(AgentInfo, "nt 6.0") > 0 Then
            OsType = "Windows Vista"

        ElseIf InStr(AgentInfo, "nt 5.2") > 0 Then
            OsType = "Windows 2003"

        ElseIf InStr(AgentInfo, "nt 5.1") > 0 Then
            OsType = "Windows XP"

        ElseIf InStr(AgentInfo, "nt") > 0 Then
            OsType = "Windows"

        ElseIf InStr(AgentInfo, "mac") > 0 Then
            OsType = "mac"

        ElseIf InStr(AgentInfo, "unix") > 0 Then
            OsType = "Unix"

        ElseIf InStr(AgentInfo, "linux") > 0 Then
            OsType = "Linux"

        ElseIf InStr(AgentInfo, "sunos") > 0 Then
            OsType = "SunOS"

        Else
            OsType = "其他"

        End If

        GetOsType = OsType
    End Function


    Function GetBrowserType()

        AgentInfo = lcase(Request.ServerVariables("HTTP_USER_AGENT"))

        If InStr(LCase(AgentInfo), "se 2.x") > 0 Then
            BrowserType = "搜狗"

        ElseIf InStr(AgentInfo, "maxthon") > 0 Then
            BrowserType = "遨游"

        ElseIf InStr(AgentInfo, "360se") > 0 Then
            BrowserType = "360"

        ElseIf InStr(AgentInfo, "taobrowser") > 0 Then
            BrowserType = "淘宝"

        ElseIf InStr(AgentInfo, "lbbrowser") > 0 Then
            BrowserType = "猎豹"

        ElseIf InStr(AgentInfo, "ucbrowser") > 0 Then
            BrowserType = "UC"

        ElseIf InStr(AgentInfo, "tencenttraveler") > 0 Then
            BrowserType = "腾讯"

        ElseIf InStr(AgentInfo, "firefox") > 0 Then
            BrowserType = "火狐"

        ElseIf InStr(AgentInfo, "115browser") > 0 Then
            BrowserType = "115浏览器"

        ElseIf InStr(AgentInfo, "theworld") > 0 Then
            BrowserType = "世界之窗"

        ElseIf InStr(AgentInfo, "opera") > 0 Then
            BrowserType = "Opera"

        ElseIf InStr(AgentInfo, "chrome") > 0 Then
            BrowserType = "Chrome"

        ElseIf InStr(AgentInfo, "safar") > 0 Then
            BrowserType = "Safar"

        ElseIf InStr(AgentInfo, "greenbrowser") > 0 Then
            BrowserType = "GreenBrowser"

        ElseIf InStr(AgentInfo, "msie 6.0") > 0 Then
            BrowserType = "IE 6.0"

        ElseIf InStr(AgentInfo, "msie 7.0") > 0 Then
            BrowserType = "IE 7.0"

        ElseIf InStr(AgentInfo, "msie 8.0") > 0 Then
            BrowserType = "IE 8.0"

        ElseIf InStr(AgentInfo, "msie 9.0") > 0 Then
            BrowserType = "IE 9.0"

        ElseIf InStr(AgentInfo, "msie 10.0") > 0 Then
            BrowserType = "IE 10.0"

        ElseIf InStr(AgentInfo, "rv:11") > 0 Then
            BrowserType = "IE 11.0"

        ElseIf InStr(AgentInfo, "msie") > 0 Then
            BrowserType = "IE"

        Else
            BrowserType = "其它"

        End If

        GetBrowserType = BrowserType

    End Function

Function GetAppChange(ByVal UserName,ByVal IP,ByVal CFCountVisitTotal,ByVal Currweb,ByVal AgentStr,ByVal WebTitle)
 MyArray=Split(Application("CFCountLy_"&UserName),"|")
 For I=0 To Ubound(MyArray)-1
  If Instr(MyArray(I),IP)=0 Then
   AllStr=AllStr&MyArray(I)&"|"
  Else
   MyArray_2=Split(MyArray(I),"\")
   MyStr=Ip&"\"&CFCountVisitTotal&"\"&MyArray_2(2)&"\"&MyArray_2(3)&"\"&Now()&"\"&CurrWeb&"\"&AgentStr&"\"&I&"\"&MyArray_2(7)&"\"&MyArray_2(8)&"\"&MyArray_2(9)&"\"&MyArray_2(10)&"\"&MyArray_2(11)&"\"&WebTitle&"|"
   AllStr=AllStr&MyStr
  End if
 Next
   
 GetAppChange=AllStr
End Function

Function GetAppChange_2(ByVal UserName,ByVal IP,ByVal CFCountVisitTotal,ByVal Currweb,ByVal AgentStr,ByVal WebTitle,ByVal OnlineTime)
 MyArray=Split(Application("CFCountOnline_"&UserName),"|")
 
 If Ubound(Myarray)>1000 Then K=1'只保留1000条记录
 J=0
 For I=K To Ubound(MyArray)-1
  MyArray_2=Split(MyArray(I),"\")
  If Instr(MyArray(I),IP)>0 And J=0 Then   
   MyStr=Ip&"\"&CFCountVisitTotal&"\"&MyArray_2(2)&"\"&MyArray_2(3)&"\"&Now()&"\"&CurrWeb&"\"&AgentStr&"\"&CLng(MyArray_2(7))+1&"\"&MyArray_2(8)&"\"&MyArray_2(9)&"\"&MyArray_2(10)&"\"&MyArray_2(11)&"\"&MyArray_2(12)&"\"&WebTitle&"|"
   AllStr=AllStr&MyStr
   J=1
  Else
   If Ubound(MyArray_2)=12 Then
    If DateDiff("n",Cdate(MyArray_2(4)),Now())<=OnlineTime Then AllStr=AllStr&MyArray(I)&"|"
   End If
  End if
 Next
   
 GetAppChange_2=AllStr
End Function

function GetUnicode(Str) 
  dim i 
  dim Str_one 
  dim Str_unicode 
  if(isnull(Str)) then
     exit function
  end if
  for i=1 to len(Str) 
    Str_one=Mid(Str,i,1) 
    Str_unicode=Str_unicode&chr(38) 
    Str_unicode=Str_unicode&chr(35) 
    Str_unicode=Str_unicode&chr(120) 
    Str_unicode=Str_unicode& Hex(ascw(Str_one)) 
    Str_unicode=Str_unicode&chr(59) 
  next 
  GetUnicode=Str_unicode 
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 GetIpArea(ByVal Ip)
inIP=Ip
inIPs=split(inIP,".")
if ubound(inIPs)=3 Then
inIPnum=inips(0)*256*256*256 + inips(1)*256*256 + inips(2)*256 + inips(3)
Else
inIPnum=0
End If

Sql="Select Area,Area_2,Area_3 from CFCount_IpAddress where Ip_1<="&inIPnum&" and Ip_2>="&inIPnum
set RsIp=Conn.Execute(Sql)

If Not RsIp.Eof Then
 GetIpArea= RsIp("Area")&"-"&RsIp("Area_2")&"-"&RsIp("Area_3")
Else
  GetIpArea= "未知地区"
End If
RsIp.Close
End Function

Function GetPicStyle(ByVal UserName)
Sql="Select * From CFCount_User Where UserName='"&UserName&"'"
Set RsPicStyle= Server.CreateObject("Adodb.RecordSet")
RsPicStyle.Open Sql,Conn,1,1
If RsPicStyle("ShowType")=1 Then
 Counter=RsPicStyle("ShowTotal")
ElseIf RsPicStyle("ShowType")=2 Then
 Counter=RsPicStyle("RealShowTotal")
ElseIf RsPicStyle("ShowType")=3 Then
 Counter=RsPicStyle("RealIpTotal")
End if   
CountLen=Len(Counter)
ZeroNum=RsPicStyle("PicNum")-CountLen

For I=1 To ZeroNum
 LinkUrl="CounterPic/"&RsPicStyle("Style")&"/0"
 CounterHtm=CounterHtm&"<img src="&LinkUrl&".gif border='0'>"
Next
For I=1 To CountLen
 Pic=Mid(Counter,I,1)
 LinkUrl="CounterPic/"&RsPicStyle("Style")&"/"&Pic
 CounterHtm=CounterHtm&"<img src="&LinkUrl&".gif border='0'>"
Next
GetPicStyle=CounterHtm
RsPicStyle.Close
End Function

Function GetWeek(ByVal Mydate)
weeknum = weekDay(Mydate)
select case weeknum
 case "1"
  data="星期天"
 case "2"
  data="星期一"
 case "3"
  data="星期二"
 case "4"
  data="星期三"
 case "5"
  data="星期四"
 case "6"
  data="星期五"
 case "7"
  data="星期六"
 case else
  data="错误的时间"
end select
GetWeek=data
End Function


Function GetTurnCent(byval Num)
 Num = CStr (Num)

 If Left(Num,1)="." Then Num="0" & Num

 GetTurnCent = Num
End Function


Function GetRanStr(ByVal digits)
        Dim output
        Dim Num
        Dim char_array(35)
        char_array(0) = "0"
        char_array(1) = "1"
        char_array(2) = "2"
        char_array(3) = "3"
        char_array(4) = "4"
        char_array(5) = "5"
        char_array(6) = "6"
        char_array(7) = "7"
        char_array(8) = "8"
        char_array(9) = "9"
        char_array(10) = "a"
        char_array(11) = "b"
        char_array(12) = "c"
        char_array(13) = "d"
        char_array(14) = "e"
        char_array(15) = "f"
        char_array(16) = "g"
        char_array(17) = "h"
        char_array(18) = "i"
        char_array(19) = "j"
        char_array(20) = "k"
        char_array(21) = "l"
        char_array(22) = "m"
        char_array(23) = "n"
        char_array(24) = "o"
        char_array(25) = "p"
        char_array(26) = "q"
        char_array(27) = "r"
        char_array(28) = "s"
        char_array(29) = "t"
        char_array(30) = "u"
        char_array(31) = "v"
        char_array(32) = "w"
        char_array(33) = "x"
        char_array(34) = "y"
        char_array(35) = "z"

 output=""
 num=""

        Randomize()
        Do While Len(output) < digits
            Num = char_array(Int(36*Rnd))
            output = output + Num
        Loop

        GetRanStr = output
    End Function

Function GetRanStr_2(ByVal digits) 
 dim char_array_2(9)
 char_array_2(0) = "0"
 char_array_2(1) = "1"
 char_array_2(2) = "2"
 char_array_2(3) = "3"
 char_array_2(4) = "4"
 char_array_2(5) = "5"
 char_array_2(6) = "6"
 char_array_2(7) = "7"
 char_array_2(8) = "8"
 char_array_2(9) = "9"

 randomize
 do while len(output_2)<digits
 num_2 = char_array_2(Int(10*Rnd))
 output_2 = output_2 + num_2
 loop
 GetRanStr_2 = output_2
End Function


Function GetRanStr_3(ByVal digits)


        Dim output_3
        Dim Num_3
        Dim char_array_3(25)
        char_array_3(0) = "a"
        char_array_3(1) = "b"
        char_array_3(2) = "c"
        char_array_3(3) = "d"
        char_array_3(4) = "e"
        char_array_3(5) = "f"
        char_array_3(6) = "g"
        char_array_3(7) = "h"
        char_array_3(8) = "i"
        char_array_3(9) = "j"
        char_array_3(10) = "k"
        char_array_3(11) = "l"
        char_array_3(12) = "m"
        char_array_3(13) = "n"
        char_array_3(14) = "o"
        char_array_3(15) = "p"
        char_array_3(16) = "q"
        char_array_3(17) = "r"
        char_array_3(18) = "s"
        char_array_3(19) = "t"
        char_array_3(20) = "u"
        char_array_3(21) = "v"
        char_array_3(22) = "w"
        char_array_3(23) = "x"
        char_array_3(24) = "y"
        char_array_3(25) = "z"


        Randomize()

        Do While Len(output_3) < digits
            Num_3 = char_array_3(Int(26 * Rnd))

            output_3 = output_3 + Num_3
        Loop

        GetRanStr_3 = output_3
    End Function

Function DollarConVert(ByVal MyCent)
 MyCent=Cstr(MyCent)
 If Instr(MyCent,".")=1 Then MyCent="0"&MyCent
 If Len(MyCent)=3 Then MyCent=MyCent&"0"
 If MyCent="0" Then MyCent="0.00"
 DollarConVert=MyCent
End Function

Function GetStr(ByVal App, ByVal MyStr)
 GetStr = ""
 MyStr_1 = "|-|" & App & "|-|"
 MyStr_2 = ""
 I_Str=0

 I_Str = InStr(LCase(MyStr_1), "|-|" & LCase(MyStr) & "=")
 If I_Str > 0 Then
  MyStr_2 = Mid(MyStr_1, I_Str + Len(MyStr) + 4)
  GetStr = Left(MyStr_2, InStr(MyStr_2, "|-|") - 1)
 End If
End Function

Function GetStrB(ByVal App, ByVal MyStr, ByVal SpanNum)
 GetStrB = ""
 I_StrB = 0
 SplitStr = ""

 For I_StrB = 1 To SpanNum
  SplitStr = SplitStr & "-"
 Next

 GetStrB = ""
 MyStr_1 = "|" & SplitStr & "|" & App & "|" & SplitStr & "|"
 MyStr_2 = ""
 
 I_StrB = 0
 I_StrB = InStr(LCase(MyStr_1), "|" & SplitStr & "|" & LCase(MyStr) & "=")
 If I_StrB > 0 Then
  MyStr_2 = Mid(MyStr_1, I_StrB + Len(MyStr) + 3 + SpanNum)
  GetStrB = Left(MyStr_2, InStr(MyStr_2, "|" & SplitStr & "|") - 1)
 End If
End Function
	
Function GetAllFlagSet(ByVal AppName, ByVal SetBClassFlag, ByVal SetFlag, ByVal SetName)
 If AppName="" Then
   Sql = "Select SetValue From CFCount_SetBClass Where SetBClassFlag='" & SetBClassFlag & "'"
   Set Rs_MySet = Conn.Execute(Sql)
   SetValue = Rs_MySet("SetValue")
   Rs_MySet.Close
 Else
  If IsEmpty(Application(AppName)) Then
   Sql = "Select SetValue From CFCount_SetBClass Where SetBClassFlag='" & SetBClassFlag & "'"
   Set Rs_MySet = Conn.Execute(Sql)
   Application(AppName) = Rs_MySet("SetValue")
   Rs_MySet.Close
  End If
  SetValue = Application(AppName)
 End If

 '--格式为"主标志_字段"格式
 SetName = SetFlag & "_" & SetName
 
 GetAllFlagSet=GetStr(SetValue, SetName)
End Function

Function GetSkinColor(byval SkinColor,byval Assort)
 MyArray_SkinColor=Split(SkinColor,"|")
 If Assort<=Ubound(MyArray_SkinColor) Then
  GetSkinColor=MyArray_SkinColor(Assort)
 End If
End Function

'--隐藏用户名的后两位
Function GetHiddenUserName(byval StrUserName)
 If Len(StrUserName)=0 Then
  GetHiddenUserName=StrUserName
 ElseIf Len(StrUserName)=1 Then
  GetHiddenUserName="*"
 ElseIf Len(StrUserName)=2 Then
  GetHiddenUserName=Left(StrUserName,1)&"*"
 ElseIf Len(StrUserName)>=3 Then
  GetHiddenUserName=Left(StrUserName,Len(StrUserName)-2)&"**"
 End If 
End Function


'--获取登录
Function GetUserLogin(ShowWidth,ShowWidth_2)
UserLoginStr="<script>"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"$(function(){"	&Chr(13)&Chr(10)

UserLoginStr=UserLoginStr&"$('#ccimg').click(function(){"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&" $('#ccimg').prop('src','Include/CheckCode.asp?RanStr=' + Math.random())"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"}); "	&Chr(13)&Chr(10)

UserLoginStr=UserLoginStr&" $(""#login"").click(function(){"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"  var username = $(""#username"").val();"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"  var pwd = $(""#pwd"").val();"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"  var cookies_time = $(""#cookies_time"").val();"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"  var checkcode = $(""#checkcode"").val();"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&""	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&" if(username==""""){"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"  alert('请输入用户名', '', function () {$('#username').focus();});"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"  return false;"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&" }"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&""	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&" if(pwd==""""){"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"  alert('请输入密码', '', function () {$('#pwd').focus();});"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"  return false;"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&" }"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&""	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&" if(checkcode==""""){"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"  alert('请输入验证码', '', function () {$('#checkcode').focus();});"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"  return false;"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&" }"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&""	&Chr(13)&Chr(10)

UserLoginStr=UserLoginStr&"var checkcode = $(""#checkcode"").val();"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"var checkvalid = 1;"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"$.ajax({url: ""?"",type: ""post"",async: false,data:""action=checkcodechecksave&checkcode=""+checkcode,success: function(response){"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"   if(response.indexOf(""错误"")>=0){"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"	   checkvalid=0;"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"   }"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"  }});"	&Chr(13)&Chr(10)

UserLoginStr=UserLoginStr&"if(checkvalid==0){"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&" alert('验证码输入错误', '', function () {$('#checkcode').focus();});"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&" return false;"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"}"	&Chr(13)&Chr(10)


UserLoginStr=UserLoginStr&" });"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"});"	&Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"</script>"	&Chr(13)&Chr(10)

UserLoginStr=UserLoginStr&"<table style=""width:"&ShowWidth&";margin:0px auto;"" id='userlogin'>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<form method=""POST"" action=""?Action=userloginsave"" name=""form2"">"	& Chr(13)&Chr(10)
If Session("CFCountUser")="" Then
UserLoginStr=UserLoginStr&"<tr>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<td style=""width:70px"" >用户名：</td>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<td><INPUT name=username id=username value="""&Request("UserName")&""" size=15 style=""width:"&ShowWidth_2&";""></td>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"</tr>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<tr>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<td>密&nbsp;&nbsp;码：</td>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<td><INPUT id=pwd type=password size=15 name=pwd style=""width:"&ShowWidth_2&";""></td>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"</tr>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<tr>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<td>Cookies：</td>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<td><select name=""cookies_time"" id=""cookies_time"" style=""width:"&ShowWidth_2&";"">"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<option value=""60"" selected>不保留</option>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<option value=""1440"">保留一天</option>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<option value=""10080"">保留一周</option>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<option value=""43200"">保留一个月</option>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"</select></td>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"</tr>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<tr>"	& Chr(13)&Chr(10) 
UserLoginStr=UserLoginStr&"<td>验证码：</td>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<td>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<INPUT name=checkcode type=text id=checkcode value="""" size=4 autoComplete=""off"">"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<a href=""javascript:""><IMG id=""ccimg"" src=""Include/CheckCode.asp?RanStr="&Now&""" title=""看不清楚，换一个！"" width=""56"" height=""14""></a>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"</td>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"</tr>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<tr>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<td><a href=""PwdRecover.asp"">忘记密码</a></td>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<td>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<INPUT type=image name=login id=login src=""images/login.gif"" style=""width:53px;height:21px;border:0px"">"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"&nbsp;<a href=""Reg.asp""><img src=""images/reg.gif"" border=0></a></td>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"</tr>"	& Chr(13)&Chr(10)
Else
UserLoginStr=UserLoginStr&"<tr><td style='text-align:center;padding:10px;'><a href='User.asp'><img src='images/manage.gif' border=0></a></td></tr>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<tr><td style='text-align:center;padding:10px;'><a href='User.asp?Action=userlogout' onClick=""return confirm('确定要退出管理吗?')""><img src='images/logout.gif' border=0></a></td></tr>"	& Chr(13)&Chr(10)
End If
UserLoginStr=UserLoginStr&"</form>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"</table>"	& Chr(13)&Chr(10)

GetUserLogin=UserLoginStr
End Function

'--获取最后注册的用户
Function GetUserLast(ByVal ShowWidth,ByVal ShowNum)
UserLastStr="<table style=""width:"&ShowWidth&";margin:0px auto;"" id='userlast'>"
UserLastStr=UserLastStr&"<td style=""width:70px"">用户名</td>"
UserLastStr=UserLastStr&"<td>注册日期</td>"
UserLastStr=UserLastStr&"</tr>"
Sql="Select Top "&ShowNum&" * From CFCount_User Order By AddTime Desc,ID Desc"
Set Rs=Conn.Execute(Sql)
While Not Rs.Eof
UserLastStr=UserLastStr&"<tr>"
UserLastStr=UserLastStr&"<td>"&GetHiddenUserName(Rs("UserName"))&"</td>"
UserLastStr=UserLastStr&"<td>"&year(Rs("AddTime"))&"-"&month(Rs("AddTime"))&"-"&day(Rs("AddTime"))&"</td>"
UserLastStr=UserLastStr&"</tr>"
Rs.MoveNext
Wend
UserLastStr=UserLastStr&"</table>"

GetUserLast=UserLastStr
End Function

'--获取最近的公告
Function GetInfoLast(ByVal ShowWidth,ByVal ShowNum)
InfoLastStr="<table style=""width:"&ShowWidth&";margin-left:5px"" id='infolast'>"
Sql="Select Top "&ShowNum&" * From CFCount_SysInfo Order By ID Desc"
Set Rs=Conn.Execute(Sql)
While Not Rs.Eof
InfoLastStr=InfoLastStr&"<tr>"
InfoLastStr=InfoLastStr&"<td>"
InfoLastStr=InfoLastStr&rs("AddDate")&"&nbsp;&nbsp;<a href=""infoshow.asp?ID="&Rs("ID")&""" target=""_blank"">"&Rs("Title")&"</a>"
InfoLastStr=InfoLastStr&"</td>"
InfoLastStr=InfoLastStr&"</tr>"
Rs.MoveNext
Wend
InfoLastStr=InfoLastStr&"</table>"
GetInfoLast=InfoLastStr
End Function

'--获取全部公告
Function GetInfoAll(ByVal ShowWidth,ByVal ShowNum)
InfoAllStr="<table style=""width:"&ShowWidth&";margin-left:5px"" id='infoall'>"

Sql="Select * From CFCount_SysInfo Order By ID Desc"
Set Rs=Server.CreateObject("Adodb.RecordSet")
Rs.open Sql,Conn,1,1

If Not Rs.eof then
 Rs.pagesize=20
 TotalRs=Rs.RecordCount
 TotalPage=Rs.PageCount
 MyPageSize=Rs.PageSize
 Page=CLng(ChkStr(Request("Page"),2))
 If Page<=0 Then Page=1
 If Page>TotalPage Then Page=TotalPage
 Rs.AbsolutePage=Page
End If

While Not Rs.Eof And MyPageSize>0

InfoAllStr=InfoAllStr&"<tr>"
InfoAllStr=InfoAllStr&"<td>"
InfoAllStr=InfoAllStr&rs("AddDate")&"&nbsp;&nbsp;<a href=""infoshow.asp?ID="&Rs("ID")&""" target=""_blank"">"&Rs("Title")&"</a>"

InfoAllStr=InfoAllStr&"</td>"
InfoAllStr=InfoAllStr&"</tr>"

MyPageSize=MyPageSize-1
Rs.MoveNext
Wend
Rs.Close

InfoAllStr=InfoAllStr&"</table>"&GetPageList(TotalRs,TotalPage,Page,PageUrl,Px)


GetInfoAll=InfoAllStr

End Function


'--获取公告显示
Function GetInfoShow(ByVal ShowWidth)
ID=Goback(ChkStr(Request("ID"),2),"请输入ID号")

Sql="Select * From CFCount_SysInfo Where ID="&ID
Set Rs=Conn.Execute(Sql)
	
InfoShowStr="<table style=""width:"&ShowWidth&";margin:0px auto;"" id='infoshow'>"
InfoShowStr=InfoShowStr&"<tr style=""font-weight:bold;font-size:14px;"">"
InfoShowStr=InfoShowStr&"<td class='td_2'>"&Rs("Title")&"</td>"
InfoShowStr=InfoShowStr&"</tr>"
InfoShowStr=InfoShowStr&"<tr style=""text-align:center;"">"
InfoShowStr=InfoShowStr&"<td class=""td_2"">发布时间："&Rs("AddDate")&"</td>"
InfoShowStr=InfoShowStr&"</tr>"
InfoShowStr=InfoShowStr&"<tr>"
InfoShowStr=InfoShowStr&"<td>"&Rs("Content")&"</td>"
InfoShowStr=InfoShowStr&"</tr>"

InfoShowStr=InfoShowStr&"<tr style=""text-align:center;"">"
InfoShowStr=InfoShowStr&"<td class=""td_2"">"
InfoShowStr=InfoShowStr&"<script>function CloseWin(){window.opener=null;window.open("""",""_self"");window.close();}</script>"
InfoShowStr=InfoShowStr&"<a href=""javascript:"" onclick=""CloseWin()"">关闭本页</a></td>"
InfoShowStr=InfoShowStr&"</tr>"
InfoShowStr=InfoShowStr&"</table>"

GetInfoShow=InfoShowStr
End Function


'--获取标签的描述
Function GetLabelDesc(ByVal LabelName)

If LabelName="menu_cjwt" Then
 GetLabelDesc = "常见问题"
ElseIf LabelName="menu_dltk" Then
 GetLabelDesc = "代理条款"
ElseIf LabelName="menu_lxwm" Then
 GetLabelDesc = "联系我们"
ElseIf LabelName="reg_zzxy" Then
 GetLabelDesc = "用户守则" 
End If

End Function


function URLDecode(strIn)
    URLDecode = ""
    Dim sl: sl = 1
    Dim tl: tl = 1
    Dim key: key = "%"
    Dim kl: kl = Len(key)

    sl = InStr(sl, strIn, key, 1)
    Do While sl>0
        If (tl=1 And sl<>1) Or tl<sl Then
            URLDecode = URLDecode & Mid(strIn, tl, sl-tl)
        End If

        Dim hh, hi, hl
        Dim a
        Select Case UCase(Mid(strIn, sl+kl, 1))
            Case "U":                  'Unicode URLEncode
            a = Mid(strIn, sl+kl+1, 4)
            URLDecode = URLDecode & ChrW("&H" & a)
            sl = sl + 6

            Case "E":                   'UTF-8 URLEncode
            hh = Mid(strIn, sl+kl, 2)
            a = Int("&H" & hh)          'ascii码
            If Abs(a)<128 Then
                sl = sl + 3
                URLDecode = URLDecode & Chr(a)
            Else
                hi = Mid(strIn, sl+3+kl, 2)
                hl = Mid(strIn, sl+6+kl, 2)
                a = ("&H" & hh And &H0F) * 2 ^12 Or ("&H" & hi And &H3F) * 2 ^ 6 Or ("&H" & hl And &H3F)
                If a<0 Then a = a + 65536
                URLDecode = URLDecode & ChrW(a)
                sl = sl + 9
            End If
        Case Else:                      'Asc URLEncode
            hh = Mid(strIn, sl+kl, 2)   '高位
            a = Int("&H" & hh)          'ascii码
            If Abs(a)<128 Then
            sl = sl + 3
            Else
            hi = Mid(strIn, sl+3+kl, 2) '低位
            a = Int("&H" & hh & hi)     '非ascii码
            sl = sl + 6
            End If
            URLDecode = URLDecode & Chr(a)
        End Select

        tl = sl
        sl = InStr(sl, strIn, key, 1)
    Loop

    URLDecode = URLDecode & Mid(strIn, tl)
End Function



Function ShowPage(ByVal TotalRs,ByVal TotalPage,ByVal Page,ByVal PageUrl,ByVal Px)
	Response.Write GetPageList(TotalRs,TotalPage,Page,PageUrl,Px)
End Function

Function GetPageList(ByVal TotalRs,ByVal TotalPage,ByVal Page,ByVal PageUrl,ByVal Px)
	
If InStr(PageUrl,"?")=0 Then PageUrl=PageUrl&"?"

If Right(PageUrl,1)="?" Then 
 If Px<>"" Then PageUrl= PageUrl & "Px=" & Px & "&"
Else 
 PageUrl=PageUrl&"&Px="&Px& "&"
End If

If totalrs>0 Then

if cint(page)>9 then 
 ks=page-5 
 js=page+5 
 if ks<1 then 
  ks=1 
  js=ks+9 
 end If
 
 if js>cint(TotalPage) then 
  js=TotalPage 
  ks=js-9 
 end if 
else 
 if cint(TotalPage)>10 then 
  ks=1 
  js=10 
 else 
  ks=1 
  js=TotalPage 
 end if 
end if 

PageStr = "<div id='fenye' class='fenye'>"
if page<>1 then
 If page=2 Then'第二页时上一页是首页
  PageStr = PageStr & "<a href='"&PageUrl&"Page=1' class='prev'>上一页</a> "
 Else
  PageStr = PageStr & "<a href='"&PageUrl&"Page="&Page-1&"' class='prev'>上一页</a> "
 End If
 
 PageStr = PageStr & "<a href='"&PageUrl&"Page=1' class='prev'>首页</a> "

else 
 PageStr = PageStr & "<a href='"&PageUrl&"Page=1' class='prev'>首页</a> "
end if 

for i= ks to js 

  if cint(i)=cint(page) then 
   PageStr = PageStr & "<a href='"&PageUrl&"Page="&i&"' class='curr'>"& i & "</a> "
  else 
   PageStr = PageStr & "<a href='"&PageUrl&"Page="&i&"' class='num'>"& i & "</a> "
  end if

Next

if cint(page)<cint(TotalPage) then 
 PageStr = PageStr & "<a href='"&PageUrl&"Page="&TotalPage&"' class='next'>尾页</a> <a href='"&PageUrl&"Page="&Page+1&"' class='next'>下一页</a>"
else 
 PageStr = PageStr & "<a href='"&PageUrl&"Page="&TotalPage&"' class='next'>尾页</a>"
end if 

PageStr = PageStr &  "&nbsp;&nbsp;共"&TotalRs&"条记录"

PageStr = PageStr &  "&nbsp;&nbsp;转到第<select id='page' onChange=""window.location='"&PageUrl&"Page='+document.getElementById('page').options[document.getElementById('page').selectedIndex].value"">"
For I=1 To TotalPage
 PageStr = PageStr &  "<option value="&I
 If Page=I Then PageStr = PageStr &  " selected"
 PageStr = PageStr &  ">"& I &"</option>"
Next
PageStr = PageStr &  "</select>页"
PageStr = PageStr &  "</div>"
PageStr = PageStr &  "<div style='clear:both;'></div>"

End If

GetPageList=PageStr
End Function
%>