ASP access and MS SQL2000 2005 shared Database Operations class

<%

'====================================
' H----------Access and SQL Common database action classes, all SQL statements are SQL
'====================================
Class Dbclass
Public Conn
Private ConnStr
Private ErrorInfo

' Initialize class


Public Sub Class_Initialize


Select Case Cfg.dbtype


Case "MSSQL"


ConnStr = "Provider = SQLOLEDB; User ID = "&amp; Cfg.sqlusername &amp;"; Password = "&amp; Cfg.sqlpassword &amp;"; Initial Catalog = "&amp; Cfg.sqldatabasename &amp;"; Data Source = "&amp; Cfg.sqllocalname &amp;";


Case "Mssql_w"


ConnStr = "Provider = sqloledb;integrated security = SSPI;" Persist Security Info = False;data Source =.;i Nitial Catalog = "&amp; Cfg.sqldatabasename &amp;";


Case "AC"


ConnStr = "Provider = Microsoft.jet.oledb.4.0;data Source =" &amp; Server.MapPath (Cfg.dbpath)


Case Else


Response.Write "&lt;div style=" "Font-family:arial,verdana; font-size:12px; "" &gt; "&amp; cfg.sysversion &amp;" Configuration error ("&amp; Now () &amp;") &lt;a href= "JavaScript Tutorial: History.back ();" " &gt; Return &lt;/a&gt; &lt;a href= "" Javascript:location.reload (); "" &gt; Retry &lt;/a&gt;&lt;br/&gt;&lt;br/&gt; Error Source: &lt;br/&gt;&lt;span style= "" Color: #FF0000 "" &gt; System unsupported Database type &lt;/span &gt;&lt;br/&gt; Error Description: &lt;br/&gt;&lt;span style= "" Color: #FF0000 "" &gt; Unrecognized database Type &lt;/span&gt; "


Response.Write "&lt;/div&gt;"


Response.End ()


End Select


End Sub

' Function: Create a database link


Public Function dbopen ()


If IsObject (Conn) Then Exit Function


Set Conn = Server.CreateObject (cfg.nconnectionobject)


If conn.state = 1 Then Exit Function


On Error Resume Next


Conn.Open ConnStr


If Err.Number Then


ErrorInfo = Err.Description


Err.Clear


Set Conn = Nothing


Response.Write "&lt;div style=" "Font-family:arial,verdana; font-size:12px; "" &gt; "&amp; cfg.sysversion &amp;" Execution error ("&amp; Now () &amp;") &lt;a href= "" Javascript:history.back (); "" &gt; Return &lt;/a&gt; &lt;a href= "" Javascript:location.reload (); "" &gt; Retry &lt;/a&gt;&lt;br/&gt;&lt;br/&gt; Error Source: &lt;br/&gt;&lt;span style= "" Color: #FF0000 "" &gt; Database connection Error &lt;/span&gt; &lt;br/&gt; Error Description: &lt;br/&gt;&lt;span style= "" Color: #FF0000 "" &gt; "&amp; errorinfo &amp;" &lt;/span&gt; "


Response.Write "&lt;/div&gt;"


Response.End ()


End If


End Function

' Function: Close database link
' Parameters: Link string
Public Function dbclose ()
If not IsObject (Conn) Then Exit Function
If conn.state = 0 Then Exit Function
Conn.Close:Set Conn = Nothing
End Function

' function: Creating a Database Recordset object
' Parameters: Link string
Public Function RecordSet (obj)
Set obj = Server.CreateObject (cfg.nrecordsetobject)
End Function

' function: Convert SQL script from current database type
' Parameters: SQL string
' Return: Convert result SQL string
Public Function Sqltran (SQL)
If Cfg.dbtype = "AC" Then
Sqltran = sql2access (SQL)
Else
Sqltran = SQL
End If
End Function

' Function: Database script execution (on behalf of SQL conversion)


' Parameters: SQL script


' Return: Execution result


' Description: This execution can automatically convert partial SQL base syntax based on database type execution


Public Function Execute (SQL)


sql = Sqltran (SQL)


