 |
|
|
 首页 |
名片设计 CorelDRAW Illustrator AuotoCAD Painter 其他软件 Photoshop Fireworks Flash |
|
<% \\\'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:InetPubwwwrootasp101samplesdatabase.mdb;Driver={Microsoft Access Driver (*.mdb)};DriverId=25" \\\'Const DSN_NAME = "DBQ=C:InetPubdatabasedonations.mdb;Driver={Microsoft Access Driver (*.mdb)};DriverId=25" Dim DSN_NAME DSN_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 SECTION Sub OpenConnection Set objDC = Server.CreateObject("ADODB.Connection") objDC.ConnectionTimeout = 15 objDC.CommandTimeout = 30 objDC.Open DSN_NAME, DSN_USER, DSN_PASS End Sub Sub OpenRecordset(sType) Dim sSqlString \\\'as String - building area for SQL query Dim sCritOperator \\\'as String - basically "=" or "LIKE" Dim sCritDelimiter \\\'as String - parameter delimiter "", "\\\'", or "#" Set objRS = Server.CreateObject("ADODB.Recordset") Select Case sType Case "ListTables" \\\'Open RS of the Tables in the DB Set objRS = objDC.OpenSchema(adSchemaTables) Case "ViewTable" \\\'Open the Selected Table Set objRS = Server.CreateObject("ADODB.Recordset") objRS.Open "[" & sTableName & "]", objDC, adOpenForwardOnly, adLockReadOnly Case "DrillDown" \\\'Open the Recordset built by the selected options Set objRS = Server.CreateObject("ADODB.Recordset") \\\'Build Our SQL Statement sSqlString = "SELECT * FROM [" & sTableName & "]" \\\'If we\\\'re limiting records returned - insert the WHERE Clause into the SQL If sCritField <> "" Then \\\'Figure out if we\\\'re dealinh with Numeric, Date, or String Values Select Case iCritDataType Case adSmallInt, adInteger, adSingle, adDouble, adDecimal, adTinyInt, adUnsignedTinyInt, adUnsignedSmallInt, adUnsignedInt, adBigInt, adUnsignedBigInt, adBinary, adNumeric, adVarBinary, adLongVarBinary, adCurrency, adBoolean sCritOperator = "=" sCritDelimiter = "" Case adDate, adDBDate, adDBTime, adDBTimeStamp sCritOperator = "=" sCritDelimiter = "#" Case adBSTR, adChar, adWChar, adVarChar, adLongVarChar, adVarWChar, adLongVarWChar sCritOperator = "LIKE" sCritDelimiter = "\\\'" End Select sSqlString = sSqlString & " WHERE [" & sCritField & "] " & sCritOperator & " " & sCritDelimiter & sCritValue & sCritDelimiter End If \\\'If we\\\'re sorting - insert the ORDER BY clause If sSortOrder <> "none" Then sSqlString = sSqlString & " ORDER BY [" & sSortField & "] " & sSortOrder End If sSqlString = sSqlString & ";" \\\'Open the actual Recordset using a Forward Only Cursor in Read Only Mode objRS.Open sSqlString, objDC, adOpenForwardOnly, adLockReadOnly End Select End Sub Sub CloseRecordset objRS.Close Set objRS = Nothing End Sub Sub CloseConnection objDC.Close Set objDC = Nothing End Sub Sub WriteTitle(sTitle) Response.Write "<H2>" & sTitle & "</H2>" & vbCrLf End Sub Sub WriteTableHeader Response.Write "<TABLE BORDER=1>" & vbCrLf End Sub Sub WriteTableRowOpen Response.Write "<TR>" & vbCrLf End Sub Sub WriteTableCell(bCellIsTitle, sContents) Response.Write vbTab & "<TD>" If bCellIsTitle Then Response.Write "<B>" Response.Write sContents If bCellIsTitle Then Response.Write "</B>" Response.Write "</TD>" & vbCrLf End Sub Sub WriteTableRowClose Response.Write "</TR>" & vbCrLf End Sub Sub WriteTableFooter Response.Write "</TABLE>" & vbCrLf End 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 RecordSet Dim I \\\'As Integer - Standard Looping Var Dim strTemp \\\'As String - Temporary area for building long strings Dim sAction \\\'As String - Action String to choose what to do Dim sTableName \\\'As String - ...so we know what to do it to Dim sSortField \\\'As String - Field to sort by Dim sSortOrder \\\'As String - ...ASC or DESC Dim sCritField \\\'As String - Field for DrillDown Dim sCritValue \\\'As String - ...Value to compare to Dim 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 need sAction = 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 Else sSortOrder = "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 OpenConnection Call OpenRecordset(sAction) Select Case sAction Case "ShowDataConnectionProperties" \\\'Cool to look at but not really part of the sample! \\\'Fake it out so we don\\\'t have problems closing the DB OpenRecordset("ListTables") \\\'Get all the DataConn Properties For I = 0 to objDC.Properties.Count - 1 Response.Write I & " " & objDC.Properties(i).Name & ": " & objDC.Properties(I) & "<BR>" & vbCrLf Next \\\'I Case "ListTables" Call WriteTitle("Tables") If Not objRS.EOF Then objRS.MoveFirst Call WriteTableHeader Call WriteTableRowOpen Call WriteTableCell(True, "Table Name") Call WriteTableRowClose Do While Not objRS.EOF If objRS.Fields("TABLE_TYPE") = "TABLE" Then Call WriteTableRowOpen Call WriteTableCell(False, "<A HREF=""./db_dsn.asp?action=ViewTable&tablename=" & Server.URLEncode(objRS.Fields("TABLE_NAME")) & """>" & objRS.Fields("TABLE_NAME") & "</A>") Call WriteTableRowClose End If objRS.MoveNext Loop Call WriteTableFooter Case "ViewTable", "DrillDown" \\\'The same here but in the OpenRecordset SUB they\\\'re very different. Call WriteTitle(sTableName) If Not objRS.EOF Then objRS.MoveFirst Call WriteTableHeader Call WriteTableRowOpen For 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 heading strTemp = objRS.Fields(I).Name \\\'Begin Anchor for the + Sign strTemp = strTemp & " (<A HREF=""./db_dsn.asp" \\\'Set action strTemp = strTemp & "?action=DrillDown" \\\'Set table name to current table strTemp = strTemp & "&tablename=" & Server.URLEncode(sTableName) \\\'Set criteria field to whatever it currently is strTemp = strTemp & "&cf=" & Server.URLEncode(sCritField) \\\'Set criteria value to whatever it currently is strTemp = strTemp & "&cv=" & Server.URLEncode(sCritValue) \\\'Set criteria data type to this fields\\\'data type strTemp = strTemp & "&cdt=" & iCritDataType \\\'Set sort field to this field strTemp = 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=" & iCritDataType strTemp = strTemp & "&sf=" & Server.URLEncode(objRS.Fields(I).Name) strTemp = strTemp & "&so=desc"">-</A>)" \\\'End Anchor for the - Sign Call WriteTableCell(True, strTemp) Next \\\'I Call WriteTableRowClose Do While Not objRS.EOF Call WriteTableRowOpen For I = 0 to objRS.Fields.Count - 1 If IsNull(objRS.Fields(I).Value) Or objRS.Fields(I).Value = "" Or VarType(objRS.Fields(I).Value)= vbNull Then strTemp = " " Else \\\'These set the drill down values which get passed if you click on any value strTemp = "<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).Type strTemp = strTemp & "&sf=" & Server.URLEncode(sSortField) strTemp = strTemp & "&so=" & sSortOrder & """>" strTemp = strTemp & objRS.Fields(I).Value strTemp = strTemp & "</A>" End If Call WriteTableCell(False, strTemp) Next \\\'I Call WriteTableRowClose objRS.MoveNext Loop Call WriteTableFooter End Select \\\'Close Data Access Objects and free DB variables Call CloseRecordset Call CloseConnection \\\'END RUNTIME CODE %> 返回类别: 教程 上一教程: 一些ASP技巧和实用解决方式 下一教程: 使用函数自动生成N层目录 您可以阅读与"不通过数据源完全控制MDB数据库"相关的教程: · 在ASP中通过GETROWS实现数据库记录分页的一段代码 · 不用数据源打开数据库(DSNLESS CONNECTION) · ASP怎样实现通过传真机把传真直接保存进数据库 · 数据库远程控制的ASP实现 · 不用数据源打开数据库（DSNless connection) |
  |
| 快精灵印艺坊 版权所有 |
首页 会员中心在线印刷在线编辑付款方式索取样品设计指南连锁门店
|
||
