<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%
'=========================================================
' 文件：Conn.asp
' 功能：为系统创建数据库链接，兼容Access和Sql Server
' 版本：爱雪儿图文管理系统 PAMS Version 1.1.0
' 时间：2006-01-05
' 作者：Guidy
' 版权：爱雪儿工作室 [iXuEr Studio]
'=========================================================
' Copyright (C) 2005-2008 iXuEr.Net All Rights Reserved .
' 官方网站：http://www.ixuer.net/
' 技术论坛：http://bbs.ixuer.net/
' 电子信箱：guidy@114xp.cn
'=========================================================
Option Explicit
Response.Buffer = True

Dim StarTime, EndTime
Dim Conn, DBPath, DB, ConnStr, MyRootPath, QQWryPath
Dim SqlNowString
Const IsDeBug = 1 ' 取值非0时是调试模式，1只显示数据库查询的错误信息，2会显示所有错误信息
' -------------------------------------------------------------------------------------------------------------------------
' 可修改设置：======================== 用于定义服务器端对象创建 =============================
' 这里所有的内容都是本系统要用到的组件对象，集合在这里是为了大家修改方便，同时也是为了解决杀毒软件误报的问题
' 例如：有的服务器端FSO组件进行过改名，那么您可以在这里定义自己的FSO组件对象名称
' 例如：一些杀毒软件，根据特征码"ADODB.Stream"来判断是否Asp木马，如果您修改成"ADO" & "DB.Str" & "eam"，那么就可以躲避查杀
' -------------------------------------------------------------------------------------------------------------------------
Const ServerObject_001 = "ADODB.Connection" 			' ＋必须 数据库链接对象
Const ServerObject_002 = "ADODB.RecordSet" 				' ＋必须 数据库记录集操作对象
Const ServerObject_003 = "ADODB.Stream" 				' ＋必须 文件流操作组件

Const ServerObject_004 = "Scripting.Dictionary" 		' ＋必须 内置 字典对象
Const ServerObject_005 = "Scripting.FileSystemObject" 	' ＋必须 内置 文件系统组件

Const ServerObject_006 = "JMail.Message" 				' －可选 JMail邮件收发组件
Const ServerObject_007 = "CDONTS.NewMail" 				' －可选 CDONTS邮件收发组件
Const ServerObject_008 = "Persits.MailSender" 			' －可选 AspEmail邮件收发组件
Const ServerObject_009 = "CDO.Message" 					' －可选 内置 Window 2003 New SendMailCom Object
Const ServerObject_010 = "CDO.Configuration"			' －可选 内置 CDO的Configuration对象

Const ServerObject_011 = "Persits.Upload"				' －可选 AspUpload 3.0 组件
Const ServerObject_012 = "Persits.UploadProgress"		' －可选 AspUpload 3.0 组件 上传进度对象 此组件在iXs_UpLoadAspUp3.asp有单独项目，要修改请同时修改
Const ServerObject_013 = "SoftArtisans.FileUp"			' －可选 SA-FileUp 4.0 组件
Const ServerObject_014 = "DvFile.Upload"				' －可选 DvFile.Upload 1.0 组件

Const ServerObject_015 = "CreatePreviewImage.cGvbox"	' －可选 CreatePreviewImage 组件
Const ServerObject_016 = "Persits.Jpeg"					' －可选 AspJpeg 1.2 组件
Const ServerObject_017 = "SoftArtisans.ImageGen"		' －SoftArtisans ImgWriter V1.21组件

Const ServerObject_018 = "MSXML2.XMLHTTP"				' ＋必须 MSXML2.XMLHTTP 对象
Const ServerObject_019 = "JRO.JetEngIne"				' ＋必须 JRO.JetEngIne 对象，在本系统中应用于数据库压缩，只要有数据库链接对象，这个也应该存在
' -------------------------------------------------------------------------------------------------------------------------
StarTime = Timer()
MyRootPath = ""
' -------------------------------------------------------------------------------------------------------------------------
' 可修改设置一：========================定义数据库类别，1为SQL数据库，0为Access数据库=============================
Const IsSqlDataBase = 0