On Error Resume Next


Dbopen ()


Set Execute = Conn.execute (SQL)


If err.number &lt;&gt; 0 Then


Response.Write "&lt;div style=" "Font-family:arial,verdana; font-size:12px; "" &gt; "&amp; cfg.sysversion &amp;" SQL statement execution error ("&amp; Now () &amp;") &lt;a href= "" Javascript:history.back (); "" &gt; Return &lt;/a&gt; &lt;a href= "" Javascript:location.reload (); "" &gt; Retry &lt;/a&gt;&lt;br/&gt;&lt;br/&gt; Error Source: &lt;br/&gt;&lt;span style= "" Color: #FF0000 "" &gt; "&amp; Err.Source &amp;" &lt;/span&gt;&lt;br/&gt; Error Description: &lt;br/&gt;&lt;span style= "" Color: #FF0000 "" &gt; "&amp; Err.Description &amp;" &lt;/ Span&gt; "


If Cfg.printerrorsql Then Response.Write "&lt;br/&gt; Error statements are as follows: &lt;br/&gt;&lt;span style=" "Color: #FF0000" &gt; "&amp; SQL &amp; "&lt;/span&gt;"


Response.Write "&lt;/div&gt;"


Response.End ()


End If


If Err &lt;&gt; 0 Then Err.Clear


End Function

' function: Execute SQL return two-dimensional array


' Parameters: SQL script


' Return: two-dimensional array object


Public Function Query (SQL)


Dim Rstmp,tmparray


sql = Sqltran (SQL)


On Error Resume Next


Dbopen ()


Set Rstmp=conn.execute (SQL)


If err.number &lt;&gt; 0 Then


Response.Write "&lt;div style=" "Font-family:arial,verdana; font-size:12px; "" &gt; "&amp; cfg.sysversion &amp;" SQL statement execution error ("&amp; Now () &amp;") &lt;a href= "" Javascript:history.back (); "" &gt; Return &lt;/a&gt; &lt;a href= "" Javascript:location.reload (); "" &gt; Retry &lt;/a&gt;&lt;br/&gt;&lt;br/&gt; Error Source: &lt;br/&gt;&lt;span style= "" Color: #FF0000 "" &gt; "&amp; Err.Source &amp;" &lt;/span&gt;&lt;br/&gt; Error Description: &lt;br/&gt;&lt;span style= "" Color: #FF0000 "" &gt; "&amp; Err.Description &amp;" &lt;/ Span&gt; "


If Cfg.printerrorsql Then Response.Write "&lt;br/&gt; Error statements are as follows: &lt;br/&gt;&lt;span style=" "Color: #FF0000" &gt; "&amp; SQL &amp; "&lt;/span&gt;"


Response.Write "&lt;/div&gt;"


Response.End ()


End If


If rstmp.eof Or rstmp.bof Then Exit Function


Tmparray=rstmp.getrows ()


Set rstmp=nothing


Query=tmparray


End Function





' function: Execute SQL Return ID that just inserted database record


Public Function Getidenid (tablename)


Getidenid=conn.execute ("Select Ident_current" &amp; CFG. Tableprefix &amp; tablename &amp; "]") (0)


End Function

' [Get the specified field record]


' Sccol use ' | ' Separate unique field names, table names, conditional constraint field names


' Scvalue passed the specified parameter


' Scnonetext alternate text when no records are recorded


' Codes by Konghu


Public Function Getspecialcol (sccol,scvalue,scnonetext)


Dim arrcol,sql,tmp


Arrcol = Split (Sccol, "@")


If IsNumeric (Scnonetext) Then


SQL = "Select" &amp; Arrcol (0) &amp; "from [" &amp; Cfg.tableprefix &amp; "" &amp; Arrcol (1) &amp; "] Where" &amp; Arrcol (2) &amp; "=" &amp; Scvalue


Else


SQL = "Select" &amp; Arrcol (0) &amp; "from [" &amp; Cfg.tableprefix &amp; "" &amp; Arrcol (1) &amp; "] Where" &amp; Arrcol (2) &amp; "= '" &amp; Scvalue &amp; ""


