1
<%
2'==========================================================================
3'文件名称：clsDbCtrl.asp
4'功 能：数据库操作类
5'作 者：coldstone (coldstone[在]qq.com)
6'程序版本：v1.0.5
7'完成时间：2005.09.23
8'修改时间：2007.10.30
9'版权声明：可以在任意作品中使用本程序代码，但请保留此版权信息。
10' 如果你修改了程序中的代码并得到更好的应用，请发送一份给我，谢谢。
11'==========================================================================
12
13Dim a : a = CreatConn(0, "master", "localhost", "sa", "") 'MSSQL数据库
14'Dim a : a = CreatConn(1, "Data/%TestDB%.mdb", "", "", "") 'Access数据库
15'Dim a : a = CreatConn(1, "E:\MyWeb\Data\%TestDB%.mdb", "", "", "mdbpassword")
16Dim Conn
17'OpenConn() '在加载时就建立的默认连接对象Conn,默认使用数据库a
18Sub OpenConn : Set Conn = Oc(a) : End Sub
19Sub CloseConn : Co(Conn) : End Sub
20
21Function Oc(ByVal Connstr)
22On Error Resume Next
23Dim objConn
24Set objConn = Server.CreateObject("ADODB.Connection")
25objConn.Open Connstr
26If Err.number <> 0 Then
27 Response.Write("<div id=""DBError"">数据库服务器端连接错误，请与网站管理员联系。</div>")
28 'Response.Write("错误信息：" & Err.Description)
29 objConn.Close
30 Set objConn = Nothing
31 Response.End
32End If
33Set Oc = objConn
34End Function
35
36Sub Co(obj)
37On Error Resume Next
38Set obj = Nothing
39End Sub
40
41Function CreatConn(ByVal dbType, ByVal strDB, ByVal strServer, ByVal strUid, ByVal strPwd)
42Dim TempStr
43Select Case dbType
44 Case "0","MSSQL"
45 TempStr = "driver={sql server};server="&strServer&";uid="&strUid&";pwd="&strPwd&";database="&strDB
46 Case "1","ACCESS"
47 Dim tDb : If Instr(strDB,":")>0 Then : tDb = strDB : Else : tDb = Server.MapPath(strDB) : End If
48 TempStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&tDb&";Jet OLEDB:Database Password="&strPwd&";"
49 Case "3","MYSQL"
50 TempStr = "Driver={mySQL};Server="&strServer&";Port=3306;Option=131072;Stmt=; Database="&strDB&";Uid="&strUid&";Pwd="&strPwd&";"
51 Case "4","ORACLE"
52 TempStr = "Driver={Microsoft ODBC for Oracle};Server="&strServer&";Uid="&strUid&";Pwd="&strPwd&";"
53End Select
54CreatConn = TempStr
55End Function
56
57
58Class dbCtrl
59Private debug
60Private idbConn
61Private idbErr
62
63Private Sub Class_Initialize()
64 debug = true '调试模式是否开启
65 idbErr = "出现错误："
66 If IsObject(Conn) Then
67 Set idbConn = Conn
68 End If
69End Sub
70
71Private Sub Class_Terminate()
72 Set idbConn = Nothing
73 If debug And idbErr<>"出现错误：" Then Response.Write(idbErr)
74End Sub
75
76Public Property Let dbConn(pdbConn)
77 If IsObject(pdbConn) Then
78 Set idbConn = pdbConn
79 Else
80 Set idbConn = Conn
81 End If
82End Property
83
84Public Property Get dbErr()
85 dbErr = idbErr
86End Property
87
88Public Property Get Version
89 Version = "ASP Database Ctrl V1.0 By ColdStone"
90End Property
91
92Public Function AutoID(ByVal TableName)
93 On Error Resume Next
94 Dim m_No,Sql, m_FirTempNo
95 Set m_No=Server.CreateObject("adodb.recordset")
96 Sql="SELECT * FROM ["&TableName&"]"
97 m_No.Open Sql,idbConn,1,1
98 If m_No.EOF Then
99 AutoID=1
100 Else
101 Do While Not m_No.EOF
102 m_FirTempNo=m_No.Fields(0).Value
103 m_No.MoveNext
104 If m_No.EOF Then
105 AutoID=m_FirTempNo+1
106 End If
107 Loop
108 End If
109 If Err.number <> 0 Then
110 idbErr = idbErr & "无效的查询条件！<br />"
111 If debug Then idbErr = idbErr & "错误信息："& Err.Description
112 Response.End()
113 Exit Function
114 End If
115 m_No.close
116 Set m_No = Nothing
117End Function
118
119Public Function GetRecord(ByVal TableName,ByVal FieldsList,ByVal Condition,ByVal OrderField,ByVal ShowN)
120 On Error Resume Next
121 Dim rstRecordList
122 Set rstRecordList=Server.CreateObject("adodb.recordset")
123 With rstRecordList
124 .ActiveConnection = idbConn
125 .CursorType = 1
126 .LockType = 1
127 .Source = wGetRecord(TableName,FieldsList,Condition,OrderField,ShowN)
128 .Open
129 If Err.number <> 0 Then
130 idbErr = idbErr & "无效的查询条件！<br />"
131 If debug Then idbErr = idbErr & "错误信息："& Err.Description
132 .Close
133 Set rstRecordList = Nothing
134 Response.End()
135 Exit Function
136 End If
137 End With
138 Set GetRecord=rstRecordList
139End Function
140
141Public Function wGetRecord(ByVal TableName,ByVal FieldsList,ByVal Condition,ByVal OrderField,ByVal ShowN)
142 Dim strSelect
143 strSelect="select "
144 If ShowN > 0 Then
145 strSelect = strSelect & " top " & ShowN & " "
146 End If
147 If FieldsList<>"" Then
148 strSelect = strSelect & FieldsList
149 Else
150 strSelect = strSelect & " * "
151 End If
152 strSelect = strSelect & " from [" & TableName & "]"
153 If Condition <> "" Then
154 strSelect = strSelect & " where " & ValueToSql(TableName,Condition,1)
155 End If
156 If OrderField <> "" Then
157 strSelect = strSelect & " order by " & OrderField
158 End If
159 wGetRecord = strSelect
160End Function
161
162Public Function GetRecordBySQL(ByVal strSelect)
163 On Error Resume Next
164 Dim rstRecordList
165 Set rstRecordList=Server.CreateObject("adodb.recordset")
166 With rstRecordList
167 .ActiveConnection =idbConn
168 .CursorType = 1
169 .LockType = 1
170 .Source = strSelect
171 .Open
172 If Err.number <> 0 Then
173 idbErr = idbErr & "无效的查询条件！<br />"
174 If debug Then idbErr = idbErr & "错误信息："& Err.Description
175 .Close
176 Set rstRecordList = Nothing
177 Response.End()
178 Exit Function
179 End If
180 End With
181 Set GetRecordBySQL = rstRecordList
182End Function
183
184Public Function GetRecordDetail(ByVal TableName,ByVal Condition)
185 On Error Resume Next
186 Dim rstRecordDetail, strSelect
187 Set rstRecordDetail=Server.CreateObject("adodb.recordset")
188 With rstRecordDetail
189 .ActiveConnection =idbConn
190 strSelect = "select * from [" & TableName & "] where " & ValueToSql(TableName,Condition,1)
191 .CursorType = 1
192 .LockType = 1
193 .Source = strSelect
194 .Open
195 If Err.number <> 0 Then
196 idbErr = idbErr & "无效的查询条件！<br />"
197 If debug Then idbErr = idbErr & "错误信息："& Err.Description
198 .Close
199 Set rstRecordDetail = Nothing
200 Response.End()
201 Exit Function
202 End If
203 End With
204 Set GetRecordDetail=rstRecordDetail
205End Function
206
207Public Function AddRecord(ByVal TableName, ByVal ValueList)
208 On Error Resume Next
209 DoExecute(wAddRecord(TableName,ValueList))
210 If Err.number <> 0 Then
211 idbErr = idbErr & "写入数据库出错！<br />"
212 If debug Then idbErr = idbErr & "错误信息："& Err.Description
213 'DoExecute "ROLLBACK TRAN Tran_Insert" '如果存在添加事务（事务滚回）
214 AddRecord = 0
215 Exit Function
216 End If
217 AddRecord = AutoID(TableName)-1
218End Function
219
220Public Function wAddRecord(ByVal TableName, ByVal ValueList)
221 Dim TempSQL, TempFiled, TempValue
222 TempFiled = ValueToSql(TableName,ValueList,2)
223 TempValue = ValueToSql(TableName,ValueList,3)
224 TempSQL = "Insert Into [" & TableName & "] (" & TempFiled & ") Values (" & TempValue & ")"
225 wAddRecord = TempSQL
226End Function
227
228Public Function UpdateRecord(ByVal TableName,ByVal Condition,ByVal ValueList)
229 On Error Resume Next
230 DoExecute(wUpdateRecord(TableName,Condition,ValueList))
231 If Err.number <> 0 Then
232 idbErr = idbErr & "更新数据库出错！<br />"
233 If debug Then idbErr = idbErr & "错误信息："& Err.Description
234 'DoExecute "ROLLBACK TRAN Tran_Update" '如果存在添加事务（事务滚回）
235 UpdateRecord = 0
236 Exit Function
237 End If
238 UpdateRecord = 1
239End Function
240
241Public Function wUpdateRecord(ByVal TableName,ByVal Condition,ByVal ValueList)
242 Dim TmpSQL
243 TmpSQL = "Update ["&TableName&"] Set "
244 TmpSQL = TmpSQL & ValueToSql(TableName,ValueList,0)
245 TmpSQL = TmpSQL & " Where " & ValueToSql(TableName,Condition,1)
246 wUpdateRecord = TmpSQL
247End Function
248
249Public Function DeleteRecord(ByVal TableName,ByVal IDFieldName,ByVal IDValues)
250 On Error Resume Next
251 Dim Sql
252 Sql = "Delete From ["&TableName&"] Where ["&IDFieldName&"] In ("
253 If IsArray(IDValues) Then
254 Sql = Sql & "Select ["&IDFieldName&"] From ["&TableName&"] Where " & ValueToSql(TableName,IDValues,1)
255 Else
256 Sql = Sql & IDValues
257 End If
258 Sql = Sql & ")"
259 DoExecute(Sql)
260 If Err.number <> 0 Then
261 idbErr = idbErr & "删除数据出错！<br />"
262 If debug Then idbErr = idbErr & "错误信息："& Err.Description
263 'DoExecute "ROLLBACK TRAN Tran_Delete" '如果存在添加事务（事务滚回）
264 DeleteRecord = 0
265 Exit Function
266 End If
267 DeleteRecord = 1
268End Function
269
270Public Function wDeleteRecord(ByVal TableName,ByVal IDFieldName,ByVal IDValues)
271 On Error Resume Next
272 Dim Sql
273 Sql = "Delete From ["&TableName&"] Where ["&IDFieldName&"] In ("
274 If IsArray(IDValues) Then
275 Sql = Sql & "Select ["&IDFieldName&"] From ["&TableName&"] Where " & ValueToSql(TableName,IDValues,1)
276 Else
277 Sql = Sql & IDValues
278 End If
279 Sql = Sql & ")"
280 wDeleteRecord = Sql
281End Function
282
<%2
'==========================================================================3
'文件名称：clsDbCtrl.asp4
'功 能：数据库操作类5
'作 者：coldstone (coldstone[在]qq.com)6
'程序版本：v1.0.57
'完成时间：2005.09.238
'修改时间：2007.10.309
'版权声明：可以在任意作品中使用本程序代码，但请保留此版权信息。10
' 如果你修改了程序中的代码并得到更好的应用，请发送一份给我，谢谢。11
'==========================================================================12
13
Dim a : a = CreatConn(0, "master", "localhost", "sa", "") 'MSSQL数据库14
'Dim a : a = CreatConn(1, "Data/%TestDB%.mdb", "", "", "") 'Access数据库15
'Dim a : a = CreatConn(1, "E:\MyWeb\Data\%TestDB%.mdb", "", "", "mdbpassword")16
Dim Conn17
'OpenConn() '在加载时就建立的默认连接对象Conn,默认使用数据库a18
Sub OpenConn : Set Conn = Oc(a) : End Sub19
Sub CloseConn : Co(Conn) : End Sub20
21
Function Oc(ByVal Connstr)22
On Error Resume Next23
Dim objConn24
Set objConn = Server.CreateObject("ADODB.Connection")25
objConn.Open Connstr26
If Err.number <> 0 Then27
Response.Write("<div id=""DBError"">数据库服务器端连接错误，请与网站管理员联系。</div>")28
'Response.Write("错误信息：" & Err.Description)29
objConn.Close30
Set objConn = Nothing31
Response.End32
End If33
Set Oc = objConn34
End Function35
36
Sub Co(obj)37
On Error Resume Next38
Set obj = Nothing39
End Sub40
41
Function CreatConn(ByVal dbType, ByVal strDB, ByVal strServer, ByVal strUid, ByVal strPwd)42
Dim TempStr43
Select Case dbType44
Case "0","MSSQL"45
TempStr = "driver={sql server};server="&strServer&";uid="&strUid&";pwd="&strPwd&";database="&strDB46
Case "1","ACCESS"47
Dim tDb : If Instr(strDB,":")>0 Then : tDb = strDB : Else : tDb = Server.MapPath(strDB) : End If48
TempStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&tDb&";Jet OLEDB:Database Password="&strPwd&";"49
Case "3","MYSQL"50
TempStr = "Driver={mySQL};Server="&strServer&";Port=3306;Option=131072;Stmt=; Database="&strDB&";Uid="&strUid&";Pwd="&strPwd&";"51
Case "4","ORACLE"52
TempStr = "Driver={Microsoft ODBC for Oracle};Server="&strServer&";Uid="&strUid&";Pwd="&strPwd&";"53
End Select54
CreatConn = TempStr55
End Function56
57
58
Class dbCtrl59
Private debug60
Private idbConn61
Private idbErr62
63
Private Sub Class_Initialize()64
debug = true '调试模式是否开启65
idbErr = "出现错误："66
If IsObject(Conn) Then67
Set idbConn = Conn68
End If69
End Sub70
71
Private Sub Class_Terminate()72
Set idbConn = Nothing73
If debug And idbErr<>"出现错误：" Then Response.Write(idbErr)74
End Sub75
76
Public Property Let dbConn(pdbConn)77
If IsObject(pdbConn) Then78
Set idbConn = pdbConn79
Else80
Set idbConn = Conn81
End If82
End Property83
84
Public Property Get dbErr()85
dbErr = idbErr86
End Property87
88
Public Property Get Version89
Version = "ASP Database Ctrl V1.0 By ColdStone"90
End Property91
92
Public Function AutoID(ByVal TableName)93
On Error Resume Next94
Dim m_No,Sql, m_FirTempNo95
Set m_No=Server.CreateObject("adodb.recordset")96
Sql="SELECT * FROM ["&TableName&"]"97
m_No.Open Sql,idbConn,1,198
If m_No.EOF Then99
AutoID=1100
Else101
Do While Not m_No.EOF102
m_FirTempNo=m_No.Fields(0).Value 103
m_No.MoveNext104
If m_No.EOF Then 105
AutoID=m_FirTempNo+1106
End If107
Loop108
End If109
If Err.number <> 0 Then110
idbErr = idbErr & "无效的查询条件！<br />"111
If debug Then idbErr = idbErr & "错误信息："& Err.Description112
Response.End()113
Exit Function114
End If115
m_No.close116
Set m_No = Nothing117
End Function118
119
Public Function GetRecord(ByVal TableName,ByVal FieldsList,ByVal Condition,ByVal OrderField,ByVal ShowN)120
On Error Resume Next121
Dim rstRecordList122
Set rstRecordList=Server.CreateObject("adodb.recordset")123
With rstRecordList124
.ActiveConnection = idbConn125
.CursorType = 1126
.LockType = 1127
.Source = wGetRecord(TableName,FieldsList,Condition,OrderField,ShowN)128
.Open 129
If Err.number <> 0 Then130
idbErr = idbErr & "无效的查询条件！<br />"131
If debug Then idbErr = idbErr & "错误信息："& Err.Description132
.Close133
Set rstRecordList = Nothing134
Response.End()135
Exit Function136
End If 137
End With138
Set GetRecord=rstRecordList139
End Function140
141
Public Function wGetRecord(ByVal TableName,ByVal FieldsList,ByVal Condition,ByVal OrderField,ByVal ShowN)142
Dim strSelect143
strSelect="select "144
If ShowN > 0 Then145
strSelect = strSelect & " top " & ShowN & " "146
End If147
If FieldsList<>"" Then148
strSelect = strSelect & FieldsList149
Else150
strSelect = strSelect & " * "151
End If152
strSelect = strSelect & " from [" & TableName & "]"153
If Condition <> "" Then154
strSelect = strSelect & " where " & ValueToSql(TableName,Condition,1)155
End If156
If OrderField <> "" Then157
strSelect = strSelect & " order by " & OrderField158
End If159
wGetRecord = strSelect160
End Function161
162
Public Function GetRecordBySQL(ByVal strSelect)163
On Error Resume Next164
Dim rstRecordList165
Set rstRecordList=Server.CreateObject("adodb.recordset")166
With rstRecordList167
.ActiveConnection =idbConn168
.CursorType = 1169
.LockType = 1170
.Source = strSelect171
.Open 172
If Err.number <> 0 Then173
idbErr = idbErr & "无效的查询条件！<br />"174
If debug Then idbErr = idbErr & "错误信息："& Err.Description175
.Close176
Set rstRecordList = Nothing177
Response.End()178
Exit Function179
End If 180
End With181
Set GetRecordBySQL = rstRecordList182
End Function183
184
Public Function GetRecordDetail(ByVal TableName,ByVal Condition)185
On Error Resume Next186
Dim rstRecordDetail, strSelect187
Set rstRecordDetail=Server.CreateObject("adodb.recordset")188
With rstRecordDetail189
.ActiveConnection =idbConn190
strSelect = "select * from [" & TableName & "] where " & ValueToSql(TableName,Condition,1)191
.CursorType = 1192
.LockType = 1193
.Source = strSelect194
.Open 195
If Err.number <> 0 Then196
idbErr = idbErr & "无效的查询条件！<br />"197
If debug Then idbErr = idbErr & "错误信息："& Err.Description198
.Close199
Set rstRecordDetail = Nothing200
Response.End()201
Exit Function202
End If203
End With204
Set GetRecordDetail=rstRecordDetail205
End Function206
207
Public Function AddRecord(ByVal TableName, ByVal ValueList)208
On Error Resume Next209
DoExecute(wAddRecord(TableName,ValueList))210
If Err.number <> 0 Then211
idbErr = idbErr & "写入数据库出错！<br />"212
If debug Then idbErr = idbErr & "错误信息："& Err.Description213
'DoExecute "ROLLBACK TRAN Tran_Insert" '如果存在添加事务（事务滚回）214
AddRecord = 0215
Exit Function216
End If217
AddRecord = AutoID(TableName)-1218
End Function219
220
Public Function wAddRecord(ByVal TableName, ByVal ValueList)221
Dim TempSQL, TempFiled, TempValue222
TempFiled = ValueToSql(TableName,ValueList,2)223
TempValue = ValueToSql(TableName,ValueList,3)224
TempSQL = "Insert Into [" & TableName & "] (" & TempFiled & ") Values (" & TempValue & ")"225
wAddRecord = TempSQL226
End Function227
228
Public Function UpdateRecord(ByVal TableName,ByVal Condition,ByVal ValueList)229
On Error Resume Next230
DoExecute(wUpdateRecord(TableName,Condition,ValueList))231
If Err.number <> 0 Then232
idbErr = idbErr & "更新数据库出错！<br />"233
If debug Then idbErr = idbErr & "错误信息："& Err.Description234
'DoExecute "ROLLBACK TRAN Tran_Update" '如果存在添加事务（事务滚回）235
UpdateRecord = 0236
Exit Function237
End If238
UpdateRecord = 1239
End Function240
241
Public Function wUpdateRecord(ByVal TableName,ByVal Condition,ByVal ValueList)242
Dim TmpSQL243
TmpSQL = "Update ["&TableName&"] Set "244
TmpSQL = TmpSQL & ValueToSql(TableName,ValueList,0)245
TmpSQL = TmpSQL & " Where " & ValueToSql(TableName,Condition,1)246
wUpdateRecord = TmpSQL247
End Function248
249
Public Function DeleteRecord(ByVal TableName,ByVal IDFieldName,ByVal IDValues)250
On Error Resume Next251
Dim Sql252
Sql = "Delete From ["&TableName&"] Where ["&IDFieldName&"] In ("253
If IsArray(IDValues) Then254
Sql = Sql & "Select ["&IDFieldName&"] From ["&TableName&"] Where " & ValueToSql(TableName,IDValues,1)255
Else256
Sql = Sql & IDValues257
End If258
Sql = Sql & ")"259
DoExecute(Sql)260
If Err.number <> 0 Then261
idbErr = idbErr & "删除数据出错！<br />"262
If debug Then idbErr = idbErr & "错误信息："& Err.Description263
'DoExecute "ROLLBACK TRAN Tran_Delete" '如果存在添加事务（事务滚回）264
DeleteRecord = 0 265
Exit Function266
End If267
DeleteRecord = 1268
End Function269
270
Public Function wDeleteRecord(ByVal TableName,ByVal IDFieldName,ByVal IDValues)271
On Error Resume Next272
Dim Sql273
Sql = "Delete From ["&TableName&"] Where ["&IDFieldName&"] In ("274
If IsArray(IDValues) Then275
Sql = Sql & "Select ["&IDFieldName&"] From ["&TableName&"] Where " & ValueToSql(TableName,IDValues,1)276
Else277
Sql = Sql & IDValues278
End If279
Sql = Sql & ")"280
wDeleteRecord = Sql281
End Function 282
