ASP database Operations Class

<%
'==========================================================================
' File name: clsdbctrl.asp
' Function: Database Operation class
' Author: coldstone (coldstone[in]qq.com)
' Program version: v1.0.5
' Finish time: 2005.09.23
' Modified time: 2007.10.30
' Copyright notice: You can use this program code in any work, but please keep this copyright information.
' If you modify the code in the program and get a better application, please send me a copy, thank you.
' From: http://www.ezsaler.com/Blog/post/158.html
'==========================================================================
Dim a:a = creatconn (0, "master", "localhost", "sa", "") ' MSSQL database
' Dim a:a = creatconn (1, Data/%testdb%.mdb, "", "", ") ' Access database
' Dim a:a = creatconn (1, "E:\MyWeb\Data\%TestDB%.mdb", "", "", "Mdbpassword")
Dim Conn
' Openconn () ' The default connection object established at load time conn, using database A by default
Sub Openconn:set Conn = Oc (a): End Sub
Sub Closeconn:co (Conn): End Sub
Function Oc (ByVal connstr)
On Error Resume Next
Dim objconn
Set objconn = Server.CreateObject ("ADODB. Connection ")
objConn.Open connstr
If err.number <> 0 Then
Response.Write ("<div id=" "Dberror" > Database server-side connection error, please contact your site administrator. </div> ")
' Response.Write ("error message:" & Err.Description)
Objconn.close
Set objconn = Nothing
Response.End
End If
Set Oc = objconn
End Function
Sub Co (obj)
On Error Resume Next
Set obj = Nothing
End Sub
Function Creatconn (ByVal dbType, ByVal strDB, ByVal strserver, ByVal struid, ByVal strpwd)
Dim TempStr
Select Case DbType
Case "0", "MSSQL"
TempStr = "Driver={sql server};server=" &strServer& "uid=" &strUid& ";p wd=" &strPwd& "; Database= "&strdb
Case "1", "ACCESS"
Dim tdb:if Instr (strDB, ":") >0 then:tdb = StrDB:Else:tDb = Server.MapPath (STRDB): End If
TempStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data source=" &tDb& "; Jet oledb:database password= "&strPwd&"; "
Case "3", "MYSQL"
TempStr = "Driver={mysql};" Server= "&strServer&"; port=3306;option=131072; stmt=; Database= "&strDB&"; Uid= "&strUid&"; Pwd= "&strPwd&"; "
Case "4", "ORACLE"
TempStr = "Driver={microsoft ODBC for Oracle}; Server= "&strServer&"; Uid= "&strUid&"; Pwd= "&strPwd&"; "
End Select
Creatconn = TempStr
End Function
Class Dbctrl
Private Debug
Private Idbconn
Private Idberr
Private Sub Class_Initialize ()
Debug = True ' Debug mode is turned on
Idberr = "Error occurred:"
If IsObject (Conn) Then
Set Idbconn = Conn
End If
End Sub
Private Sub Class_Terminate ()
Set Idbconn = Nothing
If Debug and idberr<> Error: "Then Response.Write (Idberr)
End Sub
Public Property Let Dbconn (Pdbconn)
If IsObject (pdbconn) Then
Set Idbconn = Pdbconn
Else
Set Idbconn = Conn
End If
End Property
Public Property Get Dberr ()
Dberr = Idberr
End Property
Public Property Get Version
Version = "ASP Database Ctrl V1.0 by Coldstone"
End Property
Public Function autoid (ByVal tablename)
On Error Resume Next
Dim M_no,sql, M_firtempno
Set m_no=server.createobject ("Adodb.recordset")
Sql= "SELECT * from [" &TableName&] "
M_no.open sql,idbconn,3,3
If m_no.eof Then
Autoid=1
Else
Do as not m_no.eof
M_firtempno=m_no.fields (0). Value
M_no.movenext
If m_no.eof Then
Autoid=m_firtempno+1
End If
Loop
End If
If err.number <> 0 Then
Idberr = idberr & "Invalid query condition!" <br/> "
If Debug Then idberr = idberr & "error message:" & Err.Description
Response.End ()
Exit Function
End If
M_no.close
Set M_no = Nothing
End Function
Public Function Getrecord (ByVal tablename,byval fieldslist,byval condition,byval orderfield,byval)
On Error Resume Next
Dim rstrecordlist
Set rstrecordlist=server.createobject ("Adodb.recordset")
With Rstrecordlist
. ActiveConnection = Idbconn
. CursorType = 3
. LockType = 3
. Source = Wgetrecord (Tablename,fieldslist,condition,orderfield,shown)
. Open
If err.number <> 0 Then
Idberr = idberr & "Invalid query condition!" <br/> "
If Debug Then idberr = idberr & "error message:" & Err.Description
. Close
Set rstrecordlist = Nothing
Response.End ()
Exit Function
End If
End With
Set getrecord=rstrecordlist
End Function
Public Function Wgetrecord (ByVal tablename,byval fieldslist,byval condition,byval orderfield,byval)
Dim Strselect
strselect= "SELECT"
If shown > 0 Then
Strselect = strselect & "Top" & Shown & ""
End If
If fieldslist<> "" Then
Strselect = strselect & fieldslist
Else
Strselect = strselect & "*"
End If
Strselect = Strselect & "from [" & TableName & "]"
If Condition <> "" Then
Strselect = Strselect & "where" & Valuetosql (tablename,condition,1)
End If
If OrderField <> "" Then
Strselect = Strselect & "ORDER BY" & OrderField
End If
Wgetrecord = Strselect
End Function
Public Function Getrecordbysql (ByVal strselect)
On Error Resume Next
Dim rstrecordlist
Set rstrecordlist=server.createobject ("Adodb.recordset")
With Rstrecordlist
. ActiveConnection =idbconn
. CursorType = 3
. LockType = 3
. Source = Strselect
. Open
If err.number <> 0 Then
Idberr = idberr & "Invalid query condition!" <br/> "
If Debug Then idberr = idberr & "error message:" & Err.Description
. Close
Set rstrecordlist = Nothing
Response.End ()
Exit Function
End If
End With
Set Getrecordbysql = rstrecordlist
End Function
Public Function getrecorddetail (ByVal tablename,byval Condition)
On Error Resume Next
Dim Rstrecorddetail, Strselect
Set rstrecorddetail=server.createobject ("Adodb.recordset")
With Rstrecorddetail
. ActiveConnection =idbconn
Strselect = "SELECT * FROM [" & TableName & "] where" & Valuetosql (tablename,condition,1)
. CursorType = 3
. LockType = 3
. Source = Strselect
. Open
If err.number <> 0 Then
Idberr = idberr & "Invalid query condition!" <br/> "
If Debug Then idberr = idberr & "error message:" & Err.Description
. Close
Set Rstrecorddetail = Nothing
Response.End ()
Exit Function
End If
End With
Set Getrecorddetail=rstrecorddetail
End Function
Public Function AddRecord (ByVal tablename, ByVal valuelist)
On Error Resume Next
Doexecute (Waddrecord (tablename,valuelist))
If err.number <> 0 Then
Idberr = idberr & Write Database Error! <br/> "
If Debug Then idberr = idberr & "error message:" & Err.Description
' Doexecute ' ROLLBACK TRAN tran_insert ' If there is an Add transaction (transaction Roll back)
AddRecord = 0
Exit Function
End If
AddRecord = autoid (tablename)-1
End Function
Public Function Waddrecord (ByVal tablename, ByVal valuelist)
Dim Tempsql, tempfiled, Tempvalue
tempfiled = Valuetosql (tablename,valuelist,2)
Tempvalue = Valuetosql (tablename,valuelist,3)
Tempsql = "Insert into [" & TableName & "] (" & tempfiled & ") Values (" & Tempvalue & ")"
Waddrecord = Tempsql
End Function
Public Function UpdateRecord (ByVal tablename,byval condition,byval valuelist)
On Error Resume Next
Doexecute (Wupdaterecord (tablename,condition,valuelist))
If err.number <> 0 Then
Idberr = idberr & Update Database Error! <br/> "
If Debug Then idberr = idberr & "error message:" & Err.Description
' Doexecute ' ROLLBACK TRAN tran_update ' If there is an Add transaction (transaction Roll back)
UpdateRecord = 0
Exit Function
End If
UpdateRecord = 1
End Function
Public Function Wupdaterecord (ByVal tablename,byval condition,byval valuelist)
Dim Tmpsql
Tmpsql = "Update [" &TableName& "] Set"
Tmpsql = Tmpsql & Valuetosql (tablename,valuelist,0)
Tmpsql = tmpsql & "Where" & Valuetosql (tablename,condition,1)
Wupdaterecord = Tmpsql
End Function
Public Function DeleteRecord (ByVal tablename,byval idfieldname,byval idvalues)
On Error Resume Next
Dim SQL
SQL = "Delete from [&TableName&] Where [' &IDFieldName&]" in ("
If IsArray (idvalues) Then
sql = SQL & "Select [" &IDFieldName& "] from [" &TableName& "] Where" & Valuetosql (Tablename,idvalue s,1)
Else
sql = SQL & idvalues
End If
sql = SQL & ")"
Doexecute (SQL)
If err.number <> 0 Then
Idberr = idberr & Delete data Error! <br/> "
If Debug Then idberr = idberr & "error message:" & Err.Description
' Doexecute ' ROLLBACK TRAN tran_delete ' If there is an Add transaction (transaction Roll back)
DeleteRecord = 0
Exit Function
End If
DeleteRecord = 1
End Function
Public Function Wdeleterecord (ByVal tablename,byval idfieldname,byval idvalues)
On Error Resume Next
Dim SQL
SQL = "Delete from [&TableName&] Where [' &IDFieldName&]" in ("
If IsArray (idvalues) Then
sql = SQL & "Select [" &IDFieldName& "] from [" &TableName& "] Where" & Valuetosql (Tablename,idvalue s,1)
Else
sql = SQL & idvalues
End If
sql = SQL & ")"
Wdeleterecord = SQL
End Function
Public Function readtable (ByVal tablename,byval condition,byval getfieldnames)
On Error Resume Next
Dim Rstgetvalue,sql,basecondition,arrtemp,arrstr,tempstr,i
TempStr = "": Arrstr = ""
' Give the SQL conditional statement
Basecondition = Valuetosql (tablename,condition,1)
' Read data
Set Rstgetvalue = Server.CreateObject ("ADODB. Recordset ")
SQL = ' select ' &GetFieldNames& ' from [' &TableName&] Where ' &basecondition
Rstgetvalue.open sql,idbconn,3,3
If rstgetvalue.recordcount > 0 Then
If Instr (Getfieldnames, ",") >0 Then
arrtemp = Split (Getfieldnames, ",")
For i = 0 to Ubound (arrtemp)
If i<>0 Then arrstr = arrstr &chr (112) &AMP;CHR (112) &AMP;CHR (113)
Arrstr = arrstr & Rstgetvalue.fields (i). Value
Next
TempStr = Split (ARRSTR,CHR (112) &AMP;CHR (112) &AMP;CHR (113))
Else
TempStr = Rstgetvalue.fields (0). Value
End If
End If
If err.number <> 0 Then
Idberr = Idberr & "Get data Error!" <br/> "
If Debug Then idberr = idberr & "error message:" & Err.Description
Rstgetvalue.close ()
Set Rstgetvalue = Nothing
Exit Function
End If
Rstgetvalue.close ()
Set Rstgetvalue = Nothing
Readtable = TempStr
End Function
Public Function C (ByVal objRS)
Objrs.close ()
Set objRS = Nothing
End Function
Private Function Valuetosql (ByVal tablename, ByVal valuelist, ByVal stype)
Dim strtemp
strtemp = ValueList
If IsArray (valuelist) Then
strtemp = ""
Dim rstemp, Currentfield, CurrentValue, I
Set rstemp = Server.CreateObject ("Adodb.recordset")
With Rstemp
. ActiveConnection = Idbconn
. CursorType = 3
. LockType = 3
. Source = "SELECT * FROM [" & TableName & "] where 1 =-1"
. Open
For i = 0 to Ubound (valuelist)
Currentfield = Left (ValueList (i), Instr (ValueList (i), ":")-1)
CurrentValue = Mid (ValueList (i), Instr (ValueList (i), ":") +1)
If I <> 0 Then
Select Case Stype
Case 1
strtemp = strtemp & "and"
Case Else
strtemp = strtemp & ","
End Select
End If
If stype = 2 Then
strtemp = strtemp & "[" & Currentfield & "]"
Else
Select case. Fields (Currentfield). Type
Case 7,133,134,135,8,129,200,201,202,203
If stype = 3 Then
strtemp = strtemp & "'" &CurrentValue& ""
Else
strtemp = strtemp & "[" & Currentfield & "] = '" &CurrentValue& "'"
End If
Case 11
If UCase (CStr (currentvalue)) = "TRUE" Then
If stype = 3 Then
strtemp = strtemp & "1"
Else
strtemp = strtemp & "[" & Currentfield & "] = 1"
End If
Else
If stype = 3 Then
strtemp = strtemp & "0"
Else
strtemp = strtemp & "[" & Currentfield & "] = 0"
End If
End If
Case Else
If stype = 3 Then
strtemp = strtemp & CurrentValue
Else
strtemp = strtemp & "[" & Currentfield & "] =" & CurrentValue
End If
End Select
End If
Next
End With
If err.number <> 0 Then
Idberr = idberr & "Generate SQL statement error!" <br/> "
If Debug Then idberr = idberr & "error message:" & Err.Description
Rstemp.close ()
Set rstemp = Nothing
Exit Function
End If
Rstemp.close ()
Set rstemp = Nothing
End If
Valuetosql = strtemp
End Function
Private Function Doexecute (ByVal sql)
Dim Executecmd
Set executecmd = Server.CreateObject ("Adodb.command")
With Executecmd
. ActiveConnection = Idbconn
. CommandText = sql
. Execute
End With
Set Executecmd = Nothing
End Function
End Class
%>