www.gusucode.com > 25175 学生同学录管理系统 2007 build 1231D源码程序 > inc/clsDbctrl.asp

    <%
'==========================================================================
'文件名称：clsDbCtrl.asp
'功　　能：数据库操作类
'作　　者：coldstone (coldstone[在]qq.com)
'程序版本：v1.0.5
'完成时间：2005.09.23
'修改时间：2007.10.30
'版权声明：可以在任意作品中使用本程序代码，但请保留此版权信息。
'          如果你修改了程序中的代码并得到更好的应用，请发送一份给我，谢谢。
'==========================================================================

Dim a : a = CreatConn(0, "master", "localhost", "sa", "")	'MSSQL数据库
'Dim a : a = CreatConn(1, "Data/%TestDB%.mdb", "", "", "")	'Access数据库
'Dim a : a = CreatConn(1, "E:\MyWeb\Data\%TestDB%.mdb", "", "", "mdbpassword")
Dim Conn
'OpenConn()	'在加载时就建立的默认连接对象Conn,默认使用数据库a
Sub OpenConn : Set Conn = Oc(a) : End Sub
Sub CloseConn : Co(Conn) : End Sub

Function Oc(ByVal Connstr)
	On Error Resume Next
	Dim objConn
	Set objConn = Server.CreateObject("ADODB.Connection")
	objConn.Open Connstr
	If Err.number <> 0 Then
		Response.Write("<div id=""DBError"">数据库服务器端连接错误，请与网站管理员联系。</div>")
		'Response.Write("错误信息：" & Err.Description)
		objConn.Close
		Set objConn = Nothing
		Response.End
	End If
	Set Oc = objConn
End Function

Sub Co(obj)
	On Error Resume Next
	Set obj = Nothing
End Sub

Function CreatConn(ByVal dbType, ByVal strDB, ByVal strServer, ByVal strUid, ByVal strPwd)
	Dim TempStr
	Select Case dbType
		Case "0","MSSQL"
			TempStr = "driver={sql server};server="&strServer&";uid="&strUid&";pwd="&strPwd&";database="&strDB
		Case "1","ACCESS"
			Dim tDb : If Instr(strDB,":")>0 Then : tDb = strDB : Else : tDb = Server.MapPath(strDB) : End If
			TempStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&tDb&";Jet OLEDB:Database Password="&strPwd&";"
		Case "3","MYSQL"
			TempStr = "Driver={mySQL};Server="&strServer&";Port=3306;Option=131072;Stmt=; Database="&strDB&";Uid="&strUid&";Pwd="&strPwd&";"
		Case "4","ORACLE"
			TempStr = "Driver={Microsoft ODBC for Oracle};Server="&strServer&";Uid="&strUid&";Pwd="&strPwd&";"
	End Select
	CreatConn = TempStr
End Function