End If


' Response.Write (sql&amp; "&lt;br&gt;")


TMP = Query (SQL)


If IsNull (TMP) Or IsEmpty (TMP) Then


Getspecialcol = Scnonetext


Else


If IsNull (TMP (0,0)) = False Then


Getspecialcol = TMP (0,0)


Else


Getspecialcol = Scnonetext


End If


End If


End Function





' function: Verify that the data exists (true does not exist/false exists)


' Parameters: Value, field, attached condition, table, ID


Public Function Chksamevalue (value,field,wherestr,table,id)


Dbopen ()


Dim temp,wherestring


If wherestr = "" Then


wherestring = ""


Else


wherestring = Wherestr &amp; "and"


End If


If id = "" or IsNull (ID) or IsEmpty (ID) Then


temp = Conn.execute ("Select COUNT (*) from [" &amp; Cfg.tableprefix &amp; Table &amp; "] WHERE" &amp; wherestring &amp; Field &amp; "= '" &amp; Value &amp; "") (0)


Else


temp = Conn.execute ("Select COUNT (*) from [" &amp; Cfg.tableprefix &amp; Table &amp; "] WHERE" &amp; wherestring &amp; Field &amp; "= '" &amp; Value &amp; "' and ID &lt;&gt; ' &amp; ID) (0)


End If


REM Response.Write ("Select COUNT (*) from [" &amp; Cfg.tableprefix &amp; Table &amp; "] WHERE" &amp; wherestring &amp; Field &amp; "= '" &amp; Value &amp; "" &amp; "&lt;br&gt;")


If temp = 0 Then


Chksamevalue = True


Else


Chksamevalue = False


End If


End Function

'//Batch statement transaction processing


Function Begintran (This)


If this = "" or Isnull (this) Then exit Function


Dim I


On Error Resume Next


Dbopen ()


This = Split (this, "$split $")


Conn.begintrans '/Start transaction


For I = 0 to UBound (this)


Response.Write (This (I) &amp; "&lt;br&gt;")


Conn.execute (This (I))


If conn.errors.count&gt;0 Then


Response.Write "&lt;div style=" "Font-family:arial,verdana; font-size:12px; "" &gt; "&amp; cfg.sysversion &amp;" SQL statement execution error ("&amp; Now () &amp;") &lt;a href= "" Javascript:history.back (); "" &gt; Return &lt;/a&gt; &lt;a href= "" Javascript:location.reload (); "" &gt; Retry &lt;/a&gt;&lt;br/&gt;&lt;br/&gt; Error Source: &lt;br/&gt;&lt;span style= "" Color: #FF0000 "" &gt; "&amp; Err.Source &amp;" &lt;/span&gt;&lt;br/&gt; Error Description: &lt;br/&gt;&lt;span style= "" Color: #FF0000 "" &gt; "&amp; Err.Description &amp;" &lt;/ Span&gt; "


Conn.Errors.Clear


Conn.rollbacktrans


Response. End ()


End If


Next


Conn.committrans '//COMMIT TRANSACTION


End Function

' Function: SQL Server to Access (97-2000)
' Parameters: SQL, Database type (access,sqlserver)
Description
Private Function sql2access (SQL)
Dim regEx, Matches, Match
' Create a regular object
Set regEx = New RegExp
Regex.ignorecase = True
Regex.global = True
Regex.multiline = True

' Turn: GetDate ()
Regex.pattern = "(? =[^ ']?) GETDATE () (? =[^ ']?) "
sql = Regex.Replace (sql, now ())

' Turn: UPPER ()
Regex.pattern = "(? =[^ ']?) UPPER ([s]? (. +?) [s]?) (?=[^']?)"
sql = regex.replace (sql, "UCASE ($)")

' Goto: Date representation
' Description: Time format must be 2004-23-23 11:11:10 standard format
Regex.pattern = "' ([d]{4,4}-[d]{1,2}-[d]{1,2} (?: [s][d]{1,2}:[d]{1,2}:[d]{1,2})?) '"
sql = regex.replace (sql, "#$1#")

Regex.pattern = "DATEDIFF (. *?),"


Set matches = Regex.execute (SQL)


Dim Temstr


For the Match in matches


Temstr = "DATEDIFF ("


Select Case Trim (LCase (match.submatches (0))


Case "S":


Temstr = temstr &amp; "' s ',"


Case "n":


Temstr = temstr &amp; "' N ',"


Case "H":


Temstr = temstr &amp; "' H ',"


Case "D":


Temstr = temstr &amp; "' d ',"


Case "M":


Temstr = temstr &amp; "' m ',"


Case "Y":


Temstr = temstr &amp; "' Y ',"


End Select


SQL = Replace (sql,match.value,temstr,1,1)


Next

' Go: Insert function
Regex.pattern = "CHARINDEX" ([s]? (.+?)' [S]?,[s]? ' (.+?)' [s]?) [s]? "
sql = regex.replace (sql, "INSTR" (' $ ', ') ')

Set regEx = Nothing
Sql2access = SQL
End Function

'************************************
' Getconn returns when the linked object
'************************************
Public Property Get Getconn
Dbopen ()
Set Getconn = Conn
End Property

' Note-Removing class
Private Sub Class_Terminate
Dbclose
End Sub
End Class

Class SqlString '//sql generation classes


'************************************


' Variable definition


'************************************


' sTableName----table name


' isqltype----SQL statement type: 0-Add, 1-update, 2-delete, 3-query


' Swhere----conditions


' Sorder----Sorting method


' sSQL----value





Private Stablename,isqltype,swhere,sorder,ssql





'************************************


' Class initialization/end


'************************************


Private Sub Class_Initialize ()


Stablename= ""


Isqltype=0


Swhere= ""


Sorder= ""


Ssql= ""


End Sub





Private Sub Class_Terminate ()





End Sub





'************************************


' Property


'************************************


' Set the properties of the table name


Public Property Let TableName (value)


Stablename=value


End Property





' Set condition


Public Property Let Where (value)


Swhere=value


End Property





' Set sort style


Public Property Let order (value)


Sorder=value


End Property





' Set the type of the query statement


Public Property Let SqlType (value)


Isqltype=value


Select Case Isqltype


Case 0


Ssql= insert INTO {#0} ({#1}) VALUES ({#2})


Case 1


Ssql= ' Update {#0} set {#1}={#2} '


Case 2


Ssql= "Delete from {#0}"


Case 3


Ssql= ' Select {#1} from {#0} '


End Select


End Property





'************************************


' function


'************************************


' Add field (field name, field value)





Public Sub AddField (sfieldname,svalue)


Select Case Isqltype


Case 0


Ssql=replace (sSQL, "{#1}", Sfieldname &amp; ", {#1}")


Ssql=replace (sSQL, "{#2}", "'" &amp; svalue &amp; "', {#2}")


Case 1


Ssql=replace (sSQL, "{#1}", Sfieldname)


Ssql=replace (sSQL, "{#2}", "'" &amp; svalue &amp; "', {#1}={#2}")


Case 3


Ssql=replace (sSQL, "{#1}", Sfieldname &amp; ", {#1}")


End Select


End Sub





' Return SQL statement


Public Function Returnsql ()


Ssql=replace (sSQL, "{#0}", sTableName)


Select Case Isqltype


Case 0


Ssql=replace (sSQL, ", {#1}", "")


Ssql=replace (sSQL, ", {#2}", "")


Case 1


Ssql=replace (sSQL, ", {#1}={#2}", "")


Case 3


Ssql=replace (sSQL, ", {#1}", "")


End Select





If swhere&lt;&gt; "" Then


Ssql=ssql &amp; "where" &amp; Swhere


End If


If sorder&lt;&gt; "" Then


Ssql=ssql &amp; "ORDER BY" &amp; Sorder


End If


Returnsql=ssql


End Function





' Empty statement


Public Sub Clear ()


Stablename= ""


Isqltype=0


Swhere= ""


Sorder= ""


Ssql= ""


End Sub





End Class


%&gt;