Last active
September 28, 2023 14:13
-
-
Save evagoras/ec72d4b10327cdc072590eece5815637 to your computer and use it in GitHub Desktop.
A Generic GetRows VBScript Class – Part II: Adding Update and AddNew functions
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
<% | |
Dim arrFields | |
Dim arrValues | |
Dim clsDatabase | |
Dim numNewID | |
Dim numCategoryID,strQuestion,strAnswer,numPosterID | |
numCategoryID = "5" | |
strQuestion = "What is this?" | |
strAnswer = "This is the answer." | |
numPosterID = "10" | |
'-- include the fields you need to add in the array | |
arrFields = Array("category_ID","question","answer","user_ID") | |
'-- and their corresponding values | |
arrValues = Array(numCategoryID,strQuestion,strAnswer,numPosterID) | |
'-- create instance of the class | |
Set clsDatabase = New Database | |
'-- call the AddNew method passing the necessary parameters | |
clsDatabase.AddNew "tablename",arrFields,arrValues | |
'-- return the primary key of the new record created | |
numNewID = clsDatabase.Output | |
Set clsDatabase = Nothing | |
%> |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Class Database | |
Dim i_dbConnection | |
Dim i_objConn | |
Dim i_objRS | |
Dim i_output | |
Private Sub Class_Initialize() | |
Const MAX_TRIES = 10 | |
Dim intTries | |
On Error Resume Next | |
Do | |
Err.Clear | |
'edit the next line to point to your database | |
i_dbConnection = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Server.MapPath("/faqs.mdb") | |
Set i_objConn = Server.CreateObject("ADODB.Connection") | |
i_objConn.Open i_dbConnection | |
Set i_objRS = Server.CreateObject("ADODB.Recordset") | |
intTries = intTries + 1 | |
Loop While (Err.Number <> 0) And (intTries < MAX_TRIES) | |
End Sub | |
Public Function GetArray(strQuery) | |
'-- Cursor Type, Lock Type | |
' ForwardOnly 0 - ReadOnly 1 | |
' KeySet 1 - Pessimistic 2 | |
' Dynamic 2 - Optimistic 3 | |
' Static 3 - BatchOptimistic 4 | |
i_objRS.Open strQuery, i_objConn, 0, 1 | |
If Err.Number <> 0 Then | |
Response.Write("There was an error processing your request.<br>Please try again.") | |
Exit Function | |
Else | |
If i_objRS.EOF and i_objRS.BOF Then | |
Response.Write("There are currently no records returned.") | |
Exit Function | |
Else | |
GetArray = i_objRS.GetRows() | |
End If | |
End If | |
End Function | |
Public Property Get Output | |
Output = i_output | |
End Property | |
Public Sub AddNew(table,fields,values) | |
Dim arrFields | |
Dim arrValues | |
Dim i | |
Const adOpenKeyset = 1 | |
Const adLockOptimistic = 3 | |
Const adCmdTable = 2 | |
i_objRS.Open table, i_objConn, adOpenKeySet, adLockOptimistic, adCmdTable | |
i_objRS.AddNew | |
For i = 0 To UBound(fields) | |
i_objRS(fields(i)) = values(i) | |
Next | |
i_objRS.Update | |
i_output = i_objRS("ID") | |
End Sub | |
Public Sub Update(table,ID,fields,values) | |
Dim arrFields | |
Dim arrValues | |
Dim i | |
Dim strQuery | |
Dim strFields | |
Const adOpenDynamic = 2 | |
Const adLockOptimistic = 3 | |
Const adCmdText = 1 | |
strQuery = "" | |
For i = LBound(fields) to UBound(fields) | |
strQuery = strQuery & fields(i) & ", " | |
Next | |
strQuery = Left(strQuery, Len(strQuery) - 2) | |
strQuery = "select " & strQuery & " from " & table & " where ID=" & ID | |
i_objRS.Open strQuery, i_objConn, adOpenDynamic, adLockOptimistic, adCmdText | |
For i = 0 To UBound(fields) | |
i_objRS(fields(i)) = values(i) | |
Next | |
i_objRS.Update | |
End Sub | |
Private Sub Class_Terminate() | |
Const adOpenState = 1 'indicates that the object is open | |
If Not i_objRS Is Nothing Then | |
If i_objRS.State = adOpenState Then | |
i_objRS.Close | |
End If | |
Set i_objRS = Nothing | |
End If | |
If Not i_objConn Is Nothing Then | |
If i_objConn.State = adOpenState Then | |
i_objConn.Close | |
End If | |
Set i_objConn = Nothing | |
End If | |
End Sub | |
End Class |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Class Database | |
... | |
Dim i_output | |
Public Property Get Output | |
Output = i_output | |
End Property | |
Public Sub AddNew(table,fields,values) | |
Dim arrFields | |
Dim arrValues | |
Dim i | |
Const adOpenKeyset = 1 | |
Const adLockOptimistic = 3 | |
Const adCmdTable = 2 | |
i_objRS.Open table, i_objConn, adOpenKeySet, adLockOptimistic, adCmdTable | |
i_objRS.AddNew | |
For i = 0 To UBound(fields) | |
i_objRS(fields(i)) = values(i) | |
Next | |
i_objRS.Update | |
i_output = i_objRS("ID") | |
End Sub | |
Public Sub Update(table,ID,fields,values) | |
Dim arrFields | |
Dim arrValues | |
Dim i | |
Dim strQuery | |
Dim strFields | |
Const adOpenDynamic = 2 | |
Const adLockOptimistic = 3 | |
Const adCmdText = 1 | |
strQuery = "" | |
For i = LBound(fields) to UBound(fields) | |
strQuery = strQuery & fields(i) & ", " | |
Next | |
strQuery = Left(strQuery, Len(strQuery) - 2) | |
strQuery = "select " & strQuery & " from " & table & " where ID=" & ID | |
i_objRS.Open strQuery, i_objConn, adOpenDynamic, adLockOptimistic, adCmdText | |
For i = 0 To UBound(fields) | |
i_objRS(fields(i)) = values(i) | |
Next | |
i_objRS.Update | |
End Sub | |
... |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
<% | |
Dim arrFields | |
Dim arrValues | |
Dim clsDatabase | |
Dim numCategoryID,strQuestion,strAnswer | |
numCategoryID = "7" | |
strQuestion = "What is this?" | |
strAnswer = "This is the new answer." | |
arrFields = Array("category_ID","question","answer") | |
arrValues = Array(numCategoryID,strQuestion,strAnswer) | |
Set clsDatabase = New Database | |
clsDatabase.Update "tablename",arrFields,arrValues | |
Set clsDatabase = Nothing | |
%> |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
https://evagoras.com/2011/02/07/a-generic-getrows-vbscript-class-part-ii-adding-update-and-addnew-functions/