ASP通用数据库操作类源代码(1)

  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
 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  Conn
 17 ' OpenConn() '在加载时就建立的默认连接对象Conn,默认使用数据库a
 18 Sub  OpenConn :  Set  Conn  =  Oc(a) :  End Sub
 19 Sub  CloseConn : Co(Conn) :  End Sub
 20
 21 Function  Oc(ByVal Connstr)
 22 On   Error   Resume   Next
 23 Dim  objConn
 24 Set  objConn  =  Server.CreateObject( " ADODB.Connection " )
 25 objConn.Open Connstr
 26 If  Err.number  <>   0   Then
 27    Response.Write( " 数据库服务器端连接错误，请与网站管理员联系。

" )
 28     ' Response.Write("错误信息：" & Err.Description)
 29    objConn.Close
 30     Set  objConn  =   Nothing
 31    Response.End
 32 End   If
 33 Set  Oc  =  objConn
 34 End Function
 35
 36 Sub  Co(obj)
 37 On   Error   Resume   Next
 38 Set  obj  =   Nothing
 39 End Sub
 40
 41 Function  CreatConn(ByVal dbType, ByVal strDB, ByVal strServer, ByVal strUid, ByVal strPwd)
 42 Dim  TempStr
 43 Select   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 & " ; "
 53 End   Select
 54 CreatConn  =  TempStr
 55 End Function
 56
 57
 58 Class dbCtrl
 59 Private  debug
 60 Private  idbConn
 61 Private  idbErr
 62
 63 Private   Sub  Class_Initialize()
 64    debug  =   true               ' 调试模式是否开启
 65    idbErr  =   " 出现错误： "
 66     If   IsObject (Conn)  Then
 67        Set  idbConn  =  Conn
 68     End   If
 69 End Sub
 70
 71 Private   Sub  Class_Terminate()
 72     Set  idbConn  =   Nothing
 73     If  debug  And  idbErr <> " 出现错误： "   Then  Response.Write(idbErr)
 74 End Sub
 75
 76 Public   Property   Let  dbConn(pdbConn)
 77     If   IsObject (pdbConn)  Then
 78        Set  idbConn  =  pdbConn
 79     Else
 80        Set  idbConn  =  Conn
 81     End   If
 82 End Property
 83
 84 Public   Property   Get  dbErr()
 85    dbErr  =  idbErr
 86 End Property
 87
 88 Public   Property   Get  Version
 89    Version  =   " ASP Database Ctrl V1.0 By ColdStone "
 90 End Property
 91
 92 Public   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  &   " 无效的查询条件！ "
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
117 End Function
118
119 Public   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  &   " 无效的查询条件！ "
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
139 End Function
140
141 Public   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
160 End Function
161
162 Public   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  &   " 无效的查询条件！ "
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
182 End Function
183
184 Public   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  &   " 无效的查询条件！ "
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
205 End Function
206
207 Public   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  &   " 写入数据库出错！ "
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
218 End Function
219
220 Public   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
226 End Function
227
228 Public   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  &   " 更新数据库出错！ "
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
239 End Function
240
241 Public   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
247 End Function
248
249 Public   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  &   " 删除数据出错！ "
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
268 End Function
269
270 Public   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
281 End Function  
282

转载于:https://www.cnblogs.com/voswin/articles/1282506.html