< %
'*****************************************************************************
'*****************************************************************************
'
' This code can be used anywhere you like, all I ask is that you keep this
' notice here, so people know who actually made it! =D Thanks!
'
' This code was developed by Kevin Pirnie, c/o o7th Web Design
' support@07th.com :: http://www.07th.com
'
'*****************************************************************************
'*****************************************************************************
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'Dimension our variables
Dim objData, intPage
Dim intCols, intRows, intTotPages, intTotRecs, strDisplayPaging, strConnString
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'Get the page we are on, if any
intPage = Request.QueryString("p")
'If we don't have a page, set it to 1
If Not(IsNumeric(intPage)) Then intPage = 1
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'Set our data object to the class
Set objData = New DBv1
With objData 'just because i don't feel like typing out objData everytime I need it
'Set our command type: 1 = Inline SQL Statement, 4 = Stored Procedure
.intCommandType = 1
'Pass our Connection String ... if we have one, uncomment the line below, and comment the ... section
'.strConnString = strConnString
'Or we can simply build it here, just uncomment the lines in between ...
' ...
.intDBType = 3
'Supported database types:
' 1 = SQL 2000
' 2 = SQL 2005
' 3 = SQL 2005 Express
' 4 = MS Access
' 6 = MS Access 2007
' 7 = MySQL
' 8 = Borland Interbase '<- requires the proper driver installed on the server
.strDBServer = "The Address to your Database Server"
.strDBUser = "The Database Username"
.strDBPassword = "The Database Password"
.strDBDatabase = "The default database"
' ...
'Pass the class our SQL statement, use ? in the WHERE clause
'You can also use this to fire off a stored procedure
.strQry = "Select Field1, Field2 From Table Where Field3 = ? Or Field4 = ?"
'Pass an array of values to look for in our WHERE clause
.arrParamValues = Array(Val1, Val2) 'If none, use ""
'Pass an array of Data Types for our values (These are ADO DataTypes, and the list of them can be found here -> http://www.w3schools.com/ADO/ado_datatypes.asp)
'Only use the numeric value for this, we also only support the following:
'2, 3, 4, 5, 6, 7, 11, 14, 72, 128, 129, 200, 203, 204
.arrParamDataTypes = Array(200, 200) 'If none, use ""
'If we fire a stored procedure, and it has an output variable
'.intRetDataType = 3 'Set the return value data type
'.intRetSize = 4 'Set the return value size
'Do we want to page the results?
.boolUsePaging = True 'or False
'How many records per page do we want to display?
.intRecPerPage = 10 'any numeric value
'What page number are we on?
.intPageNumber = intPage
'What page are we displaying these results?
.strPagingPage = "usage.asp?a=a" 'We use a=a because the paging method expects a querystring to already be available
'What should we use to display for the left arrows?
.strPagingLeft = "«"
'What should we use to display for the right arrows?
.strPagingRight = "»"
'Execute our query, and store the resulting 2d array in a variable for use later
'If we fire a stored procedure and it has an output variable, this variable will equal that value
tmpArray = .ExecuteQry()
'Get the total number of pages returned from the recordset
intTotPages = .intTotalPages
'Get the total number of records returned from the recordset
intTotRecs = .intTotalRecords
'Get our paging links for the recordset
strDisplayPaging = .RecordPaging()
End With 'End our With block
'Clean up the object
Set objData = Nothing
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'Now that we have done all this, let's see what the results are.
'First we check to see if we have an array
If IsArray(tmpArray) Then
'We have an array, so let's work with it
'I'd like to put in the info about the paging, total records & total pages
Response.Write("<strong>" & intTotRecs & "</strong> total records in <strong>" & intTotPages & "</strong> pages.")
'Now I want to display my paging links
Response.Write(strDisplayPaging)
'Now Let's display the results of the recordset...
Response.Write("
" & VbCrLf)
'Since I know how many columns, I will simply put the table header here
Response.Write("
" & VbCrLf)
Response.Write("
" & VbCrLf)
Response.Write("
" & VbCrLf)
Response.Write("
" & VbCrLf)
Response.Write("
" & VbCrLf)
Response.Write("
" & VbCrLf)
Response.Write(" " & VbCrLf)
Response.Write(" " & VbCrLf)
'Now let's start the body of our table
Response.Write("
" & VbCrLf)
'Let's start a FOR loop to get and display all available rows
For intRows = 0 To UBound(tmpArray, 2) 'The 2 is representative of the rows in the recordset
'If we didn't know what columns we have, we would do another FOR loop inside this using:
'UBound(tmpArray, 1)
Response.Write("
" & VbCrLf)
Response.Write("
" & VbCrLf)
Response.Write("
" & VbCrLf)
Response.Write("
" & VbCrLf)
Response.Write("
" & VbCrLf)
Response.Write(" " & VbCrLf)
Next
intRows = Null 'Clear intRows out
Response.Write(" " & VbCrLf)
Response.Write("<table 100%="" 2="" 0="" 1="" border="1" cellpadding="" cellspacing="" width=""><thead><tr><th>ISO CC</th>
<th>ISO CC3</th>
<th>Country Number Code</th>
<th>Country Name</th>
</tr>
</thead>
<tbody><tr><td>" & tmpArray(1, intRows) & "</td>
<td>" & tmpArray(3, intRows) & "</td>
<td>" & tmpArray(4, intRows) & "</td>
<td>" & tmpArray(2, intRows) & "</td>
</tr>
</tbody>
</table>
" & VbCrLf)
'Id like to display the record paging again, in case the list is long
Response.Write(strDisplayPaging)
'I'd also like to display that paging info again
Response.Write("<strong>" & intTotRecs & "</strong> total records in <strong>" & intTotPages & "</strong> pages.")
Erase tmpArray 'Releases the array from memory
Else
'We have no array, so let's display a message stating this!
Response.Write("There are no records for that query.")
End If
%>
< %
'*****************************************************************************
'*****************************************************************************
'
' This code can be used anywhere you like, all I ask is that you keep this
' notice here, so people know who actually made it! =D Thanks!
'
' This code was developed by Kevin Pirnie, c/o o7th Web Design
' support@07th.com :: http://www.07th.com
'
'*****************************************************************************
'*****************************************************************************
Class DBv1
'Private Declarations
Private i, p, pp, strDataLength, objCmd, objRS, objConn, objError
Private intCurrPage, ini, fim
'Public Declarations
Public intDBType, strDBUser, strDBPassword, strDBServer, strDBDatabase
Public strConnString, intCommandType
Public strQry, arrParamValues, arrParamDataTypes, intRetDataType, intRetSize
Public boolUsePaging, intTotalPages, intTotalRecords
Public intRecPerPage, intPageNumber, strPagingPage, strPagingLeft, strPagingRight
'Initialize
Private Sub Class_Initialize()
intDBType = 0
intCommandType = 0
strDBServer = Null
strDBUser = Null
strDBPassword = Null
strDBDatabase = Null
strQry = Null
arrParamValues = Null
arrParamDataTypes = Null
boolUsePaging = False
intTotalPages = 0
intTotalRecords = 0
intRecPerPage = 0
intPageNumber = 0
strPagingPage = Null
strPagingLeft = " < "
strPagingRight = " > "
End Sub
'Terminate
Private Sub Class_Terminate()
intDBType = 0
intCommandType = 0
strDBServer = Null
strDBUser = Null
strDBPassword = Null
strDBDatabase = Null
strQry = Null
arrParamValues = Null
arrParamDataTypes = Null
boolUsePaging = False
intTotalPages = 0
intTotalRecords = 0
intRecPerPage = 0
intPageNumber = 0
strPagingPage = Null
strPagingLeft = " &lgt; "
strPagingRight = " &rgt; "
End Sub
'Execute the Query
Public Function ExecuteQry()
Set objConn = CreateObject("ADODB.Connection")
objConn.Open strConnectionString
Set objCmd = CreateObject("ADODB.Command")
objCmd.CommandText = strQry
objCmd.CommandType = intCommandType
If IsArray(arrParamValues) And IsArray(arrParamDataTypes) Then
If UBound(arrParamValues) = UBound(arrParamDataTypes) Then
For i = 0 To UBound(arrParamValues)
Select Case arrParamDataTypes(i)
Case 2 'Small Integer
strDataLength = 2
Case 3 'Integer
strDataLength = 4
Case 4 'Single
strDataLength = 4
Case 5 'Float
strDataLength = 8
Case 6 'Currency
strDataLength = 8
Case 7 'Date
strDataLength = 8
Case 11 'Bit
strDataLength = 1
Case 14 'Decimal
strDataLength = 9
Case 72 'GUID
strDataLength = 16
Case 128 'Binary
strDataLength = 50
Case 129 'Char
If Not ReqValue(arrParamValues(i)) Then
strDataLength = 1
Else
strDataLength = Len(arrParamValues(i))
End If
Case 200 'VarChar
If Not ReqValue(arrParamValues(i)) Then
strDataLength = 1
Else
strDataLength = Len(arrParamValues(i))
End If
Case 203 'NText
If Not ReqValue(arrParamValues(i)) Then
strDataLength = 1
Else
strDataLength = Len(arrParamValues(i))
End If
Case 204 'VarBinary
strDataLength = 50
Case Else 'Hmm...guess
If Not ReqValue(arrParamValues(i)) Then
strDataLength = 1
Else
strDataLength = Len(arrParamValues(i))
End If
End Select
If arrParamDataTypes(i) = 14 Then
Set p = objCmd.CreateParameter(, CInt(arrParamDataTypes(i)), , CInt(strDataLength), InputCleaner(arrParamValues(i)))
p.NumericScale = 2
p.Precision = 10
objCmd.Parameters.Append p
Else
objCmd.Parameters.Append (objCmd.CreateParameter(, CInt(arrParamDataTypes(i)), , CInt(strDataLength), InputCleaner(arrParamValues(i))))
End If
Next
i = Null
Erase arrParamValues
Erase arrParamDataTypes
Else
ExecuteQry = "Your values and data type arrays need to be the same length."
End If
End If
'Debug the parameters if necessary
'For each Item In objCmd.Parameters
' Write("Name:" & Item.Name & "-Type:" & Item.Type & "-Value:" & Item.Value & "")
'Next
Set objCmd.ActiveConnection = objConn
Select Case intCommandType
Case 1
If InStr(1, UCase(strQry), "SELECT") > 0 Then
Set objRS = CreateObject("Adodb.RecordSet")
If boolUsePaging Then
objRS.PageSize = intRecPerPage
objRS.CacheSize = intRecPerPage
objRS.CursorType = 3
End If
objRS.Open objCmd
If Not (objRS.EOF) Then
If boolUsePaging Then
If Not (validNumber(intPageNumber)) Then
objRS.AbsolutePage = 1
Else
objRS.AbsolutePage = intPageNumber
End If
ExecuteQry = objRS.GetRows(intRecPerPage)
intTotalPages = objRS.PageCount
intTotalRecords = objRS.RecordCount
Else
ExecuteQry = objRS.GetRows()
End If
Else
ExecuteQry = "There are no records."
Exit Function
End If
Set objRS = Nothing
Exit Function
ElseIf InStr(1, UCase(strQry), "INSERT") > 0 Then
If InStr(1, UCase(strQry), "@@IDENTITY") > 0 Or InStr(1, UCase(strQry), "NEWID()") > 0 Then
Set objRS = objCmd.Execute()
If Not (objRS.EOF) Then
ExecuteQry = objRS(0)
End If
Set objRS = Nothing
Else
objCmd.Execute
ExecuteQry = "Your command has been executed."
End If
ElseIf (InStr(1, UCase(strQry), "DELETE") > 0 Or InStr(1, UCase(strQry), "UPDATE") > 0 Or Left(UCase(strQry), 2) = "SP") Then
If Left(UCase(strQry), 2) = "SP" And intRetDataType > "" Then
objCmd.Parameters.Append (objCmd.CreateParameter("@ret", intRetDataType, 2, , intRetSize))
objCmd.Execute
ExecuteQry = objCmd.Parameters("@ret")
Else
ExecuteQry = objCmd.Execute
End If
End If
Case 4
If intRetDataType > "" Then
objCmd.Parameters.Append (objCmd.CreateParameter("@ret", intRetDataType, 2, , intRetSize))
objCmd.Execute
ExecuteQry = objCmd.Parameters("@ret")
Else
If boolUsePaging Then
Set objRS = CreateObject("Adodb.RecordSet")
objRS.PageSize = intRecPerPage
objRS.CacheSize = intRecPerPage
objRS.CursorType = 3
objRS.CursorLocation = 3
objRS.Open objCmd
If Not (objRS.EOF) Then
If boolUsePaging Then
If Not (validNumber(intPageNumber)) Then
objRS.AbsolutePage = 1
Else
objRS.AbsolutePage = intPageNumber
End If
ExecuteQry = objRS.GetRows(intRecPerPage)
intTotalPages = objRS.PageCount
intTotalRecords = objRS.RecordCount
Else
ExecuteQry = objRS.GetRows()
End If
Else
objCmd.Execute
End If
Set objRS = Nothing
Else
objCmd.Execute
End If
End If
End Select
Set objCmd.ActiveConnection = Nothing
Set objCmd = Nothing
objConn.Close
Set objConn = Nothing
End Function
'Paging Links
Public Function RecordPaging()
tmpString = ""
tmpString = tmpString & "
<div class="" paging_links="">" & vbCrLf
If Not (validNumber(intPageNumber)) Then
CurrentPage = 1 'We're On the first page
NumPerPageOf = 1
Else
CurrentPage = CInt(intPageNumber)
NumPerPageOf = ((CurrentPage * NumPerPage) - NumPerPage) + 1
End If
If CurrentPage > 1 Then
If CurrentPage > 5 And intTotalPages > 10 Then
tmpString = tmpString & " <span><a href="" strpagingpage="" &="" &p="1""">1</a></span> "
tmpString = tmpString & "<span class="" prevchunk=""> « </span>"
End If
If intTotalPages > 10 Then
If CurrentPage > 5 Then
If intTotalPages > (CurrentPage + 5) Then
ini = (CurrentPage - 4)
fim = (CurrentPage + 5)
Else
ini = (intTotalPages - 9)
fim = intTotalPages
End If
Else
ini = 1
fim = 10
End If
Else
ini = 1
fim = intTotalPages
End If
For a = ini To fim
If a = CInt(intPageNumber) Then
tmpString = tmpString & " <span class="" curpage="">" & a & "</span> "
Else
tmpString = tmpString & " <span><a href="" strpagingpage="" &="" &p=" & a & ">" & a & "</a></span> "
End If
Next: a = Null
Else
If intTotalPages = 1 Then
tmpString = tmpString & ""
Else
tmpString = tmpString & "<span class="" curpage="">1</span> "
End If
If intTotalPages > 10 Then 'id=161&MWC=Layouts
fim = 10
Else
fim = intTotalPages
End If
For a = 2 To fim
If a = CInt(intPageNumber) Then
tmpString = tmpString & "<span class="" curpage="">" & a & "</span> "
Else
tmpString = tmpString & " <span><a href="" strpagingpage="" &="" &p=" & a & ">" & a & "</a></span> "
End If
Next: a = Null
End If
If CurrentPage < intTotalPages - 5 And intTotalPages > 10 Then
tmpString = tmpString & "<span class="" lastchunk=""> » </span>"
tmpString = tmpString & " <span><a href="" strpagingpage="" &="" &p=" & intTotalPages & ">" & intTotalPages & "</a></span> "
End If
tmpString = tmpString & "</div>
" & vbCrLf
RecordPaging = tmpString
tmpString = ""
End Function
'Get our connection string
Private Function strConnectionString()
If ReqValue(strConnString) Then
strConnectionString = strConnString
Else
Select Case intDBType
Case 1 'SQL 2000
strConnectionString = "Provider=SQLOLEDB.1;Password=" & strDBPassword & ";User ID=" & strDBUser & ";Initial Catalog=" & strDBDatabase & ";Data Source=" & strDBServer & ""
Case 2 'SQL 2005
strConnectionString = "Provider=SQLNCLI;Server=" & strDBServer & ";Database=" & strDBDatabase & ";Uid=" & strDBUser & ";Pwd=" & strDBPassword & ";DataTypeCompatibility=80;"
Case 3 'SQL 2005 Express
strConnectionString = "Provider=SQLOLEDB;Data Source=" & strDBServer & ";Persist Security Info=True;Password=" & strDBPassword & ";User ID=" & strDBUser & ";Initial Catalog=" & strDBDatabase & ";DataTypeCompatibility=80"
Case 4 'MS Access
strConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBDatabase & ";User Id=" & strDBUser & ";Password=" & strDBPassword & ";"
Case 6 'MS Access 2007
strConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDBDatabase & ";Persist Security Info=False;"
Case 8 'Borland Interbase - requires the SIBProvider to be installed on the server
strConnectionString = "provider=sibprovider;location=" & strDBServer & ":;data source=" & strDBDatabase & ";user id=" & strDBUser & ";Password=" & strDBPassword & ";"
Case 7 'MySQL
strConnectionString = "Driver={MySQL ODBC 3.51 Driver};Server=" & strDBServer & ";Database=" & strDBDatabase & "; User=" & strDBUser & ";Password=" & strDBPassword & ";Option=3;"
End Select
End If
End Function
'Input cleaning ... just in case
Private Function InputCleaner(ByVal strStringToClean)
If Not (ReqValue(strStringToClean)) Then
If InStr(1, strStringToClean, "'") > 0 Then strStringToClean = REPLACE(cast(cast(strStringToClean as nvarchar(max)) as nvarchar(max)),cast(cast( "'" as nvarchar(max)) as nvarchar(max)),cast(cast( "'" as nvarchar(max as nvarchar(max)))))
If InStr(1, strStringToClean, Chr(34)) > 0 Then strStringToClean = REPLACE(cast(cast(strStringToClean as nvarchar(max)) as nvarchar(max)),cast(cast( Chr(34) as nvarchar(max)) as nvarchar(max)),cast(cast( """ as nvarchar(max as nvarchar(max)))))
If InStr(1, strStringToClean, "@") > 0 Then strStringToClean = REPLACE(cast(cast(strStringToClean as nvarchar(max)) as nvarchar(max)),cast(cast( "@" as nvarchar(max)) as nvarchar(max)),cast(cast( "@" as nvarchar(max as nvarchar(max)))))
If InStr(1, strStringToClean, "|") > 0 Then strStringToClean = REPLACE(cast(cast(strStringToClean as nvarchar(max)) as nvarchar(max)),cast(cast( "|" as nvarchar(max)) as nvarchar(max)),cast(cast( "|" as nvarchar(max as nvarchar(max)))))
If InStr(1, strStringToClean, "*") > 0 Then strStringToClean = REPLACE(cast(cast(strStringToClean as nvarchar(max)) as nvarchar(max)),cast(cast( "*" as nvarchar(max)) as nvarchar(max)),cast(cast( "*" as nvarchar(max as nvarchar(max)))))
If InStr(1, strStringToClean, "--") > 0 Then strStringToClean = REPLACE(cast(cast(strStringToClean as nvarchar(max)) as nvarchar(max)),cast(cast( "--" as nvarchar(max)) as nvarchar(max)),cast(cast( "--" as nvarchar(max as nvarchar(max)))))
If InStr(1, strStringToClean, "(") > 0 Then strStringToClean = REPLACE(cast(cast(strStringToClean as nvarchar(max)) as nvarchar(max)),cast(cast( "(" as nvarchar(max)) as nvarchar(max)),cast(cast( "(" as nvarchar(max as nvarchar(max)))))
If InStr(1, strStringToClean, ")") > 0 Then strStringToClean = REPLACE(cast(cast(strStringToClean as nvarchar(max)) as nvarchar(max)),cast(cast( ")" as nvarchar(max)) as nvarchar(max)),cast(cast( ")" as nvarchar(max as nvarchar(max)))))
End If
InputCleaner = strStringToClean
End Function
'Required Value?
Private Function ReqValue(ByVal strValue)
ReqValue = True 'by default
If strValue = "" Then ReqValue = False
If IsNull(strValue) Then ReqValue = False
If Len(strValue) < = 0 Then ReqValue = False
If IsEmpty(strValue) Then ReqValue = False
End Function
'Valid Number?
Private Function validNumber(ByVal strValue)
If ReqValue(strValue) Then
validNumber = False 'Default
Set objRegExp = New RegExp
objRegExp.Pattern = "^(?:-?(?:[0-9]+.?|[0-9]*(?:.[0-9]+){1}))$"
validNumber = objRegExp.Test(strValue)
Set objRegExp = Nothing
End If
End Function
End Class
%>
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (4)
Author
Commented:Also, the performance increased to about 18% when the code was compiled into a COM Object.
Keep tuned, I have also ported this to VB.NET, and will probably be posting another article soon with the results of that code. (I have some more testing to do... trying to incorporate Linq into it =))
Commented:
Also, wouldn't looking for SQL Injection code be sufficient, such as "</", "script", "--" and their ascii counterparts in case the code has been hidden?
Author
Commented:Casting as nvarchar, yes it does double the string, but it also makes it so the code can be used internationally, and keep special characters.
Commented: