Created
September 28, 2023 15:25
-
-
Save evagoras/f85ef5622a65f28ae37a3ead7ab855ef to your computer and use it in GitHub Desktop.
A Generic GetRows VBScript 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_dbConnection | |
Dim i_objConn | |
Dim i_objRS | |
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 | |
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
Dim numCols 'number of fields per row in results | |
Dim numColCounter 'used to loop through the columns | |
Dim numRows 'number of rows in results | |
Dim numRowCounter 'used to loop through the rows | |
Dim strthisfield 'current field in loop | |
numCols = UBound(arrAllData, 1) | |
numRows = UBound(arrAllData, 2) | |
Response.Write("<table border=""1"">" & vbcrlf) | |
'loop through rows | |
For numRowCounter = 0 To numRows | |
Response.Write("<tr>" & vbcrlf) | |
'for each column | |
For numColCounter = 0 to numCols | |
strthisfield = arrAllData(numColCounter, numRowCounter) | |
If IsNull(strthisfield) Then | |
strthisfield = "-null-" | |
End If | |
If Trim(strthisfield) = "" Then | |
strthisfield = " " | |
End If | |
Response.Write("<td valign=top>" & strthisfield & "</td>" & vbcrlf) | |
Next | |
Response.Write("</tr>" & vbcrlf) | |
Next | |
Response.Write("</table>") |
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
'declare local variables for fields in array | |
Dim strQuestion | |
Dim strAnswer | |
Dim datCreated | |
Dim strPoster | |
Dim i | |
For i = 0 To UBound(arrAllData, 2) | |
strQuestion = arrAllData(0, i) | |
strAnswer = arrAllData(1, i) | |
datCreated = arrAllData(2, i) | |
strPoster = arrAllData(3, i) | |
'do something with these variables | |
'like a Response.Write | |
Next |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
https://evagoras.com/2011/01/26/a-generic-getrows-vbscript-class/