不通过数据源完全控制MDB数据库
2005-04-07 16:47
453 查看
<%' BEGIN USER CONSTANTS' To just use a DSN, the format is shown on the next line:'Const DSN_NAME = "DSN=ASP101email"' Two other samples I used it with. Left in as syntax examples for DSN-less connections'Const DSN_NAME = "DBQ=C:/InetPub/wwwroot/asp101/samples/database.mdb;Driver={Microsoft Access Driver (*.mdb)};DriverId=25"'Const DSN_NAME = "DBQ=C:/InetPub/database/donations.mdb;Driver={Microsoft Access Driver (*.mdb)};DriverId=25"
Dim DSN_NAMEDSN_NAME = "DBQ=" & Server.MapPath("db_dsn.mdb") & ";Driver={Microsoft Access Driver (*.mdb)};DriverId=25;"Const DSN_USER = "username"Const DSN_PASS = "password"' Ok, I know these are poorly named constants, so sue me!' This script can be used without actually setting up a DSN, so' DSN_NAME as well as the other two constants should really be named' something more generic like CONNECTION_STRING, CONNECTION_USER, and' CONNECTION_PASS, but I did it this way without really thinking about' it and I'm too lazy to change it now. If it bothers you, you do it!' END USER CONSTANTS
' BEGIN SUBS & FUNCTIONS SECTIONSub OpenConnectionSet objDC = Server.CreateObject("ADODB.Connection")objDC.ConnectionTimeout = 15objDC.CommandTimeout = 30objDC.Open DSN_NAME, DSN_USER, DSN_PASSEnd Sub
Sub OpenRecordset(sType)Dim sSqlString ' as String - building area for SQL queryDim sCritOperator ' as String - basically "=" or "LIKE"Dim sCritDelimiter ' as String - parameter delimiter "", "'", or "#"
Set objRS = Server.CreateObject("ADODB.Recordset")Select Case sTypeCase "ListTables" ' Open RS of the Tables in the DBSet objRS = objDC.OpenSchema(adSchemaTables)Case "ViewTable" ' Open the Selected TableSet objRS = Server.CreateObject("ADODB.Recordset")objRS.Open "[" & sTableName & "]", objDC, adOpenForwardOnly, adLockReadOnlyCase "DrillDown" ' Open the Recordset built by the selected optionsSet objRS = Server.CreateObject("ADODB.Recordset")
' Build Our SQL StatementsSqlString = "SELECT * FROM [" & sTableName & "]"
' If we're limiting records returned - insert the WHERE Clause into the SQLIf sCritField <> "" Then' Figure out if we're dealinh with Numeric, Date, or String ValuesSelect Case iCritDataTypeCase adSmallInt, adInteger, adSingle, adDouble, adDecimal, adTinyInt, adUnsignedTinyInt, adUnsignedSmallInt, adUnsignedInt, adBigInt, adUnsignedBigInt, adBinary, adNumeric, adVarBinary, adLongVarBinary, adCurrency, adBooleansCritOperator = "="sCritDelimiter = ""Case adDate, adDBDate, adDBTime, adDBTimeStampsCritOperator = "="sCritDelimiter = "#"Case adBSTR, adChar, adWChar, adVarChar, adLongVarChar, adVarWChar, adLongVarWCharsCritOperator = "LIKE"sCritDelimiter = "'"End SelectsSqlString = sSqlString & " WHERE [" & sCritField & "] " & sCritOperator & " " & sCritDelimiter & sCritValue & sCritDelimiterEnd If
' If we're sorting - insert the ORDER BY clauseIf sSortOrder <> "none" ThensSqlString = sSqlString & " ORDER BY [" & sSortField & "] " & sSortOrderEnd If
sSqlString = sSqlString & ";"
' Open the actual Recordset using a Forward Only Cursor in Read Only ModeobjRS.Open sSqlString, objDC, adOpenForwardOnly, adLockReadOnlyEnd SelectEnd Sub
Sub CloseRecordsetobjRS.CloseSet objRS = NothingEnd Sub
Sub CloseConnectionobjDC.CloseSet objDC = NothingEnd Sub
Sub WriteTitle(sTitle)Response.Write "<H2>" & sTitle & "</H2>" & vbCrLfEnd Sub
Sub WriteTableHeaderResponse.Write "<TABLE BORDER=1>" & vbCrLfEnd Sub
Sub WriteTableRowOpenResponse.Write "<TR>" & vbCrLfEnd Sub
Sub WriteTableCell(bCellIsTitle, sContents)Response.Write vbTab & "<TD>"If bCellIsTitle Then Response.Write "<B>"Response.Write sContentsIf bCellIsTitle Then Response.Write "</B>"Response.Write "</TD>" & vbCrLfEnd Sub
Sub WriteTableRowCloseResponse.Write "</TR>" & vbCrLfEnd Sub
Sub WriteTableFooterResponse.Write "</TABLE>" & vbCrLfEnd Sub' END SUBS & FUNCTIONS SECTION' BEGIN RUNTIME CODE' Before I start with the run-time code, let me clear up a few things.' I've tried (and succeeded I think!) to keep all the actual HTML' formatting contained within Subs. Hence things should be relatively' consistent as well as being easy to change if you say want a larger' border or perhaps a table background color or whatever...' This, along with my attempts to try and keep my sanity, have resulted' in a rather large proportion of Sub/Function Calls to actual code.' Since I'm sure this is probably confusing to many newcomers to ASP' and/or VB, I've attempted to preface each call with the optional' Call command. Also any SUB or FUNCTION whose name starts with the' word "Write" is basically just an encapsulation of some variation of' a Response.Write command, while the remainder of the name represents' whatever it happens to write.' IE. WriteTableRowClose writes the tags used to end (or close) a table row' The actual HTML is (as usual) pretty vanilla flavored. If you want' rocky-road or mint ting-a-ling (a marvelous piece of ice cream' craftsmanship I might add), you'll need to edit the Write functions.' Just be aware of the fact that any change to a SUB will affect ALL' uses of it, so check the code before you try and make a change to' just one cell and end up changing them all!' Okay enough of my rambling......Onwards to the Code!!!
Dim objDC, objRS ' DataConnection and RecordSetDim I ' As Integer - Standard Looping VarDim strTemp ' As String - Temporary area for building long strings
Dim sAction ' As String - Action String to choose what to doDim sTableName ' As String - ...so we know what to do it toDim sSortField ' As String - Field to sort byDim sSortOrder ' As String - ...ASC or DESCDim sCritField ' As String - Field for DrillDownDim sCritValue ' As String - ...Value to compare toDim iCritDataType ' As Integer - so we know how to compare' Note to all you programmers out there!' IE4 broke this code when my QueryString was named parameter because' it was converting the ¶ to the Paragraph sign even though it was' in the middle of a word and there was no trailing ;. It works great' in Netscape. Here's another case where IE's efforts to make things' foolproof ruined the asp code!
' Get all the parameters we'll needsAction = Request.QueryString("action")If sAction = "" Then sAction = "ListTables"
sTableName = Request.QueryString("tablename")
sSortField = Request.QueryString("sf")Select Case LCase(Request.QueryString("so"))Case "asc"sSortOrder = "ASC"Case "desc"sSortOrder = "DESC"Case ElsesSortOrder = "none"End Select
sCritField = Request.QueryString("cf")If Len(sCritField) = 0 Then sCritField = ""sCritValue = Request.QueryString("cv")iCritDataType = Request.QueryString("cdt")If Len(iCritDataType) <> 0 And IsNumeric(iCritDataType) Then iCritDataType = CInt(iCritDataType)
' Start the actual DB work
' Code common to all choices.Call OpenConnectionCall OpenRecordset(sAction)
Select Case sActionCase "ShowDataConnectionProperties" ' Cool to look at but not really part of the sample!' Fake it out so we don't have problems closing the DBOpenRecordset("ListTables")' Get all the DataConn PropertiesFor I = 0 to objDC.Properties.Count - 1Response.Write I & " " & objDC.Properties(i).Name & ": " & objDC.Properties(I) & "<BR>" & vbCrLfNext 'ICase "ListTables"Call WriteTitle("Tables")
If Not objRS.EOF Then objRS.MoveFirstCall WriteTableHeader
Call WriteTableRowOpenCall WriteTableCell(True, "Table Name")Call WriteTableRowClose
Do While Not objRS.EOFIf objRS.Fields("TABLE_TYPE") = "TABLE" ThenCall WriteTableRowOpenCall WriteTableCell(False, "<A HREF=""./db_dsn.asp?action=ViewTable&tablename=" & Server.URLEncode(objRS.Fields("TABLE_NAME")) & """>" & objRS.Fields("TABLE_NAME") & "</A>")Call WriteTableRowCloseEnd IfobjRS.MoveNextLoopCall WriteTableFooterCase "ViewTable", "DrillDown" ' The same here but in the OpenRecordset SUB they're very different.Call WriteTitle(sTableName)
If Not objRS.EOF Then objRS.MoveFirstCall WriteTableHeader
Call WriteTableRowOpenFor I = 0 to objRS.Fields.Count - 1' Build heading - the "sort by" links' Was all on the line WriteTableCell line but I split it up for readability' Field name for the headingstrTemp = objRS.Fields(I).Name' Begin Anchor for the + SignstrTemp = strTemp & " (<A HREF=""./db_dsn.asp"' Set actionstrTemp = strTemp & "?action=DrillDown"' Set table name to current tablestrTemp = strTemp & "&tablename=" & Server.URLEncode(sTableName)' Set criteria field to whatever it currently isstrTemp = strTemp & "&cf=" & Server.URLEncode(sCritField)' Set criteria value to whatever it currently isstrTemp = strTemp & "&cv=" & Server.URLEncode(sCritValue)' Set criteria data type to this fields' data typestrTemp = strTemp & "&cdt=" & iCritDataType' Set sort field to this fieldstrTemp = strTemp & "&sf=" & Server.URLEncode(objRS.Fields(I).Name)' Set sort order to this ascending (hence the +)strTemp = strTemp & "&so=asc"">+</A>"' End Anchor for the + Sign
' Begin Anchor for the - Sign' Next 8 lines are basically the same as above except for the sort order (so)strTemp = strTemp & "/<A HREF=""./db_dsn.asp"strTemp = strTemp & "?action=DrillDown"strTemp = strTemp & "&tablename=" & Server.URLEncode(sTableName)strTemp = strTemp & "&cf=" & Server.URLEncode(sCritField)strTemp = strTemp & "&cv=" & Server.URLEncode(sCritValue)strTemp = strTemp & "&cdt=" & iCritDataTypestrTemp = strTemp & "&sf=" & Server.URLEncode(objRS.Fields(I).Name)strTemp = strTemp & "&so=desc"">-</A>)"' End Anchor for the - Sign
Call WriteTableCell(True, strTemp)Next 'ICall WriteTableRowClose
Do While Not objRS.EOFCall WriteTableRowOpenFor I = 0 to objRS.Fields.Count - 1If IsNull(objRS.Fields(I).Value) Or objRS.Fields(I).Value = "" Or VarType(objRS.Fields(I).Value)= vbNull ThenstrTemp = " "Else' These set the drill down values which get passed if you click on any valuestrTemp = "<A HREF=""./db_dsn.asp"strTemp = strTemp & "?action=DrillDown"strTemp = strTemp & "&tablename=" & Server.URLEncode(sTableName)strTemp = strTemp & "&cf=" & Server.URLEncode(objRS.Fields(I).Name)strTemp = strTemp & "&cv=" & Server.URLEncode(objRS.Fields(I).Value)strTemp = strTemp & "&cdt=" & objRS.Fields(I).TypestrTemp = strTemp & "&sf=" & Server.URLEncode(sSortField)strTemp = strTemp & "&so=" & sSortOrder & """>"strTemp = strTemp & objRS.Fields(I).ValuestrTemp = strTemp & "</A>"End IfCall WriteTableCell(False, strTemp)Next 'ICall WriteTableRowCloseobjRS.MoveNextLoopCall WriteTableFooterEnd Select
' Close Data Access Objects and free DB variablesCall CloseRecordsetCall CloseConnection' END RUNTIME CODE%>
Dim DSN_NAMEDSN_NAME = "DBQ=" & Server.MapPath("db_dsn.mdb") & ";Driver={Microsoft Access Driver (*.mdb)};DriverId=25;"Const DSN_USER = "username"Const DSN_PASS = "password"' Ok, I know these are poorly named constants, so sue me!' This script can be used without actually setting up a DSN, so' DSN_NAME as well as the other two constants should really be named' something more generic like CONNECTION_STRING, CONNECTION_USER, and' CONNECTION_PASS, but I did it this way without really thinking about' it and I'm too lazy to change it now. If it bothers you, you do it!' END USER CONSTANTS
' BEGIN SUBS & FUNCTIONS SECTIONSub OpenConnectionSet objDC = Server.CreateObject("ADODB.Connection")objDC.ConnectionTimeout = 15objDC.CommandTimeout = 30objDC.Open DSN_NAME, DSN_USER, DSN_PASSEnd Sub
Sub OpenRecordset(sType)Dim sSqlString ' as String - building area for SQL queryDim sCritOperator ' as String - basically "=" or "LIKE"Dim sCritDelimiter ' as String - parameter delimiter "", "'", or "#"
Set objRS = Server.CreateObject("ADODB.Recordset")Select Case sTypeCase "ListTables" ' Open RS of the Tables in the DBSet objRS = objDC.OpenSchema(adSchemaTables)Case "ViewTable" ' Open the Selected TableSet objRS = Server.CreateObject("ADODB.Recordset")objRS.Open "[" & sTableName & "]", objDC, adOpenForwardOnly, adLockReadOnlyCase "DrillDown" ' Open the Recordset built by the selected optionsSet objRS = Server.CreateObject("ADODB.Recordset")
' Build Our SQL StatementsSqlString = "SELECT * FROM [" & sTableName & "]"
' If we're limiting records returned - insert the WHERE Clause into the SQLIf sCritField <> "" Then' Figure out if we're dealinh with Numeric, Date, or String ValuesSelect Case iCritDataTypeCase adSmallInt, adInteger, adSingle, adDouble, adDecimal, adTinyInt, adUnsignedTinyInt, adUnsignedSmallInt, adUnsignedInt, adBigInt, adUnsignedBigInt, adBinary, adNumeric, adVarBinary, adLongVarBinary, adCurrency, adBooleansCritOperator = "="sCritDelimiter = ""Case adDate, adDBDate, adDBTime, adDBTimeStampsCritOperator = "="sCritDelimiter = "#"Case adBSTR, adChar, adWChar, adVarChar, adLongVarChar, adVarWChar, adLongVarWCharsCritOperator = "LIKE"sCritDelimiter = "'"End SelectsSqlString = sSqlString & " WHERE [" & sCritField & "] " & sCritOperator & " " & sCritDelimiter & sCritValue & sCritDelimiterEnd If
' If we're sorting - insert the ORDER BY clauseIf sSortOrder <> "none" ThensSqlString = sSqlString & " ORDER BY [" & sSortField & "] " & sSortOrderEnd If
sSqlString = sSqlString & ";"
' Open the actual Recordset using a Forward Only Cursor in Read Only ModeobjRS.Open sSqlString, objDC, adOpenForwardOnly, adLockReadOnlyEnd SelectEnd Sub
Sub CloseRecordsetobjRS.CloseSet objRS = NothingEnd Sub
Sub CloseConnectionobjDC.CloseSet objDC = NothingEnd Sub
Sub WriteTitle(sTitle)Response.Write "<H2>" & sTitle & "</H2>" & vbCrLfEnd Sub
Sub WriteTableHeaderResponse.Write "<TABLE BORDER=1>" & vbCrLfEnd Sub
Sub WriteTableRowOpenResponse.Write "<TR>" & vbCrLfEnd Sub
Sub WriteTableCell(bCellIsTitle, sContents)Response.Write vbTab & "<TD>"If bCellIsTitle Then Response.Write "<B>"Response.Write sContentsIf bCellIsTitle Then Response.Write "</B>"Response.Write "</TD>" & vbCrLfEnd Sub
Sub WriteTableRowCloseResponse.Write "</TR>" & vbCrLfEnd Sub
Sub WriteTableFooterResponse.Write "</TABLE>" & vbCrLfEnd Sub' END SUBS & FUNCTIONS SECTION' BEGIN RUNTIME CODE' Before I start with the run-time code, let me clear up a few things.' I've tried (and succeeded I think!) to keep all the actual HTML' formatting contained within Subs. Hence things should be relatively' consistent as well as being easy to change if you say want a larger' border or perhaps a table background color or whatever...' This, along with my attempts to try and keep my sanity, have resulted' in a rather large proportion of Sub/Function Calls to actual code.' Since I'm sure this is probably confusing to many newcomers to ASP' and/or VB, I've attempted to preface each call with the optional' Call command. Also any SUB or FUNCTION whose name starts with the' word "Write" is basically just an encapsulation of some variation of' a Response.Write command, while the remainder of the name represents' whatever it happens to write.' IE. WriteTableRowClose writes the tags used to end (or close) a table row' The actual HTML is (as usual) pretty vanilla flavored. If you want' rocky-road or mint ting-a-ling (a marvelous piece of ice cream' craftsmanship I might add), you'll need to edit the Write functions.' Just be aware of the fact that any change to a SUB will affect ALL' uses of it, so check the code before you try and make a change to' just one cell and end up changing them all!' Okay enough of my rambling......Onwards to the Code!!!
Dim objDC, objRS ' DataConnection and RecordSetDim I ' As Integer - Standard Looping VarDim strTemp ' As String - Temporary area for building long strings
Dim sAction ' As String - Action String to choose what to doDim sTableName ' As String - ...so we know what to do it toDim sSortField ' As String - Field to sort byDim sSortOrder ' As String - ...ASC or DESCDim sCritField ' As String - Field for DrillDownDim sCritValue ' As String - ...Value to compare toDim iCritDataType ' As Integer - so we know how to compare' Note to all you programmers out there!' IE4 broke this code when my QueryString was named parameter because' it was converting the ¶ to the Paragraph sign even though it was' in the middle of a word and there was no trailing ;. It works great' in Netscape. Here's another case where IE's efforts to make things' foolproof ruined the asp code!
' Get all the parameters we'll needsAction = Request.QueryString("action")If sAction = "" Then sAction = "ListTables"
sTableName = Request.QueryString("tablename")
sSortField = Request.QueryString("sf")Select Case LCase(Request.QueryString("so"))Case "asc"sSortOrder = "ASC"Case "desc"sSortOrder = "DESC"Case ElsesSortOrder = "none"End Select
sCritField = Request.QueryString("cf")If Len(sCritField) = 0 Then sCritField = ""sCritValue = Request.QueryString("cv")iCritDataType = Request.QueryString("cdt")If Len(iCritDataType) <> 0 And IsNumeric(iCritDataType) Then iCritDataType = CInt(iCritDataType)
' Start the actual DB work
' Code common to all choices.Call OpenConnectionCall OpenRecordset(sAction)
Select Case sActionCase "ShowDataConnectionProperties" ' Cool to look at but not really part of the sample!' Fake it out so we don't have problems closing the DBOpenRecordset("ListTables")' Get all the DataConn PropertiesFor I = 0 to objDC.Properties.Count - 1Response.Write I & " " & objDC.Properties(i).Name & ": " & objDC.Properties(I) & "<BR>" & vbCrLfNext 'ICase "ListTables"Call WriteTitle("Tables")
If Not objRS.EOF Then objRS.MoveFirstCall WriteTableHeader
Call WriteTableRowOpenCall WriteTableCell(True, "Table Name")Call WriteTableRowClose
Do While Not objRS.EOFIf objRS.Fields("TABLE_TYPE") = "TABLE" ThenCall WriteTableRowOpenCall WriteTableCell(False, "<A HREF=""./db_dsn.asp?action=ViewTable&tablename=" & Server.URLEncode(objRS.Fields("TABLE_NAME")) & """>" & objRS.Fields("TABLE_NAME") & "</A>")Call WriteTableRowCloseEnd IfobjRS.MoveNextLoopCall WriteTableFooterCase "ViewTable", "DrillDown" ' The same here but in the OpenRecordset SUB they're very different.Call WriteTitle(sTableName)
If Not objRS.EOF Then objRS.MoveFirstCall WriteTableHeader
Call WriteTableRowOpenFor I = 0 to objRS.Fields.Count - 1' Build heading - the "sort by" links' Was all on the line WriteTableCell line but I split it up for readability' Field name for the headingstrTemp = objRS.Fields(I).Name' Begin Anchor for the + SignstrTemp = strTemp & " (<A HREF=""./db_dsn.asp"' Set actionstrTemp = strTemp & "?action=DrillDown"' Set table name to current tablestrTemp = strTemp & "&tablename=" & Server.URLEncode(sTableName)' Set criteria field to whatever it currently isstrTemp = strTemp & "&cf=" & Server.URLEncode(sCritField)' Set criteria value to whatever it currently isstrTemp = strTemp & "&cv=" & Server.URLEncode(sCritValue)' Set criteria data type to this fields' data typestrTemp = strTemp & "&cdt=" & iCritDataType' Set sort field to this fieldstrTemp = strTemp & "&sf=" & Server.URLEncode(objRS.Fields(I).Name)' Set sort order to this ascending (hence the +)strTemp = strTemp & "&so=asc"">+</A>"' End Anchor for the + Sign
' Begin Anchor for the - Sign' Next 8 lines are basically the same as above except for the sort order (so)strTemp = strTemp & "/<A HREF=""./db_dsn.asp"strTemp = strTemp & "?action=DrillDown"strTemp = strTemp & "&tablename=" & Server.URLEncode(sTableName)strTemp = strTemp & "&cf=" & Server.URLEncode(sCritField)strTemp = strTemp & "&cv=" & Server.URLEncode(sCritValue)strTemp = strTemp & "&cdt=" & iCritDataTypestrTemp = strTemp & "&sf=" & Server.URLEncode(objRS.Fields(I).Name)strTemp = strTemp & "&so=desc"">-</A>)"' End Anchor for the - Sign
Call WriteTableCell(True, strTemp)Next 'ICall WriteTableRowClose
Do While Not objRS.EOFCall WriteTableRowOpenFor I = 0 to objRS.Fields.Count - 1If IsNull(objRS.Fields(I).Value) Or objRS.Fields(I).Value = "" Or VarType(objRS.Fields(I).Value)= vbNull ThenstrTemp = " "Else' These set the drill down values which get passed if you click on any valuestrTemp = "<A HREF=""./db_dsn.asp"strTemp = strTemp & "?action=DrillDown"strTemp = strTemp & "&tablename=" & Server.URLEncode(sTableName)strTemp = strTemp & "&cf=" & Server.URLEncode(objRS.Fields(I).Name)strTemp = strTemp & "&cv=" & Server.URLEncode(objRS.Fields(I).Value)strTemp = strTemp & "&cdt=" & objRS.Fields(I).TypestrTemp = strTemp & "&sf=" & Server.URLEncode(sSortField)strTemp = strTemp & "&so=" & sSortOrder & """>"strTemp = strTemp & objRS.Fields(I).ValuestrTemp = strTemp & "</A>"End IfCall WriteTableCell(False, strTemp)Next 'ICall WriteTableRowCloseobjRS.MoveNextLoopCall WriteTableFooterEnd Select
' Close Data Access Objects and free DB variablesCall CloseRecordsetCall CloseConnection' END RUNTIME CODE%>
相关文章推荐
- 不通过数据源完全控制MDB数据库
- spring控制数据库读写分离(多数据源动态切换)
- 能完全通过声音控制的,除了你家楼道里的灯泡,原来还有这么多产品
- ORACLE只有表空间文件通过重建控制文件进行不完全恢复
- 通过Spring Boot配置动态数据源访问多个数据库的实现代码
- 数据库并发控制完全讲解
- 敏捷开发之数据库版本控制完全指南
- 数据库版本控制完全指南
- Tomcat通过数据源访问数据库
- 通过中间代理层来统一管理所有的数据源,后端数据库集群对前端应用程序透明;
- SpringMVC通过拦截URL控制Mybatis切换数据源
- 通过 mysqldump 完全恢复 MySQL 5.7 数据库
- SQL Server 2005 中设置某个用户对某一个数据库有完全控制的权限
- 通过spring抽象路由数据源+MyBatis拦截器实现数据库自动读写分离
- Spring:完全通过程序控制Spring事务
- 关于java通过proxool连接数据库多数据源的问题
- 以Oracle为例说明如何通过ODBC将数据库中的指定表导出到MDB数据库。
- 通过Visual Studio 2005 中的数据源选择对话框实现数据库连接配置(用户使用)
- 通过使用resetlog恢复控制文件恢复数据库
- ssm中使用两个数据库,通过注解方式切换数据源