<%
'程序制作：广州网域高科
%>
<%
Option Explicit
dim db
dim ConnStr
dim rs,rs2
dim exec
Dim Sql,Type_Name
dim newstitle,origin,author,vcontent
dim thetime,theyear,themon,theday,thehor,themin,thesec
dim wenjian,newsurl,sqlstr,StrSql,pencat
dim fso,fout
Dim VbStr
VbStr = Chr(13) & Chr(10)

' ============================================
' 常用全局变量
' ============================================
' 数据库对象
Dim oConn, oRs, sSql


' ============================================
' 初始数据处理
' ============================================
' 执行每天只需处理一次的事件
Call BrandNewDay()

' 初始化数据库连接
'Call DBConnBegin()


' ********************************************
' 以下为初始函数
' ********************************************
' ============================================
' 执行每天只需处理一次的事件
' ============================================
Sub BrandNewDay()
	Dim sDate, y, m, d, w
	Dim sDateChinese
	sDate = Date()
	If Application("date_today") = sDate Then Exit Sub

	y = CStr(Year(sDate))
	m = CStr(Month(sDate))
	If Len(m) = 1 Then m = "0" & m
	d = CStr(Day(sDate))
	If Len(d) = 1 Then d = "0" & d
	w = WeekdayName(Weekday(sDate))
	sDateChinese = y & "年" & m & "月" & d & "日&nbsp;" & w

	Application.Lock
	Application("date_today") = sDate
	Application("date_chinese") = sDateChinese		'今天的中文样式
	Application.Unlock
End Sub



' ********************************************
' 以下为数据库相关函数
' ********************************************
' ============================================
' 初始化数据库连接对象
' 使用原则：最迟调用，最早释放
' ============================================
Sub DBConnBegin()
	' 如果数据库对象已打开，不要再打开
	' 你可以不需要打开数据库连接对象而直接打开记录集对象，但如果你需要打开多个记录集对象的话，效率是很低的。
	' 如果你不创建一个数据库连接对象，ADO会在每个记录集打开时自动创建一个新的数据库连接对象，就算你用的是相同的SQL语句。
	Set oConn = Server.CreateObject("ADODB.Connection")

	' On Error Resume Next
	IF ESCMS_DATE_TYPE = 0 THEN
	' Access数据库
	IF ESCMS_ROOT_DIR <> "" then
	db="../database/#wygkcnjd.asp" 
	ELSE 
	db="/" & ESCMS_DATE_DIR & "/" & ESCMS_DATE_NAME
	END IF
	'db="/e/Database/#ESCMS#.mdb" '数据库名称
	oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Server.MapPath(""&db&"")
	ELSEIF ESCMS_DATE_TYPE = 1 THEN
	' SQL Server 2000数据库
	oConn.Open "Provider=SQLOLEDB.1;Server=localhost;UID=eFsys;PWD=321;Database=ESCMS"
	END IF
	
	If Err.Number > 0 Then
		' 显示错误信息,并且发送邮件通知管理员
		'Call DBConnError(Err)
		
		' 完全地退出正在运行的脚本
		Response.End
	End If

	' 创建一个记录集
	Set oRs = Server.CreateObject( "ADODB.Recordset" )
End Sub

' ============================================
' 释放数据库连接对象
' ============================================
Sub DBConnEnd()
	' On Error Resume Next
'	oRs.Close
	Set oRs = Nothing
	oConn.Close
	Set oConn = Nothing
End Sub



' ********************************************
' 以下为常用函数
' ********************************************
' ============================================
' 错误返回处理
' ============================================
Sub Go_Error(str)
	Call DBConnEnd()
	Response.Write "<script language=javascript>alert('" & str & "\n\n系统将自动返回前一页面...');history.back();</script>"
	Response.End
End Sub

' ============================================
' 格式化时间(显示)
' 参数：n_Flag
'	1:"yyyy-mm-dd hh:mm:ss"
'	2:"yyyy-mm-dd"
'	3:"hh:mm:ss"
'	4:"yyyy年mm月dd日"
'	5:"yyyymmdd"
' ============================================
Function Format_Time(s_Time, n_Flag)
	Dim y, m, d, h, mi, s
	Format_Time = ""
	If IsDate(s_Time) = False Then Exit Function
	y = cstr(year(s_Time))
	m = cstr(month(s_Time))
	If len(m) = 1 Then m = "0" & m
	d = cstr(day(s_Time))
	If len(d) = 1 Then d = "0" & d
	h = cstr(hour(s_Time))
	If len(h) = 1 Then h = "0" & h
	mi = cstr(minute(s_Time))
	If len(mi) = 1 Then mi = "0" & mi
	s = cstr(second(s_Time))
	If len(s) = 1 Then s = "0" & s
	Select Case n_Flag
	Case 1
		' yyyy-mm-dd hh:mm:ss
		Format_Time = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
	Case 2
		' yyyy-mm-dd
		Format_Time = y & "-" & m & "-" & d
	Case 3
		' hh:mm:ss
		Format_Time = h & ":" & mi & ":" & s
	Case 4
		' yyyy年mm月dd日
		Format_Time = y & "年" & m & "月" & d & "日"
	Case 5
		' yyyymmdd
		Format_Time = y & m & d
	End Select