If IsSqlDataBase = 1 Then
	' 必修改设置二：========================SQL数据库设置=============================================================
	' sql数据库连接参数：数据库名(SqlDatabaseName)、用户密码(SqlPassword)、用户名(SqlUsername)、
	' 连接名(SqlLocalName)（本地用local，外地用IP）
	Const SqlDatabaseName 	= "iXuEr_Pams_1" 	' 数据库名
	Const SqlUsername 		= "iXuEr_Studio"	' 用户名
	Const SqlPassword 		= "iXuEr_Studio"	' 用户密码
	Const SqlLocalName 		= "(local)"			' 连接名
	' ================================================================================================================
	SqlNowString = "GetDate()"
Else
	' 必修改设置三：========================Access数据库设置==========================================================
	' 免费用户第一次使用请在这里修改数据库地址和名称
	DBPath = "Database/"
	DB = DBPath & "iXuEr_UpLoad.mdb"
	' ================================================================================================================
	SqlNowString = "Now()"
End If
' ============================================
' 函数名称：ConnectionDatabase
' 函数功能：为全站创建主数据库连接
' ============================================
Function ConnectionDatabase()
	On Error Resume Next
	If IsSqlDataBase = 1 Then
		ConnStr = "Provider = Sqloledb; User ID = " & SqlUsername & "; Password = " & SqlPassword & "; Initial Catalog = " & SqlDatabaseName & "; Data Source = " & SqlLocalName & ";"
	Else
		'第一次使用请修改本处数据库地址并相应修改data目录中数据库名称
		ConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(MyRootPath & DB)
	End If
	
	Set Conn = Server.CreateObject(ServerObject_001)
	Conn.Open ConnStr
	
	If Err Then
		Err.Clear
		Set Conn = Nothing
		Response.Write("数据库连接错误，请检查连接字符串。")
		'Response.Write("The database connection error , please check the connection character string .")
		Response.End()
	End If
End Function
' ============================================
' 函数名称：CloseDB
' 函数功能：为全站关闭主数据库连接
' ============================================
Function CloseDB()
	Conn.Close
	Set Conn = Nothing
End Function
' ============================================
' 爱雪儿网站管理核心类（简化）
' ============================================
Dim iXs

Set iXs = New iXuEr_Core

