<%
'================================================================================================================
SqlDatabaseName="cnboatskygrey"
SqlPassword="woaiwojia13"
SqlUsername="cnboatgraysky"
SqlLocalName="(local)"
'-----------------------------------------------------------------------------------------------------
connstr="driver={SQL Server};server="&SqlLocalName&";uid="&SqlUsername&";pwd="&SqlPassword&";database="&SqlDatabaseName&";"
On Error Resume Next
Set conn = Server.CreateObject("ADODB.Connection")
conn.commandtimeout=20
conn.open ConnStr
If Err Then
err.Clear
Set Conn = Nothing
Response.Write "
数据库连接出错!请检查连接数据库的参数及字符串设置是否正确!
"
Response.End
End If
'-----------------------------------------------------------------------------------------------------
sqlconfig="select * from worldec_config"
Set rsconfig= Server.CreateObject("ADODB.Recordset")
rsconfig.open sqlconfig,conn,1,1
If rsConfig.bof And rsConfig.EOF Then
Response.Write "
网站配置数据丢失!系统无法正常运行!
"
Response.End
Else
weboff_on=""&rsconfig("weboff_on")&""
inform_y_n=""&rsconfig("inform_y_n")&""
inform=""&rsconfig("inform")&""
forum_setting=""&rsconfig("forum_setting")&""
UploadSetting=""&rsconfig("UploadSetting")&""
Uploadjpg=""&rsconfig("Uploadjpg")&""
Stopreadme=""&rsconfig("Stopreadme")&""
WebName=""&rsconfig("WebName")&""
reg_y_n=""&rsconfig("reg_y_n")&""
WebUrl=""&rsconfig("WebUrl")&""
WebUrl1=""&rsconfig("WebUrl1")&""
weburl2=""&rsconfig("weburl2")&""
userweb=""&rsconfig("userweb")&""
SMTPServer=""&rsconfig("SMTPServer")&""
SystemEmail=""&rsconfig("SystemEmail")&""
Systemtel=""&rsconfig("Systemtel")&""
hottel=""&rsconfig("hottel")&""
hotfax=""&rsconfig("hotfax")&""
worldname=""&rsconfig("worldname")&""
Company=""&rsconfig("Company")&""
add=""&rsconfig("add")&""
yb=""&rsconfig("yb")&""
worldecfuwu=""&rsconfig("worldecfuwu")&""
yhzh=""&rsconfig("yhzh")&""
bank=""&rsconfig("bank")&""
Copyright=""&rsconfig("Copyright")&""
PicUrl=""&rsconfig("PicUrl")&""
LinkUrl=""&rsconfig("LinkUrl")&""
newspic=""&rsconfig("newspic")&""
bizrepic=""&rsconfig("bizrepic")&""
search=""&rsconfig("search")&""
admin_copy=""&rsconfig("admin_copy")&""
rsconfig.close
set rsconfig=nothing
end if
'-----------------------------------------------------------------------------------------------------
'为了系统的安全,直接在有数据库连接的地方都加上SQL注入的免疫
'自定义需要过滤的字串,用 "|" 分隔
Fy_In = "'| ; | and | or | exec | insert | select | delete | update | count | * | % |chr(| char(| mid | master | truncate | declare "
'----------------------------------
Fy_Inf = split(Fy_In,"|")
If Request.QueryString<>"" Then
For Each Fy_Get In Request.QueryString
For Fy_Xh=0 To Ubound(Fy_Inf)
If Instr(LCase(Request.QueryString(Fy_Get)),Fy_Inf(Fy_Xh))<>0 Then
'--------写入数据库----------头-----
conn.Execute("insert into web_errlog(Sqlin_IP,SqlIn_Web,SqlIn_FS,SqlIn_CS,SqlIn_SJ) values('"&Request.ServerVariables("REMOTE_ADDR")&"','"&Request.ServerVariables("URL")&"','GET','"&Fy_Get&"','"&replace(Request.QueryString(Fy_Get),"'","''")&"')")
'--------写入数据库----------尾-----
response.redirect("/Error.html")
response.end
End If
Next
Next
End If
%>
<%
'过滤SQL非法字符并格式化html代码
function Replace_Text(fString)
if isnull(fString) then
Replace_Text=""
exit function
else
fString=trim(fString)
fString=replace(fString,"'","''")
fString=replace(fString,";",";")
fString=replace(fString,"--","—")
fString=server.htmlencode(fString)
Replace_Text=fString
end if
end function
'会员发布的各种信息过滤
Function changechr(fString)
If Not IsNull(fString) Then
fString = trim(fString)
'fString = replace(fString, ";", ";") '分号过滤
fString = replace(fString, "--", "——") '--过滤
fString = replace(fString, "%20", "") '特殊字符过滤
fString = replace(fString, "==", "") '==过滤
'fString = replace(fString, ">", ">")
'fString = replace(fString, "<", "<")
fString = Replace(fString, CHR(32), " ") '
fString = Replace(fString, CHR(9), " ") '
fString = Replace(fString, CHR(34), """)
fString = Replace(fString, CHR(39), "'") '单引号过滤
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), "
")
fString = Replace(fString, CHR(10), " ")
changechr = fString
End If
End Function
'过滤SQL非法字符
Function checkStr(Chkstr)
dim Str:Str=Chkstr
if isnull(Str) then
checkStr = ""
exit Function
else
Str=replace(Str,"'","")
Str=replace(Str,";","")
Str=replace(Str,"--","")
checkStr=Str
end if
End Function
'检测传递的参数是否为数字型
Function Chkrequest(Para)
Chkrequest=False
If Not (IsNull(Para) Or Trim(Para)="" Or Not IsNumeric(Para)) Then
Chkrequest=True
End If
End Function
'检测传递的参数是否为日期型
Function Chkrequestdate(Para)
Chkrequestdate=False
If Not (IsNull(Para) Or Trim(Para)="" Or Not IsDate(Para)) Then
Chkrequestdate=True
End If
End Function
'得到当前页面的地址
Function GetUrl()
On Error Resume Next
Dim strTemp
If LCase(Request.ServerVariables("HTTPS")) = "off" Then
strTemp = "http://"
Else
strTemp = "https://"
End If
strTemp = strTemp & CheckStr(Request.ServerVariables("SERVER_NAME"))
If Request.ServerVariables("SERVER_PORT") <> 80 Then strTemp = strTemp & ":" & CheckStr(Request.ServerVariables("SERVER_PORT"))
strTemp = strTemp & CheckStr(Request.ServerVariables("URL"))
If Trim(Request.QueryString) <> "" Then strTemp = strTemp & "?" & CheckStr(Trim(Request.QueryString))
GetUrl = strTemp
End Function
'检查用户是否在浏览器里输入了本页的地址
Function CheckReferer()
Dim sReferer, Icheck
CheckReferer = True
sReferer = Request.ServerVariables("HTTP_REFERER")
ServerIP = Request.ServerVariables("LOCAL_ADDR")
Icheck = InStr(sReferer, "ServerIP")
If Icheck = 0 Then
CheckReferer = False
End If
End Function
'日期格式化
Function FormatDate(DT,tp)
dim Y,M,D
Y=Year(DT)
M=month(DT)
D=Day(DT)
if M<10 then M="0"&M
if D<10 then D="0"&D
select case tp
case 1 FormatDate=Y&"年"&M&"月"&D&"日"
case 2 FormatDate=Y&"/"&M&"/"&D
case 3 FormatDate=M&"/"&D
case 4 FormatDate=Y&"\"&M&"\"&D
end select
End Function
'不允许外部提交数据的选择
Function ChkPost()
dim HTTP_REFERER,SERVER_NAME
dim server_v1,server_v2
chkpost=false
SERVER_NAME=CheckStr(Request.ServerVariables("SERVER_NAME"))
HTTP_REFERER=CheckStr(Request.ServerVariables("HTTP_REFERER"))
server_v1=Cstr(HTTP_REFERER)
server_v2=Cstr(SERVER_NAME)
if mid(server_v1,8,len(server_v2))<>server_v2 then
chkpost=false
else
chkpost=true
end if
End Function
'构造上传图片文件名随机数
function MakedownName()
dim fname
fname = now()
fname = replace(fname,"-","")
fname = replace(fname," ","")
fname = replace(fname,":","")
fname = replace(fname,"PM","")
fname = replace(fname,"AM","")
fname = replace(fname,"上午","")
fname = replace(fname,"下午","")
fname = int(fname) + int((10-1+1)*Rnd + 1)
MakedownName=fname
end function
'Email检测
function IsValidEmail(email)
dim names, name, i, c
IsValidEmail = true
names = Split(email, "@")
if UBound(names) <> 1 then
IsValidEmail = false
exit function
end if
for each name in names
if Len(name) <= 0 then
IsValidEmail = false
exit function
end if
for i = 1 to Len(name)
c = Lcase(Mid(name, i, 1))
if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
IsValidEmail = false
exit function
end if
next
if Left(name, 1) = "." or Right(name, 1) = "." then
IsValidEmail = false
exit function
end if
next
if InStr(names(1), ".") <= 0 then
IsValidEmail = false
exit function
end if
i = Len(names(1)) - InStrRev(names(1), ".")
if i <> 2 and i <> 3 then
IsValidEmail = false
exit function
end if
if InStr(email, "..") > 0 then
IsValidEmail = false
end if
end function
'Jmail邮件发送
Function SendJmail(Email,Topic,MailBody)
Dim JMail
on error resume next
Set JMail = Server.CreateObject("JMail.SMTPMail")
JMail.LazySend = true
JMail.silent = true
JMail.Charset = "gb2312"
JMail.ContentType = "text/html"
JMail.Sender = ""&SMTPServer&""
JMail.ReplyTo = ""&SystemEmail&""
JMail.SenderName = ""&webname&"邮件发送系统"
JMail.Subject = Topic
JMail.SimpleLayout = true
JMail.Body = MailBody
JMail.Priority = 1
JMail.AddRecipient Email
JMail.AddHeader "Originating-IP", GBL_IPAddress
If JMail.Execute() = false Then
SendJmail = 0
Else
SendJmail = 1
End If
JMail.Close
Set JMail = Nothing
End Function
'分页
Function listPages(LinkFile)
if not (rs.eof and rs.bof) then
gopage=currentpage
totalpage=n
blockPage=Int((gopage-1)/10)*10+1
' if instr(linkfile,"?page=")>0 or instr(linkfile,"&page=")>0 then
' pos=instr(linkfile,"page=")-2
' linkfile=left(linkfile,pos)
' end if
If LCase(Request.ServerVariables("HTTPS")) = "off" Then
strTemp = "http://"
Else
strTemp = "https://"
End If
strTemp = strTemp & CheckStr(Request.ServerVariables("SERVER_NAME"))
If Request.ServerVariables("SERVER_PORT") <> 80 Then strTemp = strTemp & ":" & CheckStr(Request.ServerVariables("SERVER_PORT"))
strTemp = strTemp & CheckStr(Request.ServerVariables("URL"))
lenstrTemp=len(strTemp)+1
if instr(left(linkfile,lenstrTemp),"?")>0 then
if blockPage = 1 Then
Response.Write "【←前10页 "
Else
Response.Write("【←前10页 ")
End If
i=1
Do Until i > 10 or blockPage > n
If blockPage=int(gopage) Then
Response.Write("["&blockPage&"]")
Else
Response.Write(" ["&blockPage&"] ")
End If
blockPage=blockPage+1
i = i + 1
Loop
if blockPage > totalpage Then
Response.Write " 后10页→】"
Else
Response.Write(" 后10页→】")
End If
response.write" 直接到第 "
response.write""
response.write" 页
"
else
if blockPage = 1 Then
Response.Write "【←前10页 "
Else
Response.Write("【←前10页 ")
End If
i=1
Do Until i > 10 or blockPage > n
If blockPage=int(gopage) Then
Response.Write("["&blockPage&"]")
Else
Response.Write(" ["&blockPage&"] ")
End If
blockPage=blockPage+1
i = i + 1
Loop
if blockPage > totalpage Then
Response.Write " 后10页→】"
Else
Response.Write(" 后10页→】")
End If
response.write" 直接到第 "
response.write""
response.write" 页
"
End If
Startinfo=((gopage-1)*msg_per_page)+1
Endinfo=gopage*msg_per_page
if Endinfo>totalrec then Endinfo=totalrec
Response.Write(" 共 "&totalrec&" 条信息 当前显示第 "&Startinfo&" - "&Endinfo&" 条 每页 "&msg_per_page&" 条信息 共 "&n&" 页")
end if
End Function
'分页2
Function listPages2(LinkFile)
if not (rs.eof and rs.bof) then
gopage=currentpage
totalpage=n
blockPage=Int((gopage-1)/10)*10+1
If LCase(Request.ServerVariables("HTTPS")) = "off" Then
strTemp = "http://"
Else
strTemp = "https://"
End If
strTemp = strTemp & CheckStr(Request.ServerVariables("SERVER_NAME"))
If Request.ServerVariables("SERVER_PORT") <> 80 Then strTemp = strTemp & ":" & CheckStr(Request.ServerVariables("SERVER_PORT"))
strTemp = strTemp & CheckStr(Request.ServerVariables("URL"))
lenstrTemp=len(strTemp)+1
if instr(left(linkfile,lenstrTemp),"?")>0 then
if blockPage = 1 Then
Response.Write "前10页 "
Else
Response.Write("前10页 ")
End If
i=1
Do Until i > 10 or blockPage > n
If blockPage=int(gopage) Then
Response.Write(""&blockPage&"")
Else
Response.Write(" "&blockPage&" ")
End If
blockPage=blockPage+1
i = i + 1
Loop
if blockPage > totalpage Then
Response.Write " 后10页"
Else
Response.Write(" 后10页")
End If
response.write" 直接到第 "
response.write""
response.write" 页
"
else
if blockPage = 1 Then
Response.Write "【←前10页 "
Else
Response.Write("【←前10页 ")
End If
i=1
Do Until i > 10 or blockPage > n
If blockPage=int(gopage) Then
Response.Write("["&blockPage&"]")
Else
Response.Write(" ["&blockPage&"] ")
End If
blockPage=blockPage+1
i = i + 1
Loop
if blockPage > totalpage Then
Response.Write " 后10页→】"
Else
Response.Write(" 后10页→】")
End If
response.write" 直接到第 "
response.write""
response.write" 页
"
End If
Startinfo=((gopage-1)*msg_per_page)+1
Endinfo=gopage*msg_per_page
if Endinfo>totalrec then Endinfo=totalrec
Response.Write(" 共 "&totalrec&" 条信息 当前显示第 "&Startinfo&" - "&Endinfo&" 条 每页 "&msg_per_page&" 条信息 共 "&n&" 页")
end if
End Function
'判断文件类型是否合格
Function CheckFileExt(FileExt)
Dim ForumUpload,i
ForumUpload="gif,jpg,bmp,jpeg,png,swf"
ForumUpload=Split(ForumUpload,",")
CheckFileExt=False
For i=0 to UBound(ForumUpload)
If LCase(FileExt)=Lcase(Trim(ForumUpload(i))) Then
CheckFileExt=True
Exit Function
End If
Next
End Function
'格式后缀
Function FixName(UpFileExt)
If IsEmpty(UpFileExt) Then Exit Function
FixName = Lcase(UpFileExt)
FixName = Replace(FixName,Chr(0),"")
FixName = Replace(FixName,".","")
FixName = Replace(FixName,"asp","")
FixName = Replace(FixName,"asa","")
FixName = Replace(FixName,"aspx","")
FixName = Replace(FixName,"cer","")
FixName = Replace(FixName,"cdx","")
FixName = Replace(FixName,"htr","")
End Function
'文件Content-Type判断
Function CheckFileType(FileType)
CheckFileType = False
If Left(Cstr(Lcase(Trim(FileType))),6)="image/" Then CheckFileType = True
End Function
'获取IP地址
Function getIP()
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
getIP = Trim(Mid(strIPAddr, 1, 30))
End Function
'分离关键词中字符
function splitChar(str)
oldstring=str
newstring=""
oldsign=0
newsign=0
i=len(oldstring)
for j=1 to i
if asc(mid(oldstring,j,1))<0 then
newsign=1
else
newsign=0
end if
if j=1 then
oldsign=newsign
end if
if oldsign=newsign then
newstring=newstring+mid(oldstring,j,1)
else
newstring=newstring+" "+mid(oldstring,j,1)
end if
oldsign=newsign
next
splitChar=newstring
end function
'突出显示匹配搜索关键词字符
Function dispRed(str,Dstr)
Dstrgroup=Split(Dstr, " ", -1, 1)
for i=0 to UBound(Dstrgroup)
if InStr(1,str,Dstrgroup(i),1)<>0 then
str1=mid(str,InStr(1,str,Dstrgroup(i),1),len(Dstrgroup(i)))
str=replace(str,Dstrgroup(i),""&str1&"",1,-1,1)
end if
next
dispRed=str
end Function
'URL数据获取
Function getUrl(url)
dim Str
dim Http
dim Arr
set Http=CreateObject("Microsoft.XMLHTTP")
Http.open "GET",url,false
Http.send()
if Http.readystate<>4 then
exit function
end if
Str=bytesToBSTR(Http.responseBody,"GB2312")
getUrl=Str
set http=nothing
if err.number<>0 then err.Clear
End Function
'格式化榨取数据
Function BytesToBstr(body,Cset)
dim objstream
set objstream = CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Close
set objstream = nothing
End Function
'搜索时去除HTML标记
Function LoseHtml(ContentStr)
Dim ClsTempLoseStr,regEx
ClsTempLoseStr = Cstr(ContentStr)
Set regEx = New RegExp
regEx.Pattern = "<\/*[^<>]*>"
regEx.IgnoreCase = True
regEx.Global = True
ClsTempLoseStr = regEx.Replace(ClsTempLoseStr,"")
LoseHtml = ClsTempLoseStr
End Function
%>
<%
set rs=server.createobject("adodb.recordset")
rs.open ("select * from expo"),conn,1,1
%>