End Function

' ============================================
' 把字符串进行HTML解码,替换server.htmlencode
' 去除Html格式，用于显示输出
' ============================================
Function outHTML(str)
	Dim sTemp
	sTemp = str
	outHTML = ""
	If IsNull(sTemp) = True Then
		Exit Function
	End If
	sTemp = Replace(sTemp, "&", "&amp;")
	sTemp = Replace(sTemp, "<", "&lt;")
	sTemp = Replace(sTemp, ">", "&gt;")
	sTemp = Replace(sTemp, Chr(34), "&quot;")
	sTemp = Replace(sTemp, Chr(10), "<br>")
	outHTML = sTemp
End Function

' ============================================
' 去除Html格式，用于从数据库中取出值填入输入框时
' 注意：value="?"这边一定要用双引号
' ============================================
Function inHTML(str)
	Dim sTemp
	sTemp = str
	inHTML = ""
	If IsNull(sTemp) = True Then
		Exit Function
	End If
	sTemp = Replace(sTemp, "&", "&amp;")
	sTemp = Replace(sTemp, "<", "&lt;")
	sTemp = Replace(sTemp, ">", "&gt;")
	sTemp = Replace(sTemp, Chr(34), "&quot;")
	inHTML = sTemp
End Function

' ============================================
' 检测上页是否从本站提交
' 返回:True,False
' ============================================
Function IsSelfRefer()
	Dim sHttp_Referer, sServer_Name
	sHttp_Referer = CStr(Request.ServerVariables("HTTP_REFERER"))
	sServer_Name = CStr(Request.ServerVariables("SERVER_NAME"))
	If Mid(sHttp_Referer, 8, Len(sServer_Name)) = sServer_Name Then
		IsSelfRefer = True
	Else
		IsSelfRefer = False
	End If
End Function

' ============================================
' 得到安全字符串,在查询中使用
' ============================================
Function Get_SafeStr(str)
	Get_SafeStr = Replace(Replace(Replace(Trim(str), "'", ""), Chr(34), ""), ";", "")
End Function

' ============================================
' 取实际字符长度
' ============================================
Function Get_TrueLen(str)
	Dim l, t, c, i
	l = Len(str)
	t = l
	For i = 1 To l
		c = Asc(Mid(str, i, 1))
		If c < 0 Then c = c + 65536
		If c > 255 Then t = t + 1
	Next
	Get_TrueLen = t
End Function

' ============================================
' 判断是否安全字符串,在注册登录等特殊字段中使用
' ============================================
Function IsSafeStr(str)
	Dim s_BadStr, n, i
	s_BadStr = "' 　&<>?%,;:()`~!@#$^*{}[]|+-=" & Chr(34) & Chr(9) & Chr(32)
	n = Len(s_BadStr)
	IsSafeStr = True
	For i = 1 To n
		If Instr(str, Mid(s_BadStr, i, 1)) > 0 Then
			IsSafeStr = False
			Exit Function
		End If
	Next
End Function

'==============================================
'一个加密的函数
'==============================================

Function EnPas(CodeStr)
	Dim CodeLen,CodeSpace,NewCode,cecr,cecb,cec
	CodeLen = 30
	CodeSpace = CodeLen - Len(CodeStr)
	If Not CodeSpace < 1 Then
		For cecr = 1 To CodeSpace
			CodeStr = CodeStr & Chr(21)
		Next
	End If
	NewCode = 1
	Dim Been
	For cecb = 1 To CodeLen
		Been = CodeLen + Asc(Mid(CodeStr,cecb,1)) * cecb
		NewCode = NewCode * Been
	Next
	CodeStr = NewCode
	NewCode = Empty
	For cec = 1 To Len(CodeStr)
		NewCode = NewCode & CfsCode(Mid(CodeStr,cec,3))
	Next
	For cec = 20 To Len(NewCode) - 18 Step 2
		EnPas = EnPas & Mid(NewCode,cec,1)
	Next
		EnPas = "ES-" & EnPas
