Skip to content

Instantly share code, notes, and snippets.

@evagoras

evagoras/add-output

Last active September 28, 2023 14:13
Show Gist options
  • Save evagoras/ec72d4b10327cdc072590eece5815637 to your computer and use it in GitHub Desktop.
Save evagoras/ec72d4b10327cdc072590eece5815637 to your computer and use it in GitHub Desktop.
Download ZIP
A Generic GetRows VBScript Class – Part II: Adding Update and AddNew functions
Raw
add-output
<%
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
%>
Raw
clasDatabase.asp
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
Raw
class
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
...
Raw
update
<%
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
%>
@evagoras
Copy link
Author

https://evagoras.com/2011/02/07/a-generic-getrows-vbscript-class-part-ii-adding-update-and-addnew-functions/

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment