源码网,源码论坛,源码之家,商业源码,游戏源码下载,discuz插件,棋牌源码下载,精品源码论坛

 找回密码
 立即注册
查看: 448|回复: 17

[ASP编程] 万能数据库连接程序

[复制链接]

7万

主题

861

回帖

32万

积分

论坛元老

Rank: 8Rank: 8

积分
329525
发表于 2006-6-23 00:00:00 | 显示全部楼层 |阅读模式
简介: 连接各种类型数据库 及 对数据库操作的函数

下面这部分程序可说是万能的数据库连接程序几乎可以连接所有的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 “文件名”就可以调用里面的子程序了。
有什么问题可以一起探讨!!!
回复

使用道具 举报

0

主题

2万

回帖

0

积分

中级会员

Rank: 3Rank: 3

积分
0
发表于 2022-8-9 00:27:22 | 显示全部楼层
很不错的样子
回复 支持 反对

使用道具 举报

0

主题

2万

回帖

124

积分

注册会员

Rank: 2

积分
124
发表于 2023-1-17 23:03:56 | 显示全部楼层
好人好人好人好人
回复 支持 反对

使用道具 举报

0

主题

2万

回帖

0

积分

中级会员

Rank: 3Rank: 3

积分
0
发表于 2023-9-17 00:07:21 | 显示全部楼层
给爸爸爸爸爸爸爸爸爸爸八佰伴八佰伴
回复 支持 反对

使用道具 举报

2

主题

2万

回帖

499

积分

中级会员

Rank: 3Rank: 3

积分
499
发表于 2023-10-5 03:22:47 | 显示全部楼层
刷屏刷屏刷屏
回复 支持 反对

使用道具 举报

2

主题

2万

回帖

67

积分

注册会员

Rank: 2

积分
67
发表于 2023-11-11 23:44:03 | 显示全部楼层
问问问企鹅哇哇哇哇哇
回复 支持 反对

使用道具 举报

2

主题

1万

回帖

146

积分

注册会员

Rank: 2

积分
146
发表于 2024-3-28 04:10:43 | 显示全部楼层
还有什么好东西没
回复 支持 反对

使用道具 举报

2

主题

2万

回帖

99

积分

注册会员

Rank: 2

积分
99
发表于 2024-4-11 13:24:12 | 显示全部楼层
还不错啊
回复 支持 反对

使用道具 举报

9

主题

2万

回帖

420

积分

中级会员

Rank: 3Rank: 3

积分
420
发表于 2024-5-7 00:15:31 | 显示全部楼层
挺不错的东西
回复 支持 反对

使用道具 举报

1

主题

2万

回帖

55

积分

注册会员

Rank: 2

积分
55
发表于 2024-6-7 11:41:29 | 显示全部楼层
激动人心,无法言表!
回复 支持 反对

使用道具 举报

高级模式
B Color Image Link Quote Code Smilies

本版积分规则

手机版|小黑屋|网站地图|源码论坛 ( 海外版 )

GMT+8, 2024-11-22 16:31 , Processed in 0.198763 second(s), 26 queries .

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表