xkon.asp

支持IE 手机同步访问的WAP论坛社区程序

<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001" EnableSessionState = False%><%
Option Explicit
Server.ScriptTimeout=Read_SZ("S_TimeOut")
Response.ContentType=Read_SZ("LT_Type")&";Charset=UTF-8"
Response.Expires=Read_SZ("Long_HuanCun")

Dim Server_DB_Path
Server_DB_Path=Read_SZ("xkon_Data1")
Dim Server_IPDB_Path
Server_IPDB_Path=Read_SZ("xkon_Data2")
Dim xkon,YuYan,Zi_NiChen,Zi_ZhangHao,Zi_DenLu,Zi_ZuiHouShuaXin,Zi_XinYouJian,Zi_SuoDing,Zi_JiBie,Zi_XingBie,Const_Page_YS,Const_Page_ZS,Zi_JingBi,BanKuai_HuanCun,ShuChu_NeiRong,Zi_FaTie
xkon=CheckStr(Request.QueryString("xkon"))
YuYan=CheckStr(Request.QueryString("YuYan"))
Const_Page_Ys=CLng(Read_SZ("Page_Ys"))
Const_Page_Zs=CLng(Read_SZ("Page_Zs"))
Zi_FaTie=True
Zi_DenLu=False
If xkon="" Then
	xkon=Cookies_()
End If
Dim Str_DiZhi
Str_DiZhi="&amp;xkon="&Server.URLEncode(xkon)&"&amp;YuYan="&YuYan

Select Case YuYan
Case "Jian"
	YuYan="1"
Case "Fan"
	YuYan="0"
Case Else
	YuYan=""
End Select

Public Conn,Conn2
Call LT_ZT()
Call DaiLiFuWuQiFangWen()
Call ShouJiDianNaoFangWen()

If xkon<>"" Then
	Call Get_ZiLiao()
End If
If Zi_DenLu=True Then
	Call Yo_SuoDing()
	'Call Yo_DenLuGengXin()
End If
Private Function Cookies_()
	Dim Co
	Set Co=Server.CreateObject("MSWC.BrowserType")
	If Co.Cookies=True Then
		Cookies_=CheckStr(Request.Cookies("xkon"))
	Else
		Cookies_=""
	End If
	Set Co=Nothing
End Function
Private Sub Jie()
	If Not Response.IsClientConnected Then Response.End()
End Sub
Private Sub Write_Cookies(Co_Str)
	Dim Co
	Set Co=Server.CreateObject("MSWC.BrowserType")
	If Co.Cookies=True Then
		Response.Cookies("xkon")=Co_Str
		Response.Cookies("xkon").Expires=DateAdd("y",+1,Now())
	End If
	Set Co=Nothing
End Sub
Private Sub Yo_SuoDing()
	If Zi_SuoDing="1" Then Call xkon_Error("你的账号已被管理员锁定")
End Sub
Public Function QuanXian(Q_DenLu,Q_DenJi)
	If Q_DenLu="1" Then
		If Zi_DenLu=False Then Call xkon_Error("需要登录才能浏览")
		If Zi_JiBie<Q_DenJi Then Call xkon_Error("你的等级不够浏览")
	End If
