手机WAP编程

开发平台：
ASP/ASPX

Head.Asp：源码内容
							﻿<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001" EnableSessionState = False%><%
Option Explicit
'On Error Resume Next
Server.ScriptTimeout=30
Response.ContentType="Text/Html;Charset=UTF-8"
Response.Expires=-1
Public Const Server_DB_Path="../Database.mdb"
Public Const Server_IPDB_Path="IPData.mdb"
Public Page_Time,Conn,Conn2
Page_Time=Timer
Call Get_Admin()
Rem 版权信息类,请勿修改.
Class xkon
	Rem 程序名称
	Public Function name()
		name="新空程序网 论坛程序"
	End Function
	Rem 程序版本
	Public Function ver()
		ver="1.0"
	End Function
	Rem 程序官方网站
	Public Function Url()
		Url="http://wap.xkon.cn"
	End Function
	Rem 程序升级接口
	Public Function Interface()
		Interface="http://wap.xkon.cn/update/bbs/"
	End Function
End Class
Public Function Get_Admin()
	Dim URL,Cn2,Cn1
	URL=Request.ServerVariables("URL")
	If Mid(URL,InstrRev(URL,"/")+1)<>"DenLu.Asp" Then
		If Request.Cookies("AdminZhangHao")="" Or Request.Cookies("AdminMiMa")="" Then
		Else
			Call OpenData()
				Set Cn1=Server.CreateObject("ADODB.Command")
				Cn1.ActiveConnection=Conn
				Cn1.CommandType=1
				Cn1.CommandText="SELECT * FROM ADMIN WHERE ZHANGHAO='"&Request.Cookies("AdminZhangHao")&"' And MiMa='"&Request.Cookies("AdminMiMa")&"'"
				Set Cn2=Cn1.Execute
				If Cn2.Eof Then
					Set Cn2=Nothing
					Set Cn1=Nothing
					Call CloseData()
					Response.Redirect("DenLu.Asp")
				Else
					Response.Cookies("xkon_Cookies")=Cn2("QuanXian")
				End If
				Set Cn2=Nothing
				Set Cn1=Nothing
			Call CloseData()
		End If
	End If
End Function
Function Read_Cookies(Str)
	If Request.Cookies("xkon_Cookies")="" Then Read_Cookies="0":Exit Function
	Dim Str2
	Str2=Split("FangWen,Admin_MiMa,Admin_Admin,Admin_JBXX,Admin_GG,Admin_Help,Admin_TouXiang,JiLu,DenJi,BanKuai,BanZhu,TieZhi,HuiFu,HuiYuan,XiaoXi,ZiFu_GuoLv,BiaoQing,Data,TiShi,DiaoCha,QunFa,IP",",")
	Dim Str3
	Str3=Split(Request.Cookies("xkon_Cookies")," ")
	Dim i,ii
	For i=0 To Ubound(Str3)
		If Str2(i)=Str Then ii=i:Exit For
	Next
	If ii="" Then
		Call xkon_Error("找不到该Cookies")
	Else
		Read_Cookies=Str3(i)
	End If
End Function
Public Function OpenData()
	On Error Resume Next
	Set Conn=Server.CreateObject("ADODB.Connection")
	Conn.ConnectionString="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="& Server.Mappath(Server_DB_Path)
	Conn.Open
	If Err Then
		Conn.Close()
		Set Conn=Nothing
		Call xkon_Error("连接数据库出错")
	End If
End Function
Public Function OpenData2()
	On Error Resume Next
	Set Conn2=Server.CreateObject("ADODB.Connection")
	Conn2.ConnectionString="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="& Server.Mappath(Server_IPDB_Path)
	Conn2.Open
	If Err Then
		Conn2.Close()
		Set Conn2=Nothing
		Call xkon_Error("连接数据库出错")
	End If
End Function
Public Function CloseData()
	On Error Resume Next
	Conn.Close()
	Set Conn=Nothing
	If Err Then
		Call xkon_Error("Database Error")
	End If
End Function
Public Function H_Title1(Title)
	Response.Write("<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Transitional//EN"" ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd""><html xmlns=""http://www.w3.org/1999/xhtml""><head><meta http-equiv=""Content-Type"" content=""text/html; charset=UTF-8""/><title>"&Title&"</title><link rel=""stylesheet"" type=""text/css"" href=""../Inc/xkon.Css"" /></head><body onload=setTimeout(""load.style.display='none';h.style.display='block'"",100) ><div id=""load""><font color=#FF0000>页面载入中...</font><br/></div><div id=""h"" style=""display:none""><input type=button onclick=""window.location.reload()"" value=刷新 /><br/>")
	Response.Flush()
