<%
getsj=2 '2为正常开放，1为升级中
if getsj=1 then
call head()
Response.write ""
Response.write "对不起！网站升级中,请稍后访问，谢谢！"
Response.write "
返回" & chr(13)
Response.write "
"
Response.end
end if
'===============MSSQLSERVER数据库===============
' WAP源码之家-手机:http://wapvy.cn电脑:http://www.wapvy.cn
'=================ACCESS数据库=================
'=================过客明心版权所有========================
dim twapp_db
twapp_db="/shujuku/a6390994"
Set conn = Server.CreateObject("ADODB.Connection")
conn.open "driver={microsoft access driver (*.mdb)};uid=#twapp_ydzqbqsy1;pwd=520ydzq;dbq=" & Server.MapPath(""&twapp_db&"")
If Err Then
err.Clear
Set Conn = Nothing
Response.Write "数据库连接错误,请检查INC.Asp文件"
Response.End
End If
sid=trim(request.querystring("sid"))
'自定义需要过滤的字串,用 "|" 分隔
YD_In = " and|update|exec|insert|select|delete| count|master|truncate|declare|drop|create|eval|xp_|sp_|command|dir|update "
Sub Head()
Response.ContentType = "text/vnd.wap.wml"
Response.Write ""
Response.Write ""
Response.Write ""
Response.Write ""
Response.Write ""
Response.Write ""
Response.Write ""
Response.Write ""
End Sub
'================================================
'函数名：addwml
'作 用：时间命名的函数
'参 数：fname -文件路径, str_内容
'================================================
function addwml(fname)
fname = fname '前fname为变量，后fname为函数参数引用
fname = replace(fname,"-","")
fname = replace(fname," ","")
fname = replace(fname,":","")
fname = replace(fname,"PM","")
fname = replace(fname,"AM","")
fname = replace(fname,"上午","")
fname = replace(fname,"下午","")
addwml = fname & ".wml"
end function
'================================================
'================================================
'作 用:生成WML文件
'================================================
Function LoadFile(File) '文件内容读取.
Dim objStream
On Error Resume Next
Set objStream = Server.CreateObject("ADODB.Stream")
If Err.Number=-2147221005 Then
Response.Write "非常遗憾,您的主机不支持ADODB.Stream,不能使用本程序"
Err.Clear
' Response.End
End If
With objStream
.Type = 2
.Mode = 3
.Open
.LoadFromFile Server.MapPath(File)
If Err.Number<>0 Then
Response.Write "文件"&File&"无法被打开，请检查是否存在!"
Err.Clear
' Response.End
End If
.Charset = "utf-8"
.Position = 2
LoadFile = .ReadText
.Close
End With
Set objStream = Nothing
End Function
Sub SaveToFile(strBody,File) '存储内容到文件
Dim objStream
On Error Resume Next
Set objStream = Server.CreateObject("ADODB.Stream")
If Err.Number=-2147221005 Then
Response.Write "非常遗憾,您的主机不支持ADODB.Stream,不能使用本程序"
Err.Clear
' Response.End
End If
With objStream
.Type = 2
.Open
.Charset = "utf-8"
.Position = objStream.Size
.WriteText = strBody
.SaveToFile Server.MapPath(File),2
.Close
End With
Set objStream = Nothing
End Sub
Function sid_url()
dim WAPurl
WAPurl=WAPurl&request.ServerVariables("SCRIPT_NAME")
if(len(trim(request.ServerVariables("QUERY_STRING")))>0) then
WAPurl=WAPurl & "?" & request.ServerVariables("QUERY_STRING")
WAPurl=replace(WAPurl,"&","@@")
end if
sid_url=WAPurl
End Function
function bin2dec(binStr)
towPow=1
nUMLen=len(binStr)
bin2Dec=0
decPos=numLen
do while decPos>0
cChar=mid(binStr,decPos,1)
nChar=Cint(cChar)
bin2Dec=bin2Dec+nChar*towPow
towPow=towPow*2
decPos=decPos-1
Loop
end function
function dec2bin(octNumber)
vara=octNumber
do
dec2bin=cstr(vara mod 2) & dec2bin
vara=vara \ 2
loop until vara=0
end function
Bstr_base64="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
function enCode_base64(strBin)
bins=""
for i=1 to lenB(strBin)
varTm=AscB(midB(strBin,i,1))
bins=bins & right("00000000" & dec2bin(varTm),8)
if i mod 3=0 then
for w=0 to 3
sixBin=mid(bins,w*6+1,6)
nChar=bin2Dec(sixBin)+1
enCode_base64=enCode_base64 & mid(Bstr_base64,nChar,1)
next
bins=""
end if
next
if bins<>"" then
pads=3-len(bins) \ 8
exitLoop=false
do while not exitLoop
nChar=left(bins,6)
if len(nChar)<6 then
nChar=left(nChar & "000000",6)
exitLoop=true
end if
nNum=bin2dec(nChar)+1
enCode_base64=enCode_base64 & mid(Bstr_base64,nNum,1)
bins=mid(bins,7)
Loop
enCode_base64=enCode_base64 & String(pads,"=")
end if
end function
Dim User_Ip
User_Ip=Request.servervariables("REMOTE_ADDR")
call IpLock(User_Ip)
Sub IpLock(User_Ip)
Dim IpArray,WhyIpLock
IpArray=split(User_Ip,".")
Dim IpSQL,IpRS
IpSQL="SELECT iplock From IpLock Where "& _
" (ipsame=4 and ip1="&Cint(IpArray(0))&" and ip2="&Cint(IpArray(1))&" and ip3="&Cint(IpArray(2))&" and ip4="&Cint(IpArray(3))&" ) "& _
" Or (ipsame=3 and ip1="&Cint(IpArray(0))&" and ip2="&Cint(IpArray(1))&" and ip3="&Cint(IpArray(2))&" ) "& _
" Or (ipsame=2 and ip1="&Cint(IpArray(0))&" and ip2="&Cint(IpArray(1))&" ) "& _
" Or (ipsame=1 and ip1="&Cint(IpArray(0))&" ) Order By ipid "
Set IpRS=Conn.execute(IpSQL)
If Not (IpRS.bof or IpRS.eof) Then
WhyIpLock=split(IpRS("iplock"),"|")
call head()
Response.write ""
Response.Write"你使用的IP段或IP地址已被封锁"
Response.Write"
封锁原因:"&WhyIpLock(1)
Response.Write"
封锁时间:"&WhyIpLock(0)
Response.write "
"
Response.End
End If
Set IpRS=Nothing
End Sub
Function RequestStr(sTemp)
if trim(sTemp) ="" then
sTemp="null"
else
RequestStr = replace(trim(sTemp),"'","''")
end if
End function
%>