ASP教程之ASP通用数据库操作类源代码
国内有些大的CRM厂商的ASP就写得不错.无论是概念还是它里面用JAVASCRIPT的能力.并不是说现在的程序员用了ASP.NET来写程序就可以说自己高档了 <%'==========================================================================
'文件称号：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,1,1
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 = 1
.LockType = 1
.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 = 1
.LockType = 1
.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 = 1
.LockType = 1
.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,1,1
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 = 1
.LockType = 1
.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
%>ASP在国内异常流行，因为国内大多使用的是盗版的Windows和盗版的SQLServer，而ASP＋COM＋SQLServer实际上也是一种不错的搭配，其性能也不输于PHP+MYSQL，特别是Windows系统和SQLServer都有图形界面，比APACHE和MYSQL易于维护，因此对于不重视知识产权的国家来说也是一种不错的选择。 ASP也是这几种脚本语言中最简单易学的开发语言。但ASP也是这几种语言中唯一的一个不能很好支持跨平台的语言。 因为ASP脚本语言非常简单，因此其代码也简单易懂，结合HTML代码，可快速地完成网站的应用程序。 Session:这个存储跟客户端会话过程的数据，默认20分钟失效 运用经典的例子。并且自己可以用他来实现一些简单的系统。如果可以对他进行进一步的修改，找出你觉得可以提高性能的地方，加上自己的设计，那就更上一个层次了，也就会真正地感到有所收获。 还有如何才能在最短的时间内学完?我每天可以有效学习2小时，双休日4小时。 ASP.Net摆脱了以前ASP使用脚本语言来编程的缺点，理论上可以使用任何编程语言包括C++,VB,JS等等，当然，最合适的编程语言还是MS为.NetFrmaework专门推出的C(读csharp)，它可以看作是VC和Java的混合体吧。 封装性使得代码逻辑清晰，易于管理，并且应用到ASP.Net上就可以使业务逻辑和Html页面分离，这样无论页面原型如何改变，业务逻辑代码都不必做任何改动；继承性和多态性使得代码的可重用性大大提高。 弱类型造成潜在的出错可能：尽管弱数据类型的编程语言使用起来回方便一些，但相对于它所造成的出错几率是远远得不偿失的。 Session:这个存储跟客户端会话过程的数据，默认20分钟失效 Response:从字面上讲是“响应”，因此这个是服务端向客户端发送东西的，例如Response.Write 下面简单介绍一下我学习ASP的方法,希望对想学习ASP的朋友有所帮助... ASP也是这几种脚本语言中最简单易学的开发语言。但ASP也是这几种语言中唯一的一个不能很好支持跨平台的语言。 因为ASP脚本语言非常简单，因此其代码也简单易懂，结合HTML代码，可快速地完成网站的应用程序。 以上是语言本身的弱点，在功能方面ASP同样存在问题，第一是功能太弱，一些底层操作只能通过组件来完成，在这点上是远远比不上PHP/JSP，其次就是缺乏完善的纠错/调试功能，这点上ASP/PHP/JSP差不多。 没有坚实的理论做基础，那么我们连踏入社会第一步的资本都没有，特别对于计算机专业的学生学好专业知识是置关重要的。在这里我侧重讲一下如何学习ASP，从平时的学习过程中。 兴趣爱好，那么你无须学编程，申请一个域名和空间，在网上下载一些免费开源的CMS系统，你不用改代码，只须熟悉它们的后台操作，像office一样简单方便，很快就能建一个站点，很多站长都是这样做的 我就感觉到ASP和一些常用的数据库编程以及软件工程方面的思想是非常重要的。我现在也在尝试自己做网页，这其中就用到了ASP，我想它的作用是可想而知的。 我就感觉到ASP和一些常用的数据库编程以及软件工程方面的思想是非常重要的。我现在也在尝试自己做网页，这其中就用到了ASP，我想它的作用是可想而知的。 ASP的语言不仅仅只是命令格式差不多，而是包含在<%%>之内的命令完全就是VB语法。虽然ASP也是做为单独的一个技术来提出的，但他就是完全继承了VB所有的功能。 多看多学多思。多看一些关于ASP的书籍，一方面可以扩展知识面一方面可以鉴借别人是如何掌握、运用ASP的;多学善于关注别人，向同学老师多多学习，不论知识的大小;多思则是要将学到的知识灵活运用。 用户端的浏览器不需要提供任何别的支持，这样大提高了用户与服务器之间的交互的速度。
页:
[1]