head.asp
来自「支持IE 手机同步访问的WAP论坛社区程序 很不错」· ASP 代码 · 共 564 行 · 第 1/2 页
ASP
564 行
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)<>"&" Then
Str_Url=Str_Url&"&"
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())<>"新空程序网 论坛程序" Or C2u(x.Url())<>"http://wap.xkon.cn" 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
%>⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?