Class dbCtrl
	Private debug
	Private idbConn
	Private idbErr
	
	Private Sub Class_Initialize()
		debug = true					'调试模式是否开启
		idbErr = "出现错误："
		If IsObject(Conn) Then
			Set idbConn = Conn
		End If
	End Sub
	
	Private Sub Class_Terminate()
		Set idbConn = Nothing
		If debug And idbErr<>"出现错误：" Then Response.Write(idbErr)
	End Sub
	
	Public Property Let dbConn(pdbConn)
		If IsObject(pdbConn) Then
			Set idbConn = pdbConn
		Else
			Set idbConn = Conn
		End If
	End Property
	
	Public Property Get dbErr()
		dbErr = idbErr
	End Property
	
	Public Property Get Version
		Version = "ASP Database Ctrl V1.0 By ColdStone"
	End Property

	Public Function AutoID(ByVal TableName)
		On Error Resume Next
		Dim m_No,Sql, m_FirTempNo
		Set m_No=Server.CreateObject("adodb.recordset")
		Sql="SELECT * FROM ["&TableName&"]"
		m_No.Open Sql,idbConn,3,3
		If m_No.EOF Then
			AutoID=1
		Else
			Do While Not m_No.EOF
				m_FirTempNo=m_No.Fields(0).Value 
				m_No.MoveNext
				  If m_No.EOF Then 
						AutoID=m_FirTempNo+1
				  End If
			Loop
		End If
		If Err.number <> 0 Then
			idbErr = idbErr & "无效的查询条件！<br />"
			If debug Then idbErr = idbErr & "错误信息："& Err.Description
			Response.End()
			Exit Function
		End If
		m_No.close
		Set m_No = Nothing
	End Function

	Public Function GetRecord(ByVal TableName,ByVal FieldsList,ByVal Condition,ByVal OrderField,ByVal ShowN)
		On Error Resume Next
		Dim rstRecordList
		Set rstRecordList=Server.CreateObject("adodb.recordset")
			With rstRecordList
			.ActiveConnection = idbConn
			.CursorType = 3
			.LockType = 3
			.Source = wGetRecord(TableName,FieldsList,Condition,OrderField,ShowN)
			.Open 
			If Err.number <> 0 Then
				idbErr = idbErr & "无效的查询条件！<br />"
				If debug Then idbErr = idbErr & "错误信息："& Err.Description
				.Close
				Set rstRecordList = Nothing
				Response.End()
				Exit Function
			End If	
		End With
		Set GetRecord=rstRecordList
	End Function
	
	Public Function wGetRecord(ByVal TableName,ByVal FieldsList,ByVal Condition,ByVal OrderField,ByVal ShowN)
		Dim strSelect
		strSelect="select "
		If ShowN > 0 Then
			strSelect = strSelect & " top " & ShowN & " "
		End If
		If FieldsList<>"" Then
			strSelect = strSelect & FieldsList
		Else
			strSelect = strSelect & " * "
		End If
		strSelect = strSelect & " from [" & TableName & "]"
		If Condition <> "" Then
			strSelect = strSelect & " where " & ValueToSql(TableName,Condition,1)
		End If
		If OrderField <> "" Then
			strSelect = strSelect & " order by " & OrderField
		End If
		wGetRecord = strSelect
	End Function

	Public Function GetRecordBySQL(ByVal strSelect)
		On Error Resume Next
		Dim rstRecordList
		Set rstRecordList=Server.CreateObject("adodb.recordset")
			With rstRecordList
			.ActiveConnection =idbConn
			.CursorType = 3
			.LockType = 3
			.Source = strSelect
			.Open 
			If Err.number <> 0 Then
				idbErr = idbErr & "无效的查询条件！<br />"
				If debug Then idbErr = idbErr & "错误信息："& Err.Description
				.Close
				Set rstRecordList = Nothing
				Response.End()
				Exit Function
			End If	
		End With
		Set GetRecordBySQL = rstRecordList
	End Function

	Public Function GetRecordDetail(ByVal TableName,ByVal Condition)
		On Error Resume Next
		Dim rstRecordDetail, strSelect
		Set rstRecordDetail=Server.CreateObject("adodb.recordset")
		With rstRecordDetail
			.ActiveConnection =idbConn
			strSelect = "select * from [" & TableName & "] where " & ValueToSql(TableName,Condition,1)
			.CursorType = 3
			.LockType = 3
			.Source = strSelect
			.Open 
			If Err.number <> 0 Then
				idbErr = idbErr & "无效的查询条件！<br />"
				If debug Then idbErr = idbErr & "错误信息："& Err.Description
				.Close
				Set rstRecordDetail = Nothing
				Response.End()
				Exit Function
			End If
		End With
		Set GetRecordDetail=rstRecordDetail
	End Function

	Public Function AddRecord(ByVal TableName, ByVal ValueList)
		On Error Resume Next
		DoExecute(wAddRecord(TableName,ValueList))
		If Err.number <> 0 Then
			idbErr = idbErr & "写入数据库出错！<br />"
			If debug Then idbErr = idbErr & "错误信息："& Err.Description
			'DoExecute "ROLLBACK TRAN Tran_Insert"	'如果存在添加事务（事务滚回）
			AddRecord = 0
			Exit Function
		End If
		AddRecord = AutoID(TableName)-1
	End Function
	
	Public Function wAddRecord(ByVal TableName, ByVal ValueList)
		Dim TempSQL, TempFiled, TempValue
		TempFiled = ValueToSql(TableName,ValueList,2)
		TempValue = ValueToSql(TableName,ValueList,3)
		TempSQL = "Insert Into [" & TableName & "] (" & TempFiled & ") Values (" & TempValue & ")"
		wAddRecord = TempSQL
	End Function

	Public Function UpdateRecord(ByVal TableName,ByVal Condition,ByVal ValueList)
		On Error Resume Next
		DoExecute(wUpdateRecord(TableName,Condition,ValueList))
		If Err.number <> 0 Then
			idbErr = idbErr & "更新数据库出错！<br />"
			If debug Then idbErr = idbErr & "错误信息："& Err.Description
			'DoExecute "ROLLBACK TRAN Tran_Update"	'如果存在添加事务（事务滚回）
			UpdateRecord = 0
			Exit Function
		End If
		UpdateRecord = 1
	End Function

	Public Function wUpdateRecord(ByVal TableName,ByVal Condition,ByVal ValueList)
		Dim TmpSQL
		TmpSQL = "Update ["&TableName&"] Set "
		TmpSQL = TmpSQL & ValueToSql(TableName,ValueList,0)
		TmpSQL = TmpSQL & " Where " & ValueToSql(TableName,Condition,1)
		wUpdateRecord = TmpSQL
	End Function

	Public Function DeleteRecord(ByVal TableName,ByVal IDFieldName,ByVal IDValues)
		On Error Resume Next
		Dim Sql
		Sql = "Delete From ["&TableName&"] Where ["&IDFieldName&"] In ("
		If IsArray(IDValues) Then
			Sql = Sql & "Select ["&IDFieldName&"] From ["&TableName&"] Where " & ValueToSql(TableName,IDValues,1)
		Else
			Sql = Sql & IDValues
		End If
		Sql = Sql & ")"
		DoExecute(Sql)
		If Err.number <> 0 Then
			idbErr = idbErr & "删除数据出错！<br />"
			If debug Then idbErr = idbErr & "错误信息："& Err.Description
			'DoExecute "ROLLBACK TRAN Tran_Delete"	'如果存在添加事务（事务滚回）
			DeleteRecord = 0 
			Exit Function
		End If
		DeleteRecord = 1
	End Function
	
	Public Function wDeleteRecord(ByVal TableName,ByVal IDFieldName,ByVal IDValues)
		On Error Resume Next
		Dim Sql
		Sql = "Delete From ["&TableName&"] Where ["&IDFieldName&"] In ("
		If IsArray(IDValues) Then
			Sql = Sql & "Select ["&IDFieldName&"] From ["&TableName&"] Where " & ValueToSql(TableName,IDValues,1)
		Else
			Sql = Sql & IDValues
		End If
		Sql = Sql & ")"
		wDeleteRecord = Sql
	End Function 

	Public Function ReadTable(ByVal TableName,ByVal Condition,ByVal GetFieldNames)
		On Error Resume Next
		Dim rstGetValue,Sql,BaseCondition,arrTemp,arrStr,TempStr,i
		TempStr = "" : arrStr = ""
		'给出SQL条件语句
		BaseCondition = ValueToSql(TableName,Condition,1)
		'读取数据
		Set rstGetValue = Server.CreateObject("ADODB.Recordset")
		Sql = "Select "&GetFieldNames&" From ["&TableName&"] Where "&BaseCondition
		rstGetValue.Open Sql,idbConn,3,3
		If rstGetValue.RecordCount > 0 Then
			If Instr(GetFieldNames,",")>0 Then
				arrTemp = Split(GetFieldNames,",")
				For i = 0 To Ubound(arrTemp)
					If i<>0 Then arrStr = arrStr &Chr(112)&Chr(112)&Chr(113)
					arrStr = arrStr & rstGetValue.Fields(i).Value
				Next
				TempStr = Split(arrStr,Chr(112)&Chr(112)&Chr(113))
			Else
				TempStr = rstGetValue.Fields(0).Value
			End If
		End If
		If Err.number <> 0 Then
			idbErr = idbErr & "获取数据出错！<br />"
			If debug Then idbErr = idbErr & "错误信息："& Err.Description
			rstGetValue.close()
			Set rstGetValue = Nothing
			Exit Function
		End If
		rstGetValue.close()
		Set rstGetValue = Nothing
		ReadTable = TempStr
	End Function

	Public Function C(ByVal ObjRs)
		ObjRs.close()
		Set ObjRs = Nothing
	End Function
	
	Private Function ValueToSql(ByVal TableName, ByVal ValueList, ByVal sType)
		Dim StrTemp
		StrTemp = ValueList
		If IsArray(ValueList) Then
			StrTemp = ""
			Dim rsTemp, CurrentField, CurrentValue, i
			Set rsTemp = Server.CreateObject("adodb.recordset")
			With rsTemp
				.ActiveConnection = idbConn
				.CursorType = 3
				.LockType = 3
				.Source ="select * from [" & TableName & "] where 1 = -1"
				.Open
				For i = 0 to Ubound(ValueList)
					CurrentField = Left(ValueList(i),Instr(ValueList(i),":")-1)
					CurrentValue = Mid(ValueList(i),Instr(ValueList(i),":")+1)
					If i <> 0 Then
						Select Case sType
							Case 1
								StrTemp = StrTemp & " And "
							Case Else
								StrTemp = StrTemp & ", "
						End Select
					End If
					If sType = 2 Then
						StrTemp = StrTemp & "[" & CurrentField & "]"
					Else
						Select Case .Fields(CurrentField).Type
							Case 7,133,134,135,8,129,200,201,202,203
								If sType = 3 Then
									StrTemp = StrTemp & "'"&CurrentValue&"'"
								Else
									StrTemp = StrTemp & "[" & CurrentField & "] = '"&CurrentValue&"'"
								End If
							Case 11
								If UCase(cstr(Trim(CurrentValue)))="TRUE" Then
									If sType = 3 Then
										StrTemp = StrTemp & "1"
									Else
										StrTemp = StrTemp & "[" & CurrentField & "] = 1"
									End If
								Else 
									If sType = 3 Then
										StrTemp = StrTemp & "0"
									Else
										StrTemp = StrTemp & "[" & CurrentField & "] = 0"
									End If
								End If
							Case Else
								If sType = 3 Then
									StrTemp = StrTemp & CurrentValue
								Else
									StrTemp = StrTemp & "[" & CurrentField & "] = " & CurrentValue
								End If
						End Select
					End If
				Next
			End With
			If Err.number <> 0 Then
				idbErr = idbErr & "生成SQL语句出错！<br />"
				If debug Then idbErr = idbErr & "错误信息："& Err.Description
				rsTemp.close()
				Set rsTemp = Nothing
				Exit Function
			End If
			rsTemp.Close()
			Set rsTemp = Nothing
		End If
		ValueToSql = StrTemp
	End Function

	Private Function DoExecute(ByVal sql)
		Dim ExecuteCmd
		Set ExecuteCmd = Server.CreateObject("ADODB.Command")
		With ExecuteCmd
			.ActiveConnection = idbConn
			.CommandText = sql
			.Execute
		End With
		Set ExecuteCmd = Nothing
	End Function
End Class
%>