End Function
'Private Sub Yo_DenLuGengXin()
'	Dim Yo_SQL
'	If DateAdd("n",-CLng(Read_SZ("LiXian")),Now())>Zi_ZuiHouShuaXin Then
'		Yo_SQL="Update ZhangHao Set ZuiHouDenLuShiJian='"&Now()&"',ZuiHouDenLuIP='"&ReadUsip()&"',ZuiHouShuaXin='"&Now()&"',ZuiHouDenLuDiQu='"&xkon_WeiZhi()&"' Where BiaoShi='"&xkon&"'"
'	Else
'		Yo_SQL="Update ZhangHao Set ZuiHouShuaXin='"&Now()&"' Where BiaoShi='"&xkon&"'"
'	End If
'	Call OpenData()
'		Conn.Execute(Yo_SQL)
'	Call CloseData()
'	Call Write_Cookies(xkon)
'End Sub
Public Sub Get_XiaoXi()
	Dim Cn1,Cn2,X_Fa,X_Shou,X_ShiJian,X_NiChen,X_YanCi,X_XiaoXi,NiChen_Str,x_ID
	X_XiaoXi=False
	Call OpenData()
	Set Cn1=Server.CreateObject("Adodb.Command")
	Cn1.ActiveConnection=Conn
	Cn1.CommandType=1
	Cn1.CommandText="Select Fa,Shou,ShiJian,NiChen,YanCi,ID From XiaoXi Where Shou='"&Zi_ZhangHao&"' And ShiJian<#"&Now()&"# And ZhuangTai='0'"
	Set Cn2=Cn1.Execute
	If Not Cn2.Eof Then
		X_Fa=Cn2("Fa")
		X_Shou=Cn2("Shou")
		X_ShiJian=Cn2("ShiJian")
		X_NiChen=Cn2("NiChen")
		X_YanCi=Cn2("YanCi")
		X_ID=Cn2("ID")
		X_XiaoXi=True
	End If
	Set Cn2=Nothing
	Set Cn1=Nothing
	If X_XiaoXi=True Then
		If X_Fa="xkon.cn" Then
			NiChen_Str="系统消息:"
		Else
			NiChen_Str="<a href=""ZiLiao.Asp?ZhangHao="&X_Fa&"{(xkon.cn)链接}"">"&X_NiChen&"</a>:"
		End If
		c.Write(xkon_FenXi(NiChen_Str&ReadTextFile(X_ID,Read_SZ("Folder_XiaoXi"))&"<br/>时间:"&X_ShiJian&"<br/>该消息延迟了"&X_YanCi&"秒<br/>"))
		Conn.Execute("Update ZhangHao Set XinYouJian=XinYouJian-1 Where BiaoShi='"&xkon&"'")
		Conn.Execute("Update XiaoXi Set ZhuangTai='1' Where ID="&X_ID)
		Call Jia_JingBi("+"&Clng(Read_SZ("JiFen_Shou_XiaoXi")),"+"&Clng(Read_SZ("JingYan_Shou_XiaoXi")))
	End If
	Call CloseData()
End Sub
Private Sub LT_ZT()
	If Read_SZ("LT_ZhuangTai")="0" Then Call xkon_Error(Read_SZ("WeiHuTiShi"))
End Sub
Private Sub DaiLiFuWuQiFangWen()
	If Read_SZ("DaiLiFuWuQiFangWen")="0" Then
		If Request.ServerVariables("HTTP_X_FORWARDED_FOR")<>"" Then
			Call xkon_Error("默认设置中,禁止了代理服务器访问")
		End If
	End If
End Sub
Private Sub ShouJiDianNaoFangWen()
	Dim SD_IP
	SD_IP=Left(Trim(Replace(ReadUsip(),".","")),6)
		If (SD_IP<>211103 and SD_IP<211136) or (SD_IP>211143 and SD_IP<218200) or (SD_IP>218207 and SD_IP<221130) or (SD_IP>221131) Then
			If Read_SZ("FangWen_DianNao")="1" Then Call xkon_Error("默认设置中,禁止了电脑访问")
		Else
			If Read_SZ("FangWen_ShouJi")="1" Then Call xkon_Error("默认设置中,禁止了手机访问")
		End If
End Sub
Public Sub Get_ZiLiao()
	Dim Cn1,Cn2,ZhuCeShiJian
	Call OpenData()
	Set Cn1=Server.CreateObject("Adodb.Command")
	Cn1.ActiveConnection=Conn
	Cn1.CommandType=1
	Cn1.CommandText="Select ZhangHao,NiChen,ZuiHouShuaXin,XinYouJian,SuoDing,JiBie,XingBie,ZiShu,YeShu,JingBi,ZhuCeShiJian From ZhangHao Where BiaoShi='"&xkon&"'"
	Set Cn2=Cn1.Execute
	If Not Cn2.Eof Then
		Zi_DenLu=True
		Zi_ZhangHao=Cn2("ZhangHao")
		Zi_NiChen=Cn2("NiChen")
		Zi_ZuiHouShuaXin=Cn2("ZuiHouShuaXin")
		Zi_XinYouJian=Cn2("XinYouJian")
		Zi_SuoDing=Cn2("SuoDing")
		Zi_JiBie=Cn2("JiBie")
		Zi_XingBie=Cn2("XingBie")
		Const_Page_Ys=Cn2("YeShu")
		Const_Page_Zs=Cn2("ZiShu")
		Zi_JingBi=Cn2("JingBi")
		ZhuCeShiJian=Cn2("ZhuCeShiJian")
	End If
	Set Cn2=Nothing
	Set Cn1=Nothing
	If DateAdd("n",-Clng(Read_SZ("LiXian")),Now())>Zi_ZuiHouShuaXin Then Call Jia_JingBi("+"&Clng(Read_SZ("JiFen_DenLu")),"+"&Clng(Read_SZ("JingYan_DenLu")))
	Dim Yo_SQL
	Yo_SQL="Update ZhangHao Set ZuiHouShuaXin='"&Now()&"' Where BiaoShi='"&xkon&"'"
	Conn.Execute(Yo_SQL)
	Call CloseData()
	If ZhuCeShiJian>DateAdd("n",-CLng(Read_SZ("ZhuCe_FenZhong")),Now()) Then
		Zi_FaTie=False
	End If
