<!-- #include file="data.asp" -->

<%
'==============改路据库路径请到INC文件夹的data.asp文件====
getsj=2     '2为正常开放，1为升级中
if getsj=1 then
call head()
  Response.write "<card title=""对不起！网站升级中""><p>"
  Response.write "对不起！网站升级中,请稍后访问，谢谢！"
  Response.write "<br/><anchor><prev/>&#x8FD4;&#x56DE;</anchor>" & chr(13)
  Response.write "</p></card></wml>"
  Response.end
end if
'===============龙门网MSSQL_SERVER数据库链接===============

YD_SQL_SERVERIP=""&YD_SQL_SERVERIP1&""   '数据库IP或数据库服务名
YD_SQL_UserName=""&YD_SQL_UserName1&""          '登录数据库用户名
YD_SQL_PassWord=""&YD_SQL_PassWord1&""         '登录数据库密码
YD_Main_DatabaseName=""&YD_Main_DatabaseName1&"" '主数据库名
dim conn,saytk
'On Error Resume Next

if dateSQL="0" Then
set conn=server.createobject("ADODB.connection")
conn.open "PROVIDER=SQLOLEDB;DATASOURCE="&YD_SQL_SERVERIP&";UID="&YD_SQL_UserName&";PWD="&YD_SQL_PassWord&";DATABASE="&YD_Main_DatabaseName&""

else

'===============龙门网ACCESS数据库链接===============
Set conn = Server.CreateObject("ADODB.Connection")
conn.open "driver={microsoft access driver (*.mdb)};uid=#twapp_ydzqbqsy1;pwd=520ydzq;dbq=" & Server.MapPath(""&saytkcomshuju&"")

end if

If Err Then
		err.Clear
		Set Conn = Nothing

    Response.Write "<?xml version=""1.0"" encoding=""utf-8""?>"
    Response.Write "<!DOCTYPE wml PUBLIC ""-//WAPFORUM//DTD WML 1.1//EN"" ""http://www.wapforum.org/DTD/wml_1.1.xml"">"
    Response.Write "<wml>"
    Response.Write "<head>"
    Response.Write "<meta name=""keywords"" content=""n-出错了"" />"
    Response.Write "<meta http-equiv=""Cache-Control"" content=""max-age=0""/>"
    Response.Write "<meta http-equiv=""Cache-Control"" content=""no-cache""/>"
    Response.Write "</head>"
    Response.write "<card title=""出错了""><p>"
		Response.Write"数据库连接出错,<br/>"
		'Response.write"请检查连接文件INC.inc<br/>"
                'Response.write"数据库名,帐号,密码是否正确。<br/>"
                'Response.write"<br/>"
        Response.write "</p></card></wml>"
		
		response.End
	End If
'=============================
sid=trim(request.querystring("sid"))
saytk=request.querystring("saytk")


'sql防注入代码====
YD_In = " or| and |update|exec|insert| select|delete| count|master|truncate|declare|drop|create|eval|xp_|sp_|command| dir| len| char| nchar|asc(|'| or|updateusage|databasename|tablename|sysindexes|row_counts|TableAdapter|chr(| users|adminguli|execute| join| union"

'================================================
'函数名：addwml
'作  用：时间命名的函数
'参  数：fname -文件路径, str_内容
'================================================
ppo="9566" 'addwmlklik(fame)
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 
function addasp(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 & ".asp"
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

'================================================
	Function LoadFilee(File)		'文件内容读取.

	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)
		
	.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 ling()
        call head
if saytk>1 then
Response.write "<title>出错了</title></head><body><body bgcolor="""&yanse&"""><p>"
else
        Response.write "<card title=""出错了""><p>"
end if
		Response.Write"你使用的IP段或IP地址已被封锁"
		Response.Write"<br/>封锁原因:"&WhyIpLock(1)
		Response.Write"<br/>封锁时间:"&WhyIpLock(0)
call head1()
		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
'================================================
sub Previous(num)
if saytk=1 then
%><br/><anchor><%=num%><prev/></anchor>
<%Else

%>
<br/><a href="/?sid=<%=sid%>&amp;saytk=<%=saytk%>"><%=num%></a>
<%end if
end Sub
'================================================
%>

<!-- #include file="djcc.asp" -->
<!-- #include file="xzz.asp" -->
<!-- #include file="char.asp" -->
<!-- #include file="saycard.asp"-->
<!-- #include file="Functionsay.asp" -->
<!-- #include file="tj.asp" -->
<!-- #include file="tjconn.asp" -->
<!-- #include file="updatesql.asp" -->