高端网站建设-万能数据库连接程序

下面这部分程序可说是万能的数据库连接程序几乎可以连接所有的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 “文件名”就可以调用里面的子程序了。 

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

高端网站建设价格套餐：

500元成品模板网站套餐1000元基础型网站套餐1800元标准定制设计套餐2800元精美定制设计套餐3800-8000元商务型套餐行业门户型套餐其它定制套餐 文章由重庆一佰互联高端网站建设http://www.rzxsoft.cn编辑整理，转载请注明出处