End Function

Function CfsCode(Word)
	Dim cc
	For cc = 1 To Len(Word)
		CfsCode = CfsCode & Asc(Mid(Word,cc,1))
	Next
	CfsCode = Hex(CfsCode)
End Function

'过滤跨站脚本和HTML标签,codez by foosun

Function NoHtmlHackInput(Str) 
	Dim regEx
	Set regEx = New RegExp
	regEx.IgnoreCase = True
	regEx.Pattern = "<|>|(script)|on(mouseover|mouseon|mouseout|click|dblclick|blur|focus|change)|eval|\t"
	If regEx.Test(LCase(Str)) Then
			Response.Write "<html><title>警告</title><body bgcolor=""EEEEEE"" leftmargin=""60"" topmargin=""30""><font style=""font-size:16px;font-weight:bolder;color:blue;""><li>您提交的数据有恶意字符</li></font><font style=""font-size:14px;font-weight:bolder;color:red;""><br><li>提交的内容不能包括[<|>|(script)|on(mouseover|mouseon|mouseout|click|dblclick|blur|focus|change)|eval]</li><li>您的数据已经被记录!</li><br><li>您的IP："&Request.ServerVariables("Remote_Addr")&"</li><br><li>操作日期："&Now&"</li></font></body></html>"
			Response.End
	End If
	Set regEx = Nothing
	NoHtmlHackInput = Str
End Function

'获得中文字数，1个中文站2个字符，codez by Simpwind,foosun
	Function GotTopic(Str,StrLen)
		Dim l,t,c, i,LableStr,regEx,Match,Matches
		If StrLen=0 then
			GotTopic=""
			exit function
		End If
		if IsNull(Str) then
			GotTopic = ""
			Exit Function
		end if
		if Str = "" then
			GotTopic=""
			Exit Function
		end If
		Str=Replace(Replace(Replace(Replace(Str,"&nbsp;"," "),"&quot;",Chr(34)),"&gt;",">"),"&lt;","<")
		l=len(str)
		t=0
		strlen=Clng(strLen)
		for i=1 to l
			c=Abs(Asc(Mid(str,i,1)))
			if c>255 then
				t=t+2
			else
				t=t+1
			end if
			if t>=strlen then
				GotTopic=left(str,i)
				exit for
			else
				GotTopic=str
			end if
		Next
		GotTopic = Replace(Replace(GotTopic," ","&nbsp;"),Chr(34),"&quot;")
	End Function

'过滤安全字符
Function SafeRequest(ParaName,ParaType) 
'--- 传入参数 --- 
'ParaName:参数名称-字符型 
'ParaType:参数类型-数字型(1表示以上参数是数字，0表示以上参数为字符) 

Dim ParaValue 
ParaValue=Request(ParaName) 
If ParaType=1 then 
If not isNumeric(ParaValue) then 
Response.write "参数" & ParaName & "必须为数字型！<br /><br />" 
Response.end 
End if 
Else 
ParaValue=replace(ParaValue,"'","''") 
	ParaValue = Replace(ParaValue, "select", "sel&#101;ct")
	ParaValue = Replace(ParaValue, "join", "jo&#105;n")
	ParaValue = Replace(ParaValue, "union", "un&#105;on")
	ParaValue = Replace(ParaValue, "where", "wh&#101;re")
	ParaValue = Replace(ParaValue, "insert", "ins&#101;rt")
	ParaValue = Replace(ParaValue, "delete", "del&#101;te")
	ParaValue = Replace(ParaValue, "update", "up&#100;ate")
	ParaValue = Replace(ParaValue, "like", "lik&#101;")
	ParaValue = Replace(ParaValue, "drop", "dro&#112;")
	ParaValue = Replace(ParaValue, "create", "cr&#101;ate")
	ParaValue = Replace(ParaValue, "modify", "mod&#105;fy")
	ParaValue = Replace(ParaValue, "rename", "ren&#097;me")
	ParaValue = Replace(ParaValue, "alter", "alt&#101;r")
	ParaValue = Replace(ParaValue, "cast", "ca&#115;t")
	ParaValue = Replace(ParaValue, "and", "an&#100;")
	ParaValue = Replace(ParaValue, "or", "o&#114;")
End if 
SafeRequest=ParaValue 
End function

Function qq(q)  '检测有效QQ号
 qq = True
 if len(q) >9 or len(q) <5 then qq = false
 If not isNumeric(q) then qq = false
 if q="" then qq = True
End Function

Function IsValidEmail(Email) '检测是否有效的E-mail地址
	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
%>
