无意中在公司的电脑里发现前人留下的一个db.fun的文件，打开一看原来是众多连接数据库的函数。也许用得着，收录一下。
<%
'---------------------------------------------------
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,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,3,"" )
End Function
'---------------------------------------------------
Function GetSecuredMdbRecordset( FileName,Password )
Set GetSecuredMdbRecordset = GetMdbRs( FileName,Password )
End Function
'---------------------------------------------------
Function GetSecuredMdbStaticRecordset( FileName,Password )
Set GetSecuredMdbStaticRecordset = GetMdbRs( FileName,Password )
End Function
'---------------------------------------------------
Function GetDbfRecordset( Directory,SQL )
Set GetDbfRecordset = GetOtherRs( "Dbf",Directory,SQL,2 )
End Function
'---------------------------------------------------
Function GetDbfStaticRecordset( Directory,SQL )
Set GetDbfStaticRecordset = GetOtherRs( "Dbf",3 )
End Function
'---------------------------------------------------
Function GetDbcRecordset( FileName,SQL )
Set GetDbcRecordset = GetOtherRs( "Dbc",FileName,2 )
End Function
'---------------------------------------------------
Function GetDbcStaticRecordset( FileName,SQL )
Set GetDbcStaticRecordset = GetOtherRs( "Dbc",3 )
End Function
'---------------------------------------------------
Function GetExcelRecordset( FileName,SQL )
Set GetExcelRecordset = GetOtherRs( "Excel",2 )
End Function
'---------------------------------------------------
Function GetExcelStaticRecordset( FileName,SQL )
Set GetExcelStaticRecordset = GetOtherRs( "Excel",3 )
End Function
'---------------------------------------------------
Function GetTextRecordset( Directory,SQL )
Set GetTextRecordset = GetOtherRs( "Text",2 )
End Function
'---------------------------------------------------
Function GetTextStaticRecordset( Directory,SQL )
Set GetTextStaticRecordset = GetOtherRs( "Text",3 )
End Function
'---------------------------------------------------
Function GetSQLServerRecordset( conn,source )
Dim rs
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open source,conn,2
Set GetSQLServerRecordset = rs
End Function
'---------------------------------------------------
Function GetSQLServerStaticRecordset( conn,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,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,2
If Err.Number <> 0 Then Exit Function
Set GetMdbRs = rs
End Function
'---------------------------------------------------
Function GetOtherRs( DataType,Path,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,2
If Err.Number <> 0 Then Exit Function
Set GetOtherRs = rs
End Function
'---------------------------------------------------
Function GetSQLServerRs( Computer,Db,source,rs
On Error Resume Next
Set GetSQLServerRs = Nothing
Set conn = GetSQLServerConnection( Computer,Db )
If conn Is Nothing Then Exit Function
Set rs = Server.CreateObject("ADODB.Recordset")
If Err.Number <> 0 Then Exit Function
rs.Open source,2
If Err.Number <> 0 Then Exit Function
Set GetSQLServerRs = rs
End Function
%>
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。