Class iXuEr_Core
	Public UpFileObject
	Private Sub Class_Initialize
		UpFileObject 	= 0 ' UpFileObject = 1 ' 设置上传组件类型（0=无组件上传类，1=AspUpLoad3.0 ,2=SA-FileUp 4.0 ,3=DvFile.UpLoad V1.0
	End Sub
	' ============================================
	' 函数名称：Execute
	' 函数功能：使用数据库连接对象执行SQL命令
	' 其他说明：该函数可以容错
	' 传入参数：
	'   1、Command：需要执行的命令
	' 返回结果：返回执行的数据库连接对象
	' ============================================
	Public Function Execute(Command)
		If Not IsObject(Conn) Then ConnectionDatabase()
		On Error Resume Next
		'Response.Write("执行查询：" & Command & "<hr>")
		Set Execute = Conn.Execute(Command)
		If Err Then
			If IsDeBug = 0 Then
				Response.Write("刚才执行的查询出现错误,请认真检查您的语句。")
			Else
				Response.Write("查询语句为：" & Command & "<br>")
				Response.Write("错误信息为：" & Err.Description & "<br>")
			End If
			Err.Clear
			Set Execute = Nothing
			Response.End()
		End If
	End Function
	' ============================================
	' 获取 Recordset 对象
	' ============================================
	Public Function GetRs(Command, Num1, Num2)
		On Error Resume Next
		If Not IsObject(Conn) Then ConnectionDatabase()
		Set GetRs = Server.CreateObject(ServerObject_002)
		'Response.Write("执行查询：" & Command & "<br>")
		GetRs.Open Command, Conn, Num1, Num2
		If Err Then
			If IsDeBug = 0 Then
				Response.Write("创建 Recordset 对象失败,请认真检查您的语句。")
			Else
				Response.Write("查询语句为：" & Command & "<br>")
				Response.Write("错误信息为：" & Err.Description & "<br>")
			End If
			Err.Clear
			Response.End
		End If
	End Function
	' ============================================
	' 函数名称：ReqNum
	' 函数功能：检测获取的字符是否为数字
	' 其他说明：如果要获取的变量不存在就使用默认值
	' 传入参数：
	'    1、StrName：对象名称
	'    2、DefaultValue：默认值
	' 返回结果：数字
	' ============================================
	Public Function ReqNum(StrName, DefaultValue)
		ReqNum = Trim(Request(StrName))
		If ReqNum <> "" And Not IsNull(ReqNum) Then
			If Not IsNumeric(ReqNum) Then
				Response.Write("参数  " & StrName & "  必须为数字！\n\n请重新输入！")
			Else
				ReqNum = CLng(ReqNum)
			End If
		Else
			ReqNum = DefaultValue
		End If
	End Function
	' ============================================
	' 函数名称：ReqStr
	' 函数功能：从客户端获取字符串变量
	' 其他说明：如果要获取的变量不存在就使用默认值
	' 传入参数：
	'    1、StrName：对象名称
	'    2、DefaultValue：默认值
	' 返回结果：字符串
	' ============================================
	Public Function ReqStr(StrName, DefaultValue)
		Dim Str, i
		' 循环读取数据，以兼容大数据提交(注：需要在客户端使用脚本对数据进行分解)
		For i = 1 To Request(StrName).Count
			Str = Str & Request(StrName)(i)
		Next
		' 过滤非安全字符
		Str = Replace(Trim(Request(StrName)), Chr(0), "")
		Str = Replace(Str, "'", "''")
		' 替换空数据
		If Str = "" Or IsNull(Str) Then Str = DefaultValue
		ReqStr = Str
	End Function
	' ============================================
	' 定时地址跳转
	' ============================================
	Public Sub Redirect(Url, p_Time)
		On Error Resume Next
		If Url = "" Or IsNull(Url) Then Exit Sub
		If p_Time = 0 Then Response.Redirect(Url)
		Response.Write("<script language=""javascript1.2"">window.setTimeout(""location.href='" & Url & "';"", " & p_Time & ");</script>")
	End Sub
	' ============================================
	' 获取真实的IP地址 并整形为15位
	' ============================================
	Public Property Get ReqIP()
		ReqIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
		If ReqIP = "" Or IsNull(ReqIP) Then ReqIP = Request.ServerVariables("REMOTE_ADDR")
		' 如果包含代理，则取其真实IP地址
		If InStr(ReqIP, ",") Then ReqIP = Split(ReqIP, ",")(0)
		ReqIP = CStr(ReqIP)
	End Property
	' ============================================
	' 按照指定的正则表达式替换字符
	' ============================================
	Public Function ReFilter(p_Patrn, p_Str, p_Type, ReplaceWith)
		Dim RegEx
		Set RegEx = New RegExp
		If p_Type = 1 Then
			RegEx.Global = True
		Else
			RegEx.Global = False
		End If
		RegEx.Pattern = p_Patrn
		RegEx.IgnoreCase = True
		ReFilter = RegEx.Replace(p_Str, ReplaceWith)
	End Function
	' ============================================
	' 按照指定的正则表达式返回字符
	' ============================================
	Public Function ReSearch(p_Patrn, p_Str, p_Type, Spacer)
		Dim RegEx, Match, Matches , RetStr, i
		i = 0
		Set RegEx = New RegExp
		RegEx.Pattern = p_Patrn
		RegEx.IgnoreCase = True
		RegEx.Global = True
		Set Matches = RegEx.Execute(p_Str)
		For Each Match In Matches
			i = i + 1
			If p_Type = 0 Then
				RetStr = RetStr & Match.Value
				If i < Matches.Count Then RetStr = RetStr & Spacer
			Else
				RetStr = RetStr & Match.Value
				If i < Matches.Count Then RetStr = RetStr & Spacer
				If p_Type = i Then Exit For
			End If
		Next
		ReSearch = RetStr
	End Function
End Class
%>