End Function
Public Function H_Title(Title)
	Response.Write("<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Transitional//EN"" ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd""><html xmlns=""http://www.w3.org/1999/xhtml""><head><meta http-equiv=""Content-Type"" content=""text/html; charset=UTF-8""/><title>"&Title&"</title><link rel=""stylesheet"" type=""text/css"" href=""../Inc/xkon2.Css"" /></head><body onload=setTimeout(""load.style.display='none';h.style.display='block'"",100) ><div id=""load""><font color=#FF0000>页面载入中...</font><br/></div><div id=""h"" style=""display:none""><input type=button onclick=""window.location.reload()"" value=刷新 /><br/>")
	Response.Flush()
End Function
Public Function H_End()
	Dim x
	Set x=New xkon
	Response.Write("<br/><br/></div><font size=2 color=#A9A9A9 >程序名称:"&x.Name&"<br/>技术支持:<a target=_blank href="""&x.Url&""">"&x.Url&"</a></font></body></html>")
End Function
Public Function Checkstr(C_Str)
	If IsNull(C_Str) Then Exit Function
	C_Str=Trim(C_Str)
	C_Str=Replace(C_Str,"&","&amp;")
	C_Str=Replace(C_Str,"'","&apos;")
	C_Str=Replace(C_Str,">","&gt;")
	C_Str=Replace(C_Str,"<","&lt;")
	C_Str=Replace(C_Str," ","&nbsp;")
	C_Str=Replace(C_Str,"""","&quot;")
	C_Str=Replace(C_Str,",","，")
	Checkstr=C_Str
End Function
Class xkon_Request
	Public Function Form(xkon_Request_Str)
		xkon_Request_Str=Request.Form(xkon_Request_Str)
		xkon_Request_Str=Checkstr(xkon_Request_Str)
		Form=xkon_Request_Str
	End Function
	Public Function QueryString(xkon_QueryString_Str)
		xkon_QueryString_Str=Request.QueryString(xkon_QueryString_Str)
		xkon_QueryString_Str=Checkstr(xkon_QueryString_Str)
		QueryString=xkon_QueryString_Str
	End Function
	Public Function Form_long(xkon_Request_Str)
		On Error Resume Next
		xkon_Request_Str=Request.Form(xkon_Request_Str)
		If xkon_Request_Str="" Then
			xkon_Request_Str=1
		Else
			xkon_Request_Str=Clng(xkon_Request_Str)
		End If
		If Err Then
			Form_long=1
		End If
		Form_long=xkon_Request_Str
	End Function
	Public Function Form_Str(xkon_Request_Str,d,c)
		Dim xkon_Request_Str1
		xkon_Request_Str1=Checkstr(Request.Form(xkon_Request_Str))
		If xkon_Request_Str1<>"" Then
			If len(xkon_Request_Str1)<d Then
				Call xkon_Error("提交的长度不能小于"&d&"位<br/>参数:"&xkon_Request_Str)
			End If
			If Len(xkon_Request_Str1)>c Then
				Call xkon_Error("提交的长度不能小于"&c&"位<br/>参数:"&xkon_Request_Str)
			End If
			Form_Str=xkon_Request_Str1
		End If
	End Function
	Public Function QueryString_Str(xkon_Request_Str,d,c)
		Dim xkon_Request_Str1
		xkon_Request_Str1=Checkstr(Request.QueryString(xkon_Request_Str))
		If xkon_Request_Str1<>"" Then
			If len(xkon_Request_Str1)<d Then
				Call xkon_Error("提交的长度不能小于"&d&"位<br/>参数:"&xkon_Request_Str)
			End If
			If Len(xkon_Request_Str1)>c Then
				Call xkon_Error("提交的长度不能小于"&c&"位<br/>参数:"&xkon_Request_Str)
			End If
			QueryString_Str=xkon_Request_Str1
		End If
	End Function
	Public Function QueryString_long(xkon_Request_Str)
		On Error Resume Next
		xkon_Request_Str=Request.QueryString(xkon_Request_Str)
		If xkon_Request_Str="" Then
			xkon_Request_Str=1
		Else
			xkon_Request_Str=Clng(xkon_Request_Str)
		End If
		If Err Then
			Form_long=1
		End If
		QueryString_long=xkon_Request_Str
	End Function
	Public Function Form_aa(xkon_Request_Str,d,c)
		Dim xkon_Request_Str1
		xkon_Request_Str1=Request.Form(xkon_Request_Str)
		If xkon_Request_Str1<>"" Then
			If aa(xkon_Request_Str1)=False Then
				Call xkon_Error("字符只能是由字母或数字组成<br/>参数:"&xkon_Request_Str)
			End If
			If Len(xkon_Request_Str1)<d Then
				Call xkon_Error("提交的长度不能小于"&d&"位<br/>参数:"&xkon_Request_Str)
			End If
			If Len(xkon_Request_Str1)>c Then
				Call xkon_Error("提交的长度不能大于"&d&"位<br/>参数:"&xkon_Request_Str)
			End If
			Form_aa=xkon_Request_Str1
		End If
	End Function
	Public Function QueryString_aa(xkon_Request_Str,d,c)
		Dim xkon_Request_Str1
		xkon_Request_Str1=Request.QueryString(xkon_Request_Str)
		If xkon_Request_Str1<>"" Then
			If aa(xkon_Request_Str1)=False Then
				Call xkon_Error("字符只能是由字母或数字组成<br/>参数:"&xkon_Request_Str)
			End If
			If Len(xkon_Request_Str1)<d Then
				Call xkon_Error("提交的长度不能小于"&d&"位<br/>参数:"&xkon_Request_Str)
			End If
			If Len(xkon_Request_Str1)>c Then
				Call xkon_Error("提交的长度不能大于"&d&"位<br/>参数:"&xkon_Request_Str)
			End If
			QueryString_aa=xkon_Request_Str1
		End If
	End Function
End Class
Class xkon_Response
	Public Function Writeln(xkon_Response_Str)
		Response.Write(xkon_Response_Str)
		Response.Write("<br/>")
	End Function
	Public Function WriteHTMLEncode(xkon_Response_Str)
		xkon_Response_Str=CheckStr(xkon_Response_Str)
		Response.Write(xkon_Response_Str)
	End Function
	Public Function Write(xkon_Response_Str)
		Response.Write(xkon_Response_Str)
	End Function
	Public Function WriteUBB(xkon_Response_Str)
		Response.Write(UBB(xkon_Response_Str))
	End Function
End Class
Class xkon_FangWen
	Public Function FangWen()
		Call QuanXian("FangWen","访问后台")
		If Request.Cookies("AdminZhangHao")="" Or Request.Cookies("AdminMiMa")="" Then
			Call xkon_Error("你无权访问后台")
		End If
	End Function
	Public Function Admin_MiMa()
		Call QuanXian("Admin_MiMa","修改密码")
	End Function
	Public Function Admin_Admin()
		Call QuanXian("Admin_Admin","管理站长")
	End Function
	Public Function Admin_JBXX()
		Call QuanXian("Admin_JBXX","设置基本信息")
	End Function
	Public Function Admin_GG()
		Call QuanXian("Admin_GG","管理广告")
	End Function
	Public Function Admin_Help()
		Call QuanXian("Admin_Help","管理帮助")
	End Function
	Public Function Admin_TouXiang()
		Call QuanXian("Admin_TouXiang","管理头像")
	End Function
	Public Function JiLu()
		Call QuanXian("JiLu","查看日志")
	End Function
	Public Function DenJi()
		Call QuanXian("DenJi","管理等级")
	End Function
	Public Function BanKuai()
		Call QuanXian("BanKuai","管理版块")
	End Function
	Public Function BanZhu()
		Call QuanXian("BanZhu","管理版主")
	End Function
	Public Function TieZhi()
		Call QuanXian("TieZhi","管理贴子")
	End Function
	Public Function HuiFu()
		Call QuanXian("HuiFu","管理回复")
	End Function
	Public Function A()
		If Lcase(Request.Cookies("AdminZhangHao"))<>"admin" Then
			Call xkon_Error("最高管理员才可进入")
		End If
	End Function
	Public Function HuiYuan()
		Call QuanXian("HuiYuan","管理会员")
	End Function
	Public Function XiaoXi()
		Call QuanXIan("XiaoXi","管理消息")
	End Function
	Public Function ZiFu_GuoLv()
		Call QuanXian("ZiFu_GuoLv","字符过滤")
	End Function
	Public Function BiaoQing()
		Call QuanXian("BiaoQing","管理表情")
	End Function
	Public Function Data()
		Call QuanXian("Data","备份恢复数据")
	End Function
	Public Function TiShi()
		Call QuanXian("TiShi","修改提示")
	End Function
	Public Function DiaoCha()
		Call QuanXian("DiaoCha","修改调查")
	End Function
	Public Function QunFa()
		Call QuanXian("QunFa","群发信息")
	End Function
	Public Function IP()
		Call QuanXian("IP","屏蔽IP")
	End Function
End Class
Public Function QuanXian(Str,Str_Err)
	If Read_Cookies(Str)<>"1" Then
		Call xkon_Error("此页需要"&Str_Err&"的权限,最高管理员未分配此权限或者您的登陆已超时.<a href=""DenLu.Asp"">重新登陆</a>")
	End If
End Function
Public Function Checked(Str)
	If Str="1" Then
		Checked="checked"
	End If
End Function
Public Function Checkeded(Str)
	If Str="on" Then
		Checkeded="1"
	Else
		Checkeded="0"
	End If
End Function
Public Function JiLu(Str)
	Dim Ji_Cn1,Ji_Cn2,Ji_ID
	Set Ji_Cn1=Server.CreateObject("Adodb.Command")
	Ji_Cn1.ActiveConnection=Conn
	Ji_Cn1.CommandType=1
	Ji_Cn1.CommandText="Select id From RiZi Order By Id DESC"
	Set Ji_Cn2=Ji_Cn1.Execute
	If Ji_Cn2.Eof Then
		Ji_ID=1
	Else
		Ji_ID=Ji_Cn2("ID")+1
	End If
	Set Ji_Cn2=Nothing
	Set Ji_Cn1=Nothing
	Conn.Execute("Insert Into RiZi(ID,Word,Admin,ShiJian,IP)Values('"&Ji_ID&"','"&Str&"','"&Request.Cookies("AdminZhangHao")&"','"&Now()&"','"&Readusip()&"')")
End Function
Public Function CPage(PageCount,Page,Str_Url)
	Dim i
	If Right(Str_Url,4)=".Asp" Then
		Str_Url=Str_Url&"?"
	Else
		If Right(Str_Url,5)<>"&amp;" Then
			Str_Url=Str_Url&"&amp;"
		End If
	End If
	For i=Page-2 To Page+2
		If i>0 And i<=PageCount Then
			If i=Page Then
				c.Write("["&i&"]")
			Else
				c.Write("<a href="""&Str_Url&"p="&i&""">["&i&"]</a>")
			End If
		End If
	Next
	c.Writeln("")
	c.Writeln("第"&Page&"页,共"&PageCount&"页<br/>")
End Function
Public Function XingBiee(Str)
	If Str="男" Then
		XingBiee="0"
	Else
		XingBiee="1"
	End If
End Function
Public Function XingBieed(Str)
	If Str="0" Then
		XingBieed="男"
	Else
		XingBieed="女"
	End If
End Function
Public Function BanMian_MingChen(ID)
	Call OpenData()
		Dim Cn1,Cn2
		Set Cn1=Server.CreateObject("Adodb.Command")
		Cn1.ActiveConnection=Conn
		Cn1.CommandType=1
		Cn1.CommandText="Select BanKuai_MingChen From BanKuai Where ID="&Clng(ID)
		Set Cn2=Cn1.Execute
		If Cn2.Eof Then
			BanMian_MingChen="0"
		Else
			BanMian_MingChen=Cn2("BanKuai_MingChen")
		End If
		Set Cn1=Nothing
		Set Cn2=Nothing
	Call CloseData()
End Function
Public Function Str_Z(Str)
	If Str="1" Then
		Str_Z="是"
	Else
		Str_Z="否"
	End If
End Function
Private Function Zhuan(Str)
	If Str="1" Then
		Zhuan="√"
	Else
		Zhuan="×"
	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("读取信息失败"&Folder_Name)
 End If
  Set FnameN= M_fso.OpenTextFile(Server.Mappath("../File/"&Folder_Name&"/"&Fname&".Txt"),1,True)
  Fnr=FnameN.ReadAll
  FnameN.Close
  Set M_fso = Nothing
  ReadTextFile=Fnr
End Function
Sub BanKuai_LieBiao()
	Dim Cn1
	c.Write("版块:<select name=""ShangJi_ID"">")
	Call OpenData()
		Set Cn1=Server.CreateObject("Adodb.Recordset")
		Cn1.Open "Select id,BanKuai_MingChen From BanKuai Order By Id Desc",Conn,1,1
		Do While(Not Cn1.Eof)
			c.Write("<option value="""&Cn1("ID")&""">"&Cn1("BanKuai_MingChen")&"</option>")
			Cn1.MoveNext
		Loop
		Cn1.Close
		Set Cn1=Nothing
	Call CloseData()
	c.Write("</select>")
End Sub
Public Function Selected(Byval Name1,Byval Name2)
	If Name1=Name2 Then
		Selected="selected"
	End If
End Function
function aa(str) 
Dim i
for i=1 to len(str) 
if (asc(mid(str,i,1))>=48 and asc(mid(str,i,1))=<57) or (asc(mid(str,i,1))>=65 and asc(mid(str,i,1))=<90) or (asc(mid(str,i,1))>=97 and asc(mid(str,i,1))=<122) then 
aa=true 
else 
aa=false 
exit for 
end if 
next 
end Function
x_c
Public Function xkon_Error(Str)
	Response.Clear()
	Response.Write("<html><head><title>出错了</title><meta http-equiv=""Content-Type"" content=""text/html; charset=utf-8"" /></head><body onselectstart=""return false"">"&Str&"</body></html>")
	Response.End()
End Function
Function C2u(text)
   Dim iw,cw
   For iw=1 to Len(text)
   cw=Mid(text,iw,1)
   c2u=c2u&"&#x" & Hex(AscW(cw)) & ";"
   next
End Function
Private Sub x_c()
	On Error Resume Next
	Dim x
	Set x=New xkon
	If C2u(x.Name())<>"&#x65B0;&#x7A7A;&#x7A0B;&#x5E8F;&#x7F51;&#x20;&#x8BBA;&#x575B;&#x7A0B;&#x5E8F;" Or C2u(x.Url())<>"&#x68;&#x74;&#x74;&#x70;&#x3A;&#x2F;&#x2F;&#x77;&#x61;&#x70;&#x2E;&#x78;&#x6B;&#x6F;&#x6E;&#x2E;&#x63;&#x6E;" Then Response.Clear():Response.End()
	If Err Then Call xkon_Error("")
	Set x=Nothing
End Sub
Public Function Readusip()
  Dim strIPAddr
  If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
      strIPAddr = Request.ServerVariables("REMOTE_ADDR")
  ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
      strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
  ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then
      strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
  Else
      strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
  End If
  Readusip = Trim(Mid(strIPAddr, 1, 30))
End Function
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,"<%","")
		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 SZ_Str2(i)=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 Get_NiChen(User)
	If User = "xkon.cn" Then Get_NiChen = "系统":Exit Function
	Dim n_1,n_2
	Set n_1=Server.CreateObject("Adodb.Command")
	n_1.ActiveConnection=Conn
	n_1.CommandType=1
	n_1.CommandText="Select NiChen From ZhangHao Where ZhangHao='"&User&"'"
	Set n_2=n_1.Execute
	If n_2.Eof Then
		Call xkon_Error("会员不存在")
	Else
		Get_NiChen=n_2("NiChen")
	End If
	Set n_2=Nothing
	Set n_1=Nothing
End Function
Public Function FaXin(User,EUser,YanCi,Fa_NeiRong)
	Dim SQL,F1,F2,J_ID
	If Fa_NeiRong="" Then Fa_NeiRong="0"
	Set F1=Server.CreateObject("Adodb.Command")
	F1.ActiveConnection=Conn
	F1.CommandType=1
	F1.CommandText="Select id From XiaoXi Order By Id Desc"
	Set F2=F1.Execute
	If F2.Eof Then
		J_ID=1
	Else
		J_ID=F2("ID")+1
	End If
	Set F2=Nothing
	Set F1=Nothing
	SQL="Insert Into XiaoXi(ID,Fa,Shou,ShiJian,ZhuangTai,NiChen,YanCi)Values('"&J_ID&"','"&User&"','"&EUser&"','"&Now()&"','0','"&Get_NiChen(User)&"','"&YanCi&"')"
	Conn.Execute(SQL)
	Conn.Execute("Update ZhangHao Set XinYouJian=XinYouJian+1 Where ZhangHao='"&EUser&"'")
	Dim FSO,FS
	Set FSO=Server.CreateObject("Scripting.FileSystemObject")
	Set FS=FSO.OpenTextFile(Server.Mappath("../File/"&Read_SZ("Folder_XiaoXi")&"/"&J_ID&".txt"),2,True)
	FS.Write(Fa_NeiRong)
	FS.Close
	Set FS=Nothing
	Set FSO=Nothing
End Function
%>

						