-
<%
-
‘*****************************************************************************
-
‘*****************************************************************************
-
‘
-
‘ 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 & "<br />")
-
‘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(strStringToClean, "’", "'")
-
If InStr(1, strStringToClean, Chr(34)) > 0 Then strStringToClean = Replace(strStringToClean, Chr(34), """)
-
If InStr(1, strStringToClean, "@") > 0 Then strStringToClean = Replace(strStringToClean, "@", "@")
-
If InStr(1, strStringToClean, "|") > 0 Then strStringToClean = Replace(strStringToClean, "|", "|")
-
If InStr(1, strStringToClean, "*") > 0 Then strStringToClean = Replace(strStringToClean, "*", "*")
-
If InStr(1, strStringToClean, "–") > 0 Then strStringToClean = Replace(strStringToClean, "–", "--")
-
If InStr(1, strStringToClean, "(") > 0 Then strStringToClean = Replace(strStringToClean, "(", "(")
-
If InStr(1, strStringToClean, ")") > 0 Then strStringToClean = Replace(strStringToClean, ")", ")")
-
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
-
%>