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

Function AlertRef(ByVal AlertStr)
 Response.Write("<script>")
 If AlertStr <> "" Then Response.Write("alert('" & AlertStr & "');")
 If Request.ServerVariables("Http_Referer") <> "" Then
  Response.Write("location.href='" & Request.ServerVariables("Http_Referer") & "';")
 Else
  Response.Write("location.href='" & HttpPath(2) & "';")
 End If
 Response.Write("</script>")
 Call ConnClose()
 Response.End()
 End Function

Function goback(ByVal str,ByVal alertstr) '为空时后退
 if str="" then 
  response.write "<script>" 
  response.write "alert('"&alertstr&"');" 
  response.write "history.go(-1)" 
  response.write "</script>" 
  Call ConnClose()
  response.end 
 else
  goback=str
 end if
End Function

Function alertback(ByVal alertstr,ByVal backnum) 
  response.write "<script>" 
  response.write "alert('"&alertstr&"');" 
  response.write "history.go(-"&backnum&")" 
  response.write "</script>" 
  Call ConnClose()
  response.end 
End Function

Function AlertUrl(ByVal alertstr,ByVal url) 
  response.write "<script>" 
  response.write "alert('"&alertstr&"');" 
  response.write "location.href='"&url&"';" 
  response.write "</script>" 
  Call ConnClose()
  response.end 
End Function

Function AlertClose(ByVal AlertStr)
 Response.Write("<script>")
 Response.Write("alert('" & AlertStr & "');")
 Response.Write("window.close();")
 Response.Write("</script>")
 Response.End()
End Function

Function GotoUrl(ByVal url) 
  response.write "<script>" 
  response.write "location.href='"&url&"';" 
  response.write "</script>" 
  Call ConnClose()
  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
  Call ConnClose()
  response.end
  end if
next
 checkinput_blank=inputstr
End Function

Function ChkStr(ByVal ParaValue,ByVal ParaType)'参数类型-数字型(1是字符，2是数字，3是日期
 If ParaType = 1 then
  ChkStr = Replace(ParaValue,"'","''")
 ElseIf ParaType = 2 then
  If ParaValue="" Then
   ChkStr = ParaValue
  Else
   If IsNumeric(ParaValue) = True Then
    If Abs(ParaValue)<=214748367 Then
	 ChkStr = ParaValue
	Else
	 Response.Write "以下传递的参数类型有错误！<br>" & ParaValue
     Response.End
	End If
   Else   
    Response.Write "以下传递的参数类型有错误！<br>" & ParaValue
    Response.End
   End If
  End If
 ElseIf ParaType = 3 then
  If ParaValue<>"" And (IsDate(ParaValue) = False) then
   Response.Write "以下传递的参数类型有错误！<br>" & ParaValue
   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

'--获取当前页的网址信息
Function HttpPath(ByVal 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
 ElseIf Assort=4 Then
  If Request.ServerVariables("QUERY_STRING")<>"" Then UrlStr="?"&Request.ServerVariables("QUERY_STRING")

  If Port="80" Then
   HttpPath="http://"&Ser&Scr&UrlStr
  Else
   HttpPath="http://"&Ser&":"&Port&Scr&UrlStr
  End If
 End If
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 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 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,".")
inIPnum=inips(0)*256*256*256 + inips(1)*256*256 + inips(2)*256 + inips(3)

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)
Set RsPicStyle= Server.CreateObject("Adodb.RecordSet")
Sql="Select * From CFCount_User Where UserName='"&UserName&"'"
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 GetMySet(ByVal AppName, ByVal SetBClassFlag, ByVal SetFlag)
 If AppName="" Then
   Sql = "Select SetValue From CFCount_SetBClass Where SetBClassFlag='" & SetBClassFlag & "'"
   Set Rs_MySet = Conn.Execute(Sql)
   MyStr_MySet_1 = "|||"&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
  MyStr_MySet_1 = Application(AppName)
 End If

 If InStr(LCase(MyStr_MySet_1), "|||" & LCase(SetFlag) & "=") > 0 Then
  MyStr_MySet_2 = Mid(MyStr_MySet_1, InStr(LCase(MyStr_MySet_1), "|||" & LCase(SetFlag) & "=") + Len(SetFlag) + 4)
  GetMySet = Left(MyStr_MySet_2, InStr(MyStr_MySet_2, "|||") - 1)
 Else
  System.Web.HttpContext.Current.Response.Write("document.write(" & Chr(34) & Server.HtmlEncode(SetFlag) & "参数在数据库里没有找到相应配置" & Chr(34) & ");")
  System.Web.HttpContext.Current.Response.End()
 End If

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 ConnClose()
 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(RsUser)=True Then
  RsUser.Close
  Set RsUser=Nothing
 End If

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

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

'--获取登录
Function GetUserLogin(ShowWidth,ShowWidth_2)
UserLoginStr="<script>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"function userloginccimgchange()"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"{"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"document.getElementById(""userloginccimg"").style.display = '';"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"document.getElementById(""userloginccimg"").src = 'CF_CheckCode.asp?RanStr=' + Math.random();"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"}"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"function userlogincheck()"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"{"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"if(document.form_userlogin.username.value==""""){"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"alert(""请输入用户名!"");"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"document.form_userlogin.username.focus();"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"return false;"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"}"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"if(document.form_userlogin.pwd.value==""""){"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"alert(""请输入密码!"");"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"document.form_userlogin.pwd.focus();"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"return false;"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"}"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"if(document.form_userlogin.checkcode.value=="""")  {"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"alert(""请输入四位数字的验证码!"");"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"document.form_userlogin.checkcode.focus();"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"return false;"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"}"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"return true;"	& 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 name=""form_userlogin"" id=form_userlogin method=""post"" action=""Index.asp?Action=userloginsave"" onsubmit=""return userlogincheck();"">"	& 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>Cookie：</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=""43200"">保留一个月</option>"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<option value=""5256000"">永久保留</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=6 onclick=""if(document.getElementById('checkcode').value==''){userloginccimgchange();}"" autoComplete=""off"">"	& Chr(13)&Chr(10)
UserLoginStr=UserLoginStr&"<a href=""javascript:userloginccimgchange()""><IMG id=userloginccimg src="""" style=""display:none;"" 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 border=0 name=imageField 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_Manage.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_Manage.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 = Server.CreateObject("ADODB.Recordset")
Rs.open Sql,Conn,1,1
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
 If ChkStr(Request("Page"),2) = "" Then
  Page = 1
 Else 
  Page = CLng(ChkStr(Request("Page"),2))
 End If 
 Rs.pagesize=ShowNum
 TotalRs=Rs.RecordCount
 TotalPage=Rs.PageCount
 MyPageSize=Rs.PageSize
 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

InfoAllStr=InfoAllStr&"</table>"

InfoAllStr=InfoAllStr&"<table style=""width:90%;margin:0px auto;"">"
InfoAllStr=InfoAllStr&"<tr>"
InfoAllStr=InfoAllStr&"<td><a href=""?Page=1"">第一页</a>"

If Page>1 Then
InfoAllStr=InfoAllStr&"&nbsp;&nbsp;<a href='?Page="&Page-1&"'>上一页</a>"
End If

If Page<Rs.PageCount then
InfoAllStr=InfoAllStr&"&nbsp;&nbsp;<a href='?Page="&Page+1&"'>下一页</a>"
End If

InfoAllStr=InfoAllStr&"&nbsp;&nbsp;<a href=""?Page="&totalpage&""">最后一页</a> 页次：<font color=""#ff0000"">"&page&"</font>/"&totalpage&"页&nbsp;&nbsp;共"&totalrs&"条记录&nbsp;&nbsp;每页显示"&rs.pagesize&"条"

InfoAllStr=InfoAllStr&"&nbsp;&nbsp;转到第<select id='page' onChange=""window.location=document.getElementById('page').options[document.getElementById('page').selectedIndex].value"">"
For I=1 To TotalPage
 InfoAllStr=InfoAllStr&"<option value=?Page="& i
 If Page=I Then InfoAllStr=InfoAllStr&" selected"
 InfoAllStr=InfoAllStr&">"& I &"</option>"
Next
InfoAllStr=InfoAllStr&"</select>页"
InfoAllStr=InfoAllStr&"</td>"

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

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 = Server.CreateObject("ADODB.Recordset")
Rs.open Sql,Conn,1,1
	
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
%>