仓酷云

 找回密码
 立即注册
搜索
热搜: 活动 交友 discuz
查看: 1709|回复: 19
打印 上一主题 下一主题

[学习教程] ASP教程之ASP通用数据库操作类源代码

[复制链接]
莫相离 该用户已被删除
跳转到指定楼层
楼主
发表于 2015-2-3 23:28:46 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有帐号?立即注册

x
国内有些大的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易于维护,因此对于不重视知识产权的国家来说也是一种不错的选择。
小女巫 该用户已被删除
沙发
发表于 2015-2-3 23:34:51 | 只看该作者
ASP也是这几种脚本语言中最简单易学的开发语言。但ASP也是这几种语言中唯一的一个不能很好支持跨平台的语言。  因为ASP脚本语言非常简单,因此其代码也简单易懂,结合HTML代码,可快速地完成网站的应用程序。
小妖女 该用户已被删除
板凳
发表于 2015-2-7 06:35:59 | 只看该作者
Session:这个存储跟客户端会话过程的数据,默认20分钟失效
谁可相欹 该用户已被删除
地板
发表于 2015-2-8 18:49:38 | 只看该作者
运用经典的例子。并且自己可以用他来实现一些简单的系统。如果可以对他进行进一步的修改,找出你觉得可以提高性能的地方,加上自己的设计,那就更上一个层次了,也就会真正地感到有所收获。
海妖 该用户已被删除
5#
发表于 2015-2-16 05:32:41 | 只看该作者
还有如何才能在最短的时间内学完?我每天可以有效学习2小时,双休日4小时。
愤怒的大鸟 该用户已被删除
6#
发表于 2015-3-4 16:38:29 | 只看该作者
ASP.Net摆脱了以前ASP使用脚本语言来编程的缺点,理论上可以使用任何编程语言包括C++,VB,JS等等,当然,最合适的编程语言还是MS为.NetFrmaework专门推出的C(读csharp),它可以看作是VC和Java的混合体吧。
灵魂腐蚀 该用户已被删除
7#
发表于 2015-3-11 20:27:04 | 只看该作者
封装性使得代码逻辑清晰,易于管理,并且应用到ASP.Net上就可以使业务逻辑和Html页面分离,这样无论页面原型如何改变,业务逻辑代码都不必做任何改动;继承性和多态性使得代码的可重用性大大提高。
8#
发表于 2015-3-15 03:10:12 | 只看该作者
弱类型造成潜在的出错可能:尽管弱数据类型的编程语言使用起来回方便一些,但相对于它所造成的出错几率是远远得不偿失的。
老尸 该用户已被删除
9#
发表于 2015-3-17 00:32:34 | 只看该作者
Session:这个存储跟客户端会话过程的数据,默认20分钟失效
爱飞 该用户已被删除
10#
发表于 2015-3-23 09:21:40 | 只看该作者
Response:从字面上讲是“响应”,因此这个是服务端向客户端发送东西的,例如Response.Write
金色的骷髅 该用户已被删除
11#
发表于 2015-3-26 13:44:30 | 只看该作者
下面简单介绍一下我学习ASP的方法,希望对想学习ASP的朋友有所帮助...
飘飘悠悠 该用户已被删除
12#
发表于 2015-4-4 13:12:53 | 只看该作者
ASP也是这几种脚本语言中最简单易学的开发语言。但ASP也是这几种语言中唯一的一个不能很好支持跨平台的语言。  因为ASP脚本语言非常简单,因此其代码也简单易懂,结合HTML代码,可快速地完成网站的应用程序。
若天明 该用户已被删除
13#
发表于 2015-4-7 17:48:54 | 只看该作者
以上是语言本身的弱点,在功能方面ASP同样存在问题,第一是功能太弱,一些底层操作只能通过组件来完成,在这点上是远远比不上PHP/JSP,其次就是缺乏完善的纠错/调试功能,这点上ASP/PHP/JSP差不多。
因胸联盟 该用户已被删除
14#
发表于 2015-4-10 20:05:46 | 只看该作者
没有坚实的理论做基础,那么我们连踏入社会第一步的资本都没有,特别对于计算机专业的学生学好专业知识是置关重要的。在这里我侧重讲一下如何学习ASP,从平时的学习过程中。
莫相离 该用户已被删除
15#
 楼主| 发表于 2015-4-11 19:09:56 | 只看该作者
兴趣爱好,那么你无须学编程,申请一个域名和空间,在网上下载一些免费开源的CMS系统,你不用改代码,只须熟悉它们的后台操作,像office一样简单方便,很快就能建一个站点,很多站长都是这样做的
冷月葬花魂 该用户已被删除
16#
发表于 2015-4-13 01:47:47 | 只看该作者
我就感觉到ASP和一些常用的数据库编程以及软件工程方面的思想是非常重要的。我现在也在尝试自己做网页,这其中就用到了ASP,我想它的作用是可想而知的。
蒙在股里 该用户已被删除
17#
发表于 2015-4-21 18:07:16 | 只看该作者
我就感觉到ASP和一些常用的数据库编程以及软件工程方面的思想是非常重要的。我现在也在尝试自己做网页,这其中就用到了ASP,我想它的作用是可想而知的。
再见西城 该用户已被删除
18#
发表于 2015-4-26 15:10:46 | 只看该作者
ASP的语言不仅仅只是命令格式差不多,而是包含在<%%>之内的命令完全就是VB语法。虽然ASP也是做为单独的一个技术来提出的,但他就是完全继承了VB所有的功能。
兰色精灵 该用户已被删除
19#
发表于 2015-4-26 15:24:48 | 只看该作者
多看多学多思。多看一些关于ASP的书籍,一方面可以扩展知识面一方面可以鉴借别人是如何掌握、运用ASP的;多学善于关注别人,向同学老师多多学习,不论知识的大小;多思则是要将学到的知识灵活运用。
乐观 该用户已被删除
20#
发表于 2015-5-9 12:17:02 | 只看该作者
用户端的浏览器不需要提供任何别的支持,这样大提高了用户与服务器之间的交互的速度。
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|Archiver|手机版|仓酷云 鄂ICP备14007578号-2

GMT+8, 2024-12-22 19:01

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表