End Sub
Public Sub OpenData()
	Set Conn=Server.CreateObject("ADODB.Connection")
	Conn.ConnectionString="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="& Server.Mappath(Server_DB_Path)
	Conn.Open
End Sub
Public Sub OpenData2()
	Set Conn2=Server.CreateObject("ADODB.Connection")
	Conn2.ConnectionString="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="& Server.Mappath(Server_IPDB_Path)
	Conn2.Open
End Sub
Public Sub CloseData()
	Conn.Close()
	Set Conn=Nothing
End Sub
Public Function Read_SZ(Str)
	If Application("SZ_Str")="" Then
		Dim FSO,FS
		Set FSO=Server.CreateObject("Scripting.FileSystemObject")
		Set FS=FSO.OpenTextFile(Server.Mappath("Inc/SZ.xkon.cn.Asp"))
		Application("SZ_Str")=Replace(FS.ReadAll,"<%","")
		FS.Close
		Set FS=Nothing
		Set FSO=Nothing
	End If
	Dim SZ_Str
	SZ_Str=Split(Application("SZ_Str"),"&xkon.cn&")
	Dim SZ_Str1,SZ_Str2
	SZ_Str1=Split(SZ_Str(0),",")
	SZ_Str2=Split(SZ_Str(1),",")
	Dim i,ii
	For i=0 To Ubound(SZ_Str2)
		If LCase(SZ_Str2(i))=LCase(Str) Then
			ii=i:Exit For
		End If
	Next
	If ii="" Then
		Call xkon_Error("找不到设置"&Str)
	Else
		Read_SZ=SZ_Str1(ii)
	End If
End Function
Public Function ReadTextFile(ByVal Fname,ByVal Folder_Name)
  Dim M_fso,FnameN,Fnr
  ReadTextFile=""
  Set M_fso = CreateObject("Scripting.FileSystemObject")
 If M_fso.FolderExists(Server.Mappath("File/"&Folder_Name))=False Then
  Call xkon_Error("读取信息失败")
 End If
  Set FnameN= M_fso.OpenTextFile(Server.Mappath("File/"&Folder_Name&"/"&Fname&".Txt"),1,True)
  If FnameN.AtEndOfStream=False Then
   Fnr=FnameN.ReadAll
  End If
  FnameN.Close
  Set M_fso = Nothing
  ReadTextFile=Fnr
End Function
Public Sub xkon_Error(Str)
	Response.Clear()
	ShuChu_NeiRong=""
	Call H_Title("出错了")
	Response.Write(Str)
	Call H_End()
	Response.End()
End Sub
Public Sub CloseData2()
	Conn2.Close()
	Set Conn2=Nothing
End Sub
Dim xkon_Title
Public Sub H_Title(Title)
	xkon_Title=Title
	Response.Write(xkon_JF(xkon_FenXi(Read_SZ("WenJianTou")),YuYan))
	If Zi_DenLu=True Then
		If Zi_XinYouJian>0 Then
			Call Jie()
			Call Get_XiaoXi()
		End If
	End If
End Sub
Public Sub H_End()
	Response.Write(xkon_JF(ShuChu_NeiRong,YuYan))
	Response.Write(xkon_JF(xkon_FenXi(Read_SZ("WenJianWei")),YuYan))
End Sub
Public Function XingBieed(x_Str)
	If X_Str="1" Then
		XingBieed="女"
	Else
		XingBieed="男"
	End If