万能数据库连接程序

  简介: 连接各种类型数据库 及 对数据库操作的函数

  下面这部分程序可说是万能的数据库连接程序几乎可以连接所有的MS数据库,自己拿去研究吧(这个程序是“ASP网页制作教程”这本书里面的——一本好书):

  <%

  '---------------------------------------------------

  Function GetMdbConnection( FileName )

  Dim Provider, DBPath

  Provider = "Provider=Microsoft.Jet.OLEDB.4.0;"

  DBPath = "Data Source=" & Server.MapPath(FileName)

  Set GetMdbConnection = GetConnection( Provider & DBPath )

  End Function

  '---------------------------------------------------

  Function GetSecuredMdbConnection( FileName, Password )

  Dim Provider, DBPath

  Provider = "Provider=Microsoft.Jet.OLEDB.4.0;"

  DBPath = "Data Source=" & Server.MapPath(FileName)

  Set GetSecuredMdbConnection = GetConnection( Provider & DBPath & ";Jet OLEDB:Database Password=" & Password ) End Function

  '---------------------------------------------------

  Function GetDbcConnection( FileName )

  Dim Driver, SourceType, DBPath

  Driver = "Driver={Microsoft Visual FoxPro Driver};"

  SourceType = "SourceType=DBC;"

  DBPath = "SourceDB=" & Server.MapPath( FileName )

  Set GetDbcConnection = GetConnection( Driver & SourceType & DBPath )

  End Function

  '---------------------------------------------------

  Function GetDbfConnection( Directory )

  Dim Driver, SourceType, DBPath

  Driver = "Driver={Microsoft Visual FoxPro Driver};"

  SourceType = "SourceType=DBF;"

  DBPath = "SourceDB=" & Server.MapPath( Directory )

  Set GetDbfConnection = GetConnection( Driver & SourceType & DBPath )

  End Function

  '---------------------------------------------------

  Function GetExcelConnection( FileName )

  Dim Driver, DBPath

  Driver = "Driver={Microsoft Excel Driver (*.xls)};"

  DBPath = "DBQ=" & Server.MapPath( FileName )

  Set GetExcelConnection = GetConnection( Driver & "ReadOnly=0;" & DBPath ) End Function

  '---------------------------------------------------

  Function GetTextConnection( Directory )

  Dim Driver, DBPath

  Driver = "Driver={Microsoft Text Driver (*.txt; *.csv)};"

  DBPath = "DBQ=" & Server.MapPath( Directory )

  Set GetTextConnection = GetConnection( Driver & DBPath )

  End Function

  '---------------------------------------------------

  Function GetSQLServerConnection( Computer, UserID, Password, Db )

  Dim Params, conn

  Set GetSQLServerConnection = Nothing

  Params = "Provider=SQLOLEDB.1"

  Params = Params & ";Data Source=" & Computer

  Params = Params & ";User ID=" & UserID

  Params = Params & ";Password=" & Password

  Params = Params & ";Initial Catalog=" & Db

  Set conn = Server.CreateObject("ADODB.Connection")

  conn.Open Params

  Set GetSQLServerConnection = conn

  End Function

  '---------------------------------------------------

  Function GetMdbRecordset( FileName, Source )

  Set GetMdbRecordset = GetMdbRs( FileName, Source, 2, "" )

  End Function

  '---------------------------------------------------

  Function GetMdbStaticRecordset( FileName, Source )

  Set GetMdbStaticRecordset = GetMdbRs( FileName, Source, 3, "" )

  End Function

  '---------------------------------------------------

  Function GetSecuredMdbRecordset( FileName, Source, Password )

  Set GetSecuredMdbRecordset = GetMdbRs( FileName, Source, 2, Password ) End Function

  '---------------------------------------------------

  Function GetSecuredMdbStaticRecordset( FileName, Source, Password )

  Set GetSecuredMdbStaticRecordset = GetMdbRs( FileName, Source, 3, Password ) End Function

  '---------------------------------------------------

  Function GetDbfRecordset( Directory, SQL )

  Set GetDbfRecordset = GetOtherRs( "Dbf", Directory, SQL, 2 )

  End Function

  '---------------------------------------------------

  Function GetDbfStaticRecordset( Directory, SQL )

  Set GetDbfStaticRecordset = GetOtherRs( "Dbf", Directory, SQL, 3 )

  End Function

  '---------------------------------------------------

  Function GetDbcRecordset( FileName, SQL )

  Set GetDbcRecordset = GetOtherRs( "Dbc", FileName, SQL, 2 )

  End Function

  '---------------------------------------------------

  Function GetDbcStaticRecordset( FileName, SQL )

  Set GetDbcStaticRecordset = GetOtherRs( "Dbc", FileName, SQL, 3 )

  End Function

  '---------------------------------------------------

  Function GetExcelRecordset( FileName, SQL )

  Set GetExcelRecordset = GetOtherRs( "Excel", FileName, SQL, 2 )

  End Function

  '---------------------------------------------------

  Function GetExcelStaticRecordset( FileName, SQL )

  Set GetExcelStaticRecordset = GetOtherRs( "Excel", FileName, SQL, 3 )

  End Function

  '---------------------------------------------------

  Function GetTextRecordset( Directory, SQL )

  Set GetTextRecordset = GetOtherRs( "Text", Directory, SQL, 2 )

  End Function

  '---------------------------------------------------

  Function GetTextStaticRecordset( Directory, SQL )

  Set GetTextStaticRecordset = GetOtherRs( "Text", Directory, SQL, 3 )

  End Function

  '---------------------------------------------------

  Function GetSQLServerRecordset( conn, source )

  Dim rs

  Set rs = Server.CreateObject("ADODB.Recordset")

  rs.Open source, conn, 2, 2

  Set GetSQLServerRecordset = rs

  End Function

  '---------------------------------------------------

  Function GetSQLServerStaticRecordset( conn, source )

  Dim rs

  Set rs = Server.CreateObject("ADODB.Recordset")

  rs.Open source, conn, 3, 2

  Set GetSQLServerStaticRecordset = rs

  End Function

  '---------------------------------------------------

  Function GetConnection( Param )

  Dim conn

  On Error Resume Next

  Set GetConnection = Nothing

  Set conn = Server.CreateObject("ADODB.Connection")

  If Err.Number <> 0 Then Exit Function

  conn.Open Param

  If Err.Number <> 0 Then Exit Function

  Set GetConnection = conn

  End Function

  '---------------------------------------------------

  Function GetMdbRs( FileName, Source, Cursor, Password )

  Dim conn, rs

  On Error Resume Next

  Set GetMdbRs = Nothing

  If Len(Password) = 0 Then

  Set conn = GetMdbConnection( FileName )

  Else

  Set conn = GetSecuredMdbConnection( FileName, Password )

  End If

  If conn Is Nothing Then Exit Function

  Set rs = Server.CreateObject("ADODB.Recordset")

  If Err.Number <> 0 Then Exit Function

  rs.Open source, conn, Cursor, 2

  If Err.Number <> 0 Then Exit Function

  Set GetMdbRs = rs

  End Function

  '---------------------------------------------------

  Function GetOtherRs( DataType, Path, SQL, Cursor )

  Dim conn, rs

  On Error Resume Next

  Set GetOtherRs = Nothing

  Select Case DataType

  Case "Dbf"

  Set conn = GetDbfConnection( Path )

  Case "Dbc"

  Set conn = GetDbcConnection( Path )

  Case "Excel"

  Set conn = GetExcelConnection( Path )

  Case "Text"

  Set conn = GetTextConnection( Path )

  End Select

  If conn Is Nothing Then Exit Function

  Set rs = Server.CreateObject("ADODB.Recordset")

  If Err.Number <> 0 Then Exit Function

  rs.Open SQL, conn, Cursor, 2

  If Err.Number <> 0 Then Exit Function

  Set GetOtherRs = rs

  End Function

  '---------------------------------------------------

  Function GetSQLServerRs( Computer, UserID, Password, Db, source, Cursor )

  Dim conn, rs

  On Error Resume Next

  Set GetSQLServerRs = Nothing

  Set conn = GetSQLServerConnection( Computer, UserID, Password, Db )

  If conn Is Nothing Then Exit Function

  Set rs = Server.CreateObject("ADODB.Recordset")

  If Err.Number <> 0 Then Exit Function

  rs.Open source, conn, Cursor, 2

  If Err.Number <> 0 Then Exit Function

  Set GetSQLServerRs = rs

  End Function

  %>

  使用方法是——复制下来存成一个文件,然后用#Include “文件名”就可以调用里面的子程序了。

  有什么问题可以一起探讨!!!