|
Utility Belt: Library
Source Code To Cut and Paste
by Charles Carroll (with some help by Jeff, Steve and Dave)
Here is the Utility Belt Library Code to cut and paste.
filename=/experiments/utilitybelt/vercurrent/utilitybelt.vb
Option Strict Off
Imports Microsoft.VisualBasic
Imports Microsoft.VisualBasic.Constants
Imports Microsoft.VisualBasic.Information
Imports System.Collections
Imports System.Collections.Specialized
Imports System.Configuration.ConfigurationSettings
Imports System.Data
Imports System.Data.OLEDB
Imports System.Data.SQLClient
Imports System.Drawing
Imports System.IO
Imports System.Net
Imports System.Reflection
Imports System.Runtime.InteropServices
Imports System.Security.Cryptography
Imports System.Text
Imports System.Text.RegularExpressions
Imports System.Threading
Imports System
Imports System.Web
Imports System.Web.Mail
Imports System.Web.UI
Imports System.Web.UI.Webcontrols
Imports System.XML
Imports System.xml.XmlNodeType
<Assembly: AssemblyVersion("0.9.8.70")>
<Assembly: AssemblyTitle("FREE Utility Belt by LearnAsp.com")>
<Assembly: AssemblyDescription("Design by Charles Carroll and Team")>
<Assembly: AssemblyCompany("Carroll Software Training (CST)")>
<Assembly: AssemblyProduct("FREE Utility Belt by LearnAsp.com")>
<Assembly: AssemblyCopyright("copyright 2002,2003,2004,2005 by Charles Mark Carroll")>
<Assembly: AssemblyTrademark("")>
<Assembly: CLSCompliant(True)>
Namespace LearnASP
Public Class UtilityBelt
' To Compile into DLL we recommend the following command line
' vbc utilitybelt.vb /r:system.dll,system.web.dll,system.data.dll,system.xml.dll,system.drawing.dll /out:utilitybelt.dll /target:library
'
Private Trace As Web.TraceContext = Web.HttpContext.Current.Trace
Private Server As Web.HttpServerUtility = Web.HttpContext.Current.Server
Private Page As Web.UI.Page = DirectCast(Web.HttpContext.Current.Handler, Web.UI.Page)
Private Cache as System.Web.Caching.Cache =System.Web.HttpContext.Current.Cache
Private Shared _AmazonLastCallTime As DateTime
Private BolAdvice_ As Boolean = False
Private BolHints_ As Boolean = False
Public SCC_Format As String = "default"
Public SCC_LineCounter As Integer = 0
Public SCC_LineNumbers As Boolean = False
Public SCC_SrcSettings As NameValueCollection
Private _strAmazonLocale As String = ""
Private bolCache_ As Boolean
Private bolEmailIsWorking_ as boolean=false
Private bolErrEmail_ As Boolean
Private bolErrFriendly_ As Boolean
Private bolErrHide_ As Boolean
Private bolErrIgnoreNext_ As Boolean
Private bolErrNullNestedIgnore_ As Boolean
Private bolErrRaw_ As Boolean
Private bolErrThrowBack_ As Boolean
Private bolErrorDetails_ As Boolean
Private bolHTMLencode_ As Boolean
Private bolLogCacheHitMiss_ As Boolean
Private bolLogDbg_ As Boolean
Private bolLogSQLShow_ As Boolean
Private bolLogSQLreturn_ As Boolean
Private bolLogSensitive_ As Boolean
Private bolLogUBFlow_ As Boolean
Private bolLogWarning_ As Boolean
Private bolMessages_ = True
Private bolSimpleTrace_ As Boolean
Private bolSuperTraceToTraceStream_ As Boolean
Private bolSuperTrace_ As Boolean
Private bolXrayOn_ As Boolean
Private bolXrayToPage_ As Boolean
Private dsXray As DataSet
Private errorCountGlobal_ As Integer
Private errorCount_ As Integer
Private errorOccuredGlobal_ As Boolean
Private errorOccured_ As Boolean
Private intCacheMinutes_ As Integer
Private intCacheSeconds_ As Integer
Private intHintNumber As Integer
Private intReaderUnClosedCount As Integer
Private objNull_ As String
Private plcException_ As PlaceHolder
Private plcXray_ As PlaceHolder
Private strAmazonDevToken_ As String
Private strAmazonPromoCode_ As String
Private strErrMessage_ As String
Private strLogFileName_ As String
Private strMailErrorSubject_ As String
Private strMailErrorsTo_ As String
Private strMailSmtpServer_ As String
private strSimpleTrace_ as string=""
Private strSuperTraceHide_ As String
Private strSuperTraceShow_ As String
Private strVersion As String
Private intLockedFileSleepDuration As Integer = 20 ' 1/500
Private intLockedFileAttempts As Integer
Private intLockedFileAttemptsMax As Integer = 1
Public Property strAmazonLocale() As String
Get
Return _strAmazonLocale
End Get
Set(ByVal Value As String)
Select Case Value.ToLower
Case "", "uk"
_strAmazonLocale = Value.ToLower
Case Else
LogHint("strAmazonLocale", "Locale can only be empty [""""] or ""uk"" ")
End Select
End Set
End Property
Private _boolAmazon1RequestPerSecond As Boolean = True
Public Property boolAmazon1RequestPerSecond() As Boolean
Get
Return _boolAmazon1RequestPerSecond
End Get
Set(ByVal Value As Boolean)
_boolAmazon1RequestPerSecond = Value
End Set
End Property
Private Property bolCache() As Boolean
Get
bolCache = bolCache_
End Get
Set(ByVal v As Boolean)
bolCache_ = v
End Set
End Property
Public Property intCacheSeconds() As Integer
Get
intCacheSeconds = intCacheSeconds_
End Get
Set(ByVal v As Integer)
intCacheSeconds_ = v
End Set
End Property
Public Property intCacheMinutes() As Integer
Get
intCacheMinutes = intCacheMinutes_
End Get
Set(ByVal v As Integer)
intCacheMinutes_ = v
End Set
End Property
ReadOnly Property errorCount() As Integer
Get
errorCount = errorCount_
End Get
End Property
ReadOnly Property errorCountGlobal() As Integer
Get
errorCountGlobal = errorCountGlobal_
End Get
End Property
ReadOnly Property errorOccured() As Boolean
Get
errorOccured = errorOccured_
End Get
End Property
ReadOnly Property errorOccuredGlobal() As Boolean
Get
errorOccuredGlobal = errorOccuredGlobal_
End Get
End Property
Public Property plcXray() As PlaceHolder
Get
If plcXray_ Is Nothing Then
Dim Page1 As System.Web.UI.Page = System.Web.HttpContext.Current.Handler
Dim plcEndOfPage As New PlaceHolder
Page1.Controls.Add(plcEndOfPage)
plcXray_ = plcEndOfPage
plcXray = plcXray_
Else
plcXray = plcXray_
End If
End Get
Set(ByVal v As PlaceHolder)
plcXray_ = v
bolXrayToPage_ = True
End Set
End Property
Public Property plcException() As PlaceHolder
Get
If plcException Is Nothing Then
' If they did not specify a placeholder then add one to end of page
Dim Page1 As System.Web.UI.Page = System.Web.HttpContext.Current.Handler
Dim plcEndOfPage As New PlaceHolder
Page1.Controls.Add(plcEndOfPage)
plcException_ = plcEndOfPage
plcException = plcException_
Else
plcException = plcException_
End If
End Get
Set(ByVal v As PlaceHolder)
plcException_ = v
End Set
End Property
Private Property strAmazonDevToken() As String
Get
strAmazonDevToken = strAmazonDevToken_
End Get
Set(ByVal v As String)
strAmazonDevToken_ = v
If v = "D1967KF255R5KZ" Then
Dim strSiteHost As String = System.Web.HttpContext.Current.Request.Url.Host.ToLower()
If strSiteHost.IndexOf("learnasp") < 0 Then
LogHint("Not Your Amazon DevKey", "Amazon Devkey you used belongs to learnasp.com! Get your own @ <a href='http://www.amazon.com/gp/browse.html/ref=mm_ws_?node=3435361'>http://www.amazon.com/gp/browse.html/ref=mm_ws_?node=3435361</a>!")
End If
End If
End Set
End Property
Private Property strAmazonPromoCode() As String
Get
strAmazonPromoCode = strAmazonPromoCode_
End Get
Set(ByVal v As String)
strAmazonPromoCode_ = v
End Set
End Property
Private Property strErrMessage() As String
Get
strErrMessage = strErrMessage_
End Get
Set(ByVal v As String)
strErrMessage_ = v
End Set
End Property
Private Property strMailSmtpServer() As String
Get
strMailSmtpServer = strMailSmtpServer_
End Get
Set(ByVal v As String)
strMailSmtpServer_ = v
End Set
End Property
Public Property strSuperTraceHide() As String
Get
strSuperTraceHide = strSuperTraceHide_
End Get
Set(ByVal v As String)
strSuperTraceHide_ = v
End Set
End Property
Public Property strSuperTraceShow() As String
Get
strSuperTraceShow = strSuperTraceShow_
End Get
Set(ByVal v As String)
strSuperTraceShow_ = v
End Set
End Property
Public Property objNull() As Object
Get
objNull = objNull_
End Get
Set(ByVal v As Object)
objNull_ = v
End Set
End Property
Public Sub New()
CheckPage()
dsXray = XrayDataSetCreate()
ConfigDefaults()
ConfigRead()
strVersion = System.Reflection.Assembly.GetExecutingAssembly().GetName().Version.ToString()
Trace.Write("Utility Belt version #", strVersion)
Trace.Write("Utility Belt authors", [Assembly].GetExecutingAssembly.GetCustomAttributes(GetType(AssemblyDescriptionAttribute), False)(0).Description)
End Sub
Private Sub Page_PreRender(ByVal Sender As Object, ByVal E As EventArgs)
dim strTask as string="Page_PreRender"
'Try
DisplayLog()
RemoveHandler Page.PreRender, AddressOf Page_PreRender
' Catch exc1 As Exception
' LogException(strTask,exc1)
'End Try
End Sub
Private Sub CheckPage()
If Page Is Nothing AndAlso Not HttpContext.Current.Handler Is Nothing Then
Page = HttpContext.Current.Handler
AddHandler Page.PreRender, AddressOf Page_PreRender
End If
End Sub
Sub Dispose()
logWarning("Dispose", "Dispose is no longer needed")
End Sub
Private Sub AAATemplate()
' DIM everything that needs to be seen by CATCH or FINALLY block
Dim strTask As String = "SUB AAATemplate"
Try
LogTaskStart(strTask)
' LogTaskEndPremature(strTask,"reason for quitting early")
' LogFlow(strTask,"some branch people want to know about with UBFlowon")
' LogDebugData(strTask,"varname=" & varname)
' LogWarning(strTask,"some high level warning for the developer")
LogTaskEnd(strTask)
Catch ex1 As Exception
LogException(strTask, ex1) ' Used for most exceptions
Finally
' Release(Conn1)
' Release(Conn1)
' Release(stream1)
' Release(Rdr1)
' Release(Rdr1)
End Try
End Sub
Private Function appkey(ByVal strParm As String) As String
' TODO in case of SQLserver use {Application Name}=HttpContext.Current.Request.FilePath
Dim strTempReturn As String=""
Dim strTask As String = "appkey"
LogTaskParms(strTask,"strParm",strParm)
Try
strTempReturn = AppSettings(strParm)
If strTempReturn = "" Then
LogHint(strTask, "<b>" & strParm & "</b> => No App Key or AppKey Value is blank")
End If
Catch ex1 As Exception
LogException(strTask, ex1)
Finally
End Try
Return LogReturn(strTask,strTempReturn)
End Function
Sub Array1dRandomize(ByRef arryP1 As String(), ByVal intP2Shufflecount As Integer)
Dim strTask As String = "SUB Array1dRandomize"
LogTaskStart(strTask)
Dim tempobj As Object
tempobj = arryP1
Array1dRandomize(tempobj, intP2Shufflecount)
LogTaskEnd(strTask)
End Sub
Sub Array1dRandomize(ByRef arryP1 As Object, ByVal intP2Shufflecount As Integer)
' 1st parameter as array C# hated that
' as string() C# hated that
' Re-arrange a 1dArray. The 2nd parameter determines how many passes through the array are done
' can't be shared AND have Error Trapping
' Cannot refer to an instance member of a class from within a shared method or shared member initializer
' without an explicit instance of the class.
Dim strTask As String = "SUB Array1dRandomize"
Try
LogTaskStart(strTask)
If arryP1 Is Nothing Then
LogHint(strTask, "Array is Nothing, Can't be re-arranged")
LogTaskEnd(strTask)
Exit Sub
End If
If arryP1.GetupperBound(0) = 0 Then
LogHint(strTask, "Array has zero elements, Can't be re-arranged")
LogTaskEnd(strTask)
Exit Sub
End If
Dim Random1 As New Random
Dim intRandomNum As Integer
Dim intMaxArraySize As Integer = arryP1.GetupperBound(0)
Dim intMaxShuffleCount As Integer = intMaxArraySize * intP2Shufflecount
Dim strSwap1, strSwap2 As String
Dim intShuffleCounter As Integer
For intShuffleCounter = 0 To intMaxShuffleCount
intRandomNum = Random1.Next(intMaxArraySize)
strSwap1 = arryP1(intRandomNum)
strSwap2 = arryP1(intMaxArraySize - 1)
arryP1(intRandomNum) = strSwap2
arryP1(intMaxArraySize - 1) = strSwap1
Next
LogTaskEnd(strTask)
Catch ex1 As Exception
LogException(strTask, ex1)
Finally
End Try
End Sub
Private Sub ArrayFromDatatable(ByRef pArray As Array, ByVal dt1 As DataTable)
Dim strTask As String = "ArrayFromDataTable - datatable + array = parameters"
Try
If TypeName(dt1) = "Nothing" Then
LogHint(strTask, "DataTable is Empty, Can't be made into array")
LogTaskEnd(strTask)
Exit Sub
End If
Dim intArraycounterMax As Integer = dt1.Rows.Count - 1
Dim intFieldcounterMax As Integer = dt1.Columns.Count - 1
Dim intFieldcounter As Integer
Dim thearray(intArraycounterMax, intFieldcounterMax) As String
Dim thearray1d(intArraycounterMax) As String
Dim intarraycounter As Integer = 0
Dim datarow1 As DataRow
If intFieldcounterMax = 0 Then
For Each datarow1 In dt1.Rows
Try
' LogDebugData(strtask,"intArrayCounter=" & intArrayCounter)
thearray1d(intarraycounter) = datarow1(intFieldcounter)
Catch ex1 As InvalidCastException
' Nothing to do Nulls are ok
Catch ex1 As Exception
logWarning(strTask, "nulldata r:" & intarraycounter)
Finally
End Try
intarraycounter += 1
Next
Else
For Each datarow1 In dt1.Rows
For intFieldcounter = 0 To intFieldcounterMax
Try
' LogDebugData(strtask,"intArrayCounter=" & intArrayCounter)
thearray(intarraycounter, intFieldcounter) = datarow1(intFieldcounter)
Catch ex1 As InvalidCastException
' Nothing to do Nulls are ok
Catch ex1 As Exception
logWarning(strTask, "nulldata r:" & intarraycounter & " c:" & intFieldcounter)
Finally
End Try
Next
intarraycounter += 1
Next
End If
If intFieldcounterMax = 0 Then
pArray = thearray1d
Else
pArray = thearray
End If
LogTaskEnd(strTask)
Catch ex1 As Exception
LogException(strTask, ex1)
Finally
End Try
End Sub
Private Sub arrayFromDataTable(ByVal strConn As String, _
ByVal strSQL As String, ByRef parray As Object)
Dim strTask As String = "SUB ArrayFromDataTable"
LogTaskStart(strTask)
LogTaskParms(strTask,"strConn", strConn,"strSQL", strSQL,"parray", pArray)
Dim dt1 As New DataTable
Select Case DBAnalyzeConn(strConn)
Case "sqlserver"
dt1 = DataTableGetSQLClient(strConn, strSQL)
Case "oledb"
dt1 = DataTableGetOLEDB(strConn, strSQL)
End Select
ArrayFromDatatable(parray, dt1)
End Sub
Private Sub arrayFromDataTable(ByVal strConn As String, ByVal strSQL As String, _
ByRef htParm As Hashtable, ByRef parray As Object)
'-- Added by Paul Brophy 31Mar03
Dim strTask As String = "SUB ArrayFromDataTable"
LogTaskStart(strTask)
logTaskParms(strTask, "strConn", strConn,"strSQL", strSQL, "htParm", htParm,"parray", pArray)
Select Case DBAnalyzeConn(strConn)
Case "sqlserver"
SPSQLServer_arrayFromDataTable(parray, strConn, htParm, strSQL)
Case Else
LogException(strTask, DBAnalyzeConn(strConn) & " not yet implemented")
End Select
LogTaskEnd(strTask)
End Sub
Private sub ConfigDefaults()
DIM strIndent as string="&npsp; "
Trace.IsEnabled = False
bolCache_ = False
intCacheSeconds_ = 600
intCacheMinutes_ = 10
bolSuperTrace_ = False
bolSuperTraceToTraceStream_ = False
bolErrorDetails_ = False
bolErrIgnoreNext_ = False
bolErrNullNestedIgnore_ = False
bolErrThrowBack_ = False
errorCount_ = 0
bolLogSQLShow_ = False
bolLogSQLreturn_ = False
bolLogUBFlow_ = False
bolLogDbg_ = False
bolLogSensitive_ = False
bolLogCacheHitMiss_ = False
bolXrayOn_ = True
bolXrayToPage_ = False
strSuperTraceHide_ = ""
strSuperTraceShow_ = ""
strMailSmtpServer_ = "localhost"
objNull_ = "-null-"
strMailErrorsTo_ = ""
Dim sbTemp As New StringBuilder
With sbTemp
.Append("<table width='100%' bgcolor='#CCE6FF' gridlines='all' border='2' bordercolor='#FFCCFF' cellpadding='2'><tr><td>")
.Append("<font face='verdana' size='1'><h3><a href='http://www.learnasp.com/ub'>")
.Append("ASP.net Utility Belt FREE Library</a> ")
.Append(strVersion)
.Append("<br>coded by ")
.Append("<a href='http://www.learnasp.com/freebook/learn/utilitybelt_credits.aspx'>")
.Append("Charles Carroll and Team</a> ")
.Append("</h3>")
.Append(strIndent)
.Append("<font size='+1'><font color='red'><b>An error occured and was logged.</b>")
.Append("<br>")
.Append(strIndent)
.Append(strMailErrorsTo_)
.Append(" has been notified by email</font><br><br>")
.Append("<font size='-1'>Note To Programmer:<br>")
.Append(strIndent)
.Append("Custom errors, use <b><StrErrorMessage>Your Message</StrErrorMessage></b> in utilitybelt.config<br>")
.Append(strIndent)
.Append("<a href='http://www.learnasp.com/freebook/learn/utilitybelt_errorhandling.aspx'>")
.Append("Additional Error-Handling Documentation Here</a><br>")
.Append(strIndent)
.Append("use <b>Options(""Debug-on"")</b> to see detailed error messages<br>")
.Append(strIndent)
.Append("<a href='http://groups.yahoo.com/group/AspNetUtilityBelt'>")
.Append("Programmer Technical Support Here</a></font>")
.Append("</font></td></tr></table><br>")
End With
strErrMessage_ = sbTemp.ToString()
end sub
Private Sub ConfigRead()
Dim Xmltr1 As XmlTextReader
Dim strTask As String = "SUB ConfigRead"
Try
LogTaskStart(strTask)
Dim strFileName As String
ErrorReset()
strFileName = FileMapIfNeeded("utilitybelt.config", strTask)
If File.Exists(strFileName) = False Then
ErrorReset()
strFileName = FileMapIfNeeded("\utilitybelt.config", strTask)
Else
LogFlow("Config File Found",strFileName)
End If
If errorCount = 1 Then
LogAdviceUtilityBeltConfigNotFound(strTask, strFileName)
LogTaskEnd(strTask)
Exit Sub
End If
Xmltr1 = New XmlTextReader(strFileName)
objectCreateTrack(strTask,XmlTr1)
Do While Xmltr1.Read()
If Xmltr1.NodeType = Element Then
Dim strElementName As String = Xmltr1.Name
Select Case strElementName
Case "ub"
' nothing to do all is well
Case "amazonpromocode"
Xmltr1.Read()
strAmazonPromoCode_ = Xmltr1.Value
Case "amazondevtoken"
Xmltr1.Read()
strAmazonDevToken_ = Xmltr1.Value
Case "strErrorMessage"
Xmltr1.Read()
strErrMessage_ = Xmltr1.Value
Case "strLogFilename"
Xmltr1.Read()
strLogFileName_ = Xmltr1.Value
Case "strMailErrorsTo"
Xmltr1.Read()
strMailErrorsTo_ = Xmltr1.Value
Case "strMailErrorSubject"
Xmltr1.Read()
strMailErrorSubject_ = Xmltr1.Value
Case "strMailSMTPServer"
Xmltr1.Read()
strMailSmtpServer = Xmltr1.Value
Trace.Write("strMailSMTPServer", strMailSmtpServer)
case "supertrace"
Xmltr1.Read()
dim strGlobalSuperTrace as string=Xmltr1.Value
strGlobalSuperTrace = strGlobalSuperTrace.ToLower
If ConvertStringToBoolean(strGlobalSuperTrace)
bolSuperTrace_=true
End If
Case Else
Xmltr1.Read()
Dim strTemp As String = Xmltr1.Value
LogAdviceConfigUnknownElement(strTask, strElementName, strTemp)
End Select
End If
Loop
LogTaskEnd(strTask)
Catch ex1 As Exception
LogException(strTask, ex1)
Finally
Release(Xmltr1)
End Try
End Sub
Function ConvertStringToBoolean (parmStrToConv as string) as boolean
dim strTemp as string
strTemp=parmStrToConv.ToLower()
If strTemp="on" OR strTemp="y" OR strTemp="yes" THEN
return(true)
Else
return(false)
end if
end function
Private Function ConvertStr2ByteArray(ByVal strInput As String) As Byte()
' Thanks to Steve Walther ASP.net Unleashed book
' http://www.amazon.com/exec/obidos/ISBN=0672320681/learnasp
' Need To Deal with Unicode in Next Version
' dave 123aspx: hmmm... i think there is a small error in the Convert2ByteArray() function
' Chaz - No Myth: go
' dave 123aspx: hang on.. still thinking out loud
' Chaz - No Myth: It came from Steve Walther's book
' dave 123aspx: hmmm... i ran into something likethis before... not all char consist of only 1 byte
' Chaz - No Myth: Unicode chars are 2 bytes for example sometimes more.
' dave 123aspx: and you can loose characters when you try to convert a multibyte char to a single byte
' dave 123aspx: use the Encoding.GetBytes() method
' dave 123aspx: much cleaner
Dim strTask As String = "ConvertStr2ByteArray"
LogTaskParms(strTask,"strInput",strInput)
Try
LogTaskStart(strTask)
Dim intCounter As Integer
Dim arrChar As Char()
'LogDebugData(strTask, "Convert2ByteArray" & strInput)
arrChar = strInput.ToCharArray()
Dim arrByte(arrChar.Length - 1) As Byte
' LogDebugData(strTask,"byte length=" & arrByte.Length)
For intCounter = 0 To arrByte.Length - 1
' LogDebugData(strTask,intCounter & " => " & arrChar(intCounter) )
arrByte(intCounter) = Convert.ToByte(arrChar(intCounter))
Next
Return (LogReturn(strTask,arrByte))
Catch ex1 As Exception
LogException(strTask, ex1)
Finally
End Try
End Function
Function ConvertStr2MD5checksum(ByVal strParm1 As String) As String
' Thanks to Jeff SchoolCraft For This Code
' Description: strings cannot easily be used as names for say caches or other programming elements
' without escaping certain letters and punctuation. For example the string:
' select * from publishers WHERE state='CA'
' PROVIDER=Microsoft.Jet.OLEDB.4.0;DATA SOURCE=D:\domains\stage.learnasp.com\experiments\data\biblio.mdb;
' would not be an acceptable cache name because it has characters that would be illegal in variable names
' and is too long as well. The MD5 Checksum representation would be an acceptable variable name, i.e
' 03-7E-5E-F3-62-25-CF-52-BE-9A-A7-4F-58-7E-07
Dim strTask As String = "ConvertStr2MD5checksum"
LogTaskParms(strTask,"strParm1",strParm1)
Try
LogTaskStart(strTask)
Dim arrHashInput As Byte()
Dim arrHashOutput As Byte()
Dim objMD5 As MD5CryptoServiceProvider
objMD5 = New MD5CryptoServiceProvider
arrHashInput = ConvertStr2ByteArray(strParm1)
arrHashOutput = objMD5.ComputeHash(arrHashInput)
Dim strChecksum As String = BitConverter.ToString(arrHashOutput)
' LogDebugData(strtask,"strParm1=" & strParm1)
' LogDebugData(strtask,"strChecksum=" & strChecksum)
LogTaskEnd(strTask)
Return (LogReturn(strTask,strChecksum))
Catch ex1 As Exception
LogException("ConvertStr2MD5checksum", ex1)
Finally
End Try
End Function
Shared Sub CtrlDropdownSelect(ByRef drpP1 As DropDownList, ByVal strP2 As String)
drpP1.SelectedIndex = drpP1.Items.IndexOf(drpP1.Items.FindByValue(strP2))
End Sub
Shared Sub CtrlListBoxSelect(ByRef lstP1 As ListBox, ByVal strP2 As String)
lstP1.Items.FindByValue(strP2).Selected = True
End Sub
Private Sub CtrlFindAndAdd(ByVal strControlName As String, ByVal objParm As Object)
' Not working, Not Final yet
Dim whatever As Control
'whatever=Page.findcontrol(strControlName)
Dim strTypenameOfFind As String = TypeName(whatever)
If strTypenameOfFind = "Nothing" Then
Trace.Warn("Sub ControlFindAndAdd", "Can't Find Control id=" & strControlName)
Else
whatever.Controls.Add(objParm)
End If
End Sub
Private Function DataTableGet(ByVal strConn As String, ByVal strSQL As String) As DataTable
Dim strTask As String = "DataTableGet"
LogTaskStart(strTask)
logTaskParms(strTask, "strConn", strConn,"strSQL", strSQL)
Select Case DBAnalyzeConn(strConn)
Case "sqlserver"
LogTaskEnd(strTask)
Return (DataTableGetSQLClient(strConn, strSQL))
Case "oledb"
LogTaskEnd(strTask)
Return (DataTableGetOLEDB(strConn, strSQL))
End Select
End Function
Private Function DataTableGet(ByVal strConn As String, ByVal strSQL As String, ByRef ht As Hashtable) As DataTable
'-- Added by Paul Brophy 31Mar03
Dim strTask As String = "DataTableGet"
LogTaskStart(strTask)
logTaskParms(strTask, "strConn", strConn,"strSQL", strSQL,"ht", ht)
Select Case DBAnalyzeConn(strConn)
Case "sqlserver"
LogTaskEnd(strTask)
Return LogReturn(strTask,SPSQLServer_DataTableGet(strConn, strSQL, ht))
Case Else
Throw New EntryPointNotFoundException(strTask & "::" & DBAnalyzeConn(strConn) & " not implemented")
End Select
End Function
Private Function DataTableGetOLEDB(ByVal strConn As String, ByVal strSQL As String) As DataTable
Dim strTask As String = "DataTableGetOLEDB"
LogTaskStart(strTask)
logTaskParms(strTask, "strConn", strConn,"strSQL", strSQL)
If bolCache_ Then
LogTaskEnd(strTask)
Return LogReturn(strTask,DataTableGetOLEDBCached(strConn, strSQL, intCacheMinutes_))
Else
LogTaskEnd(strTask)
Return LogReturn(strTask,DataTableGetOLEDBCachedNot(strConn, strSQL))
End If
End Function
Private Function DataTableGetOLEDBCached(ByVal strConn As String, ByVal strSQL As String, ByVal intMinutes As Integer) As DataTable
Dim strTask As String = "DataTableGetOLEDBCached"
Try
LogTaskStart(strTask)
logTaskParms(strTask, "strConn", strConn,"strSQL", strSQL,"intMinutes", intMinutes)
Dim strChksum As String
strChksum = ConvertStr2MD5checksum(strSQL & System.Environment.NewLine & strConn)
Dim dt1 As DataTable
If System.Web.HttpContext.Current.Cache(strChksum) Is Nothing Then
LogCache(strTask, "Adding To Cache")
dt1 = DataTableGetOLEDBCachedNot(strConn, strSQL)
System.Web.HttpContext.Current.Cache.Insert(strChksum, dt1, Nothing, DateTime.Now.AddMinutes(intMinutes), System.Web.HttpContext.Current.Cache.NoSlidingExpiration)
ObjectCreateTrack(strTask,cache(strChkSum))
Else
LogCache(strTask, "Using From Cache")
dt1 = System.Web.HttpContext.Current.Cache(strChksum)
End If
LogTaskEnd(strTask)
Return dt1
Catch ArgumentNullException As Exception
Dim strDiagnosis As String = "Tried to Cache Null Data, Maybe earlier failed database connection!"
LogException(strTask, ArgumentNullException)
Catch ex1 As Exception
LogException(strTask, ex1)
Finally
End Try
End Function
Private Function DataTableGetOLEDBCachedNot(ByVal strConn As String, ByVal strSQL As String) As DataTable
Dim strTask As String = "DataTableGetOLEDBCachedNot"
Try
LogTaskStart(strTask)
logTaskParms(strTask, "strConn", strConn,"strSQL", strSQL)
Dim dt1 As New DataTable
Dim conn As New OleDbConnection(strConn)
Dim adapter As New OleDbDataAdapter(strSQL, conn)
adapter.Fill(dt1)
' LogDebugData(strTask,"DataTable Row Count=" & dt1.rows.count)
LogTaskEnd(strTask)
Return (dt1)
Catch OleDbException As Exception
If OleDbException.Message.IndexOf("is not a valid path") > -1 Then
LogException(strTask, OleDbException)
End If
Catch ex1 As Exception
LogException(strTask, ex1)
Finally
End Try
End Function
Private Function DataTableGetSQLClient(ByVal strConn As String, ByVal strSQL As String) As DataTable
Dim strTask As String = "DataTableGetSQLClient"
LogTaskStart(strTask)
logTaskParms(strTask, "strConn", strConn,"strSQL", strSQL)
If bolCache_ Then
LogTaskEnd(strTask)
Return DataTableGetSQLClientCached(strConn, strSQL, intCacheMinutes_)
Else
LogTaskEnd(strTask)
Return DataTableGetSQLClientCachedNot(strConn, strSQL)
End If
End Function
Private Function DataTableGetSQLClientCached(ByVal strConn As String, ByVal strSQL As String, ByVal intMinutes As Integer) As DataTable
Dim strTask As String = "DataTableGetSQLClientCached"
Try
LogTaskStart(strTask)
logTaskParms(strTask, "strConn", strConn,"strSQL", strSQL)
Dim strChksum As String
strChksum = ConvertStr2MD5checksum(strConn & ";" & strSQL)
Dim dt1 As DataTable
' LogDebugData(strTask,"strChksum=" & strChkSum)
If System.Web.HttpContext.Current.Cache(strChksum) Is Nothing Then
LogCache(strTask, "Adding To Cache")
dt1 = DataTableGetSQLClientCachedNot(strConn, strSQL)
System.Web.HttpContext.Current.Cache.Insert(strChksum, dt1, Nothing, DateTime.Now.AddMinutes(intMinutes), System.Web.HttpContext.Current.Cache.NoSlidingExpiration)
ObjectCreateTrack(strTask,cache(strChkSum))
Else
LogCache(strTask, "Using From Cache")
dt1 = System.Web.HttpContext.Current.Cache(strChksum)
End If
LogTaskEnd(strTask)
Return dt1
Catch ex1 As Exception
' ToDo Deal with Cache Exceptions
LogException(strTask, ex1)
Finally
End Try
End Function
Private Function DataTableGetSQLClientCachedNot(ByVal strConn As String, ByVal strSQL As String) As DataTable
Dim strTask As String = "DataTableGetSQLClientCachedNot"
Try
LogTaskStart(strTask)
LogTaskParms(strTask, "strConn", strConn,"strSQL", strSQL)
Dim dt1 As New DataTable("temp")
Dim conn As New SqlConnection(strConn)
LogTaskSQL(strTask, strSQL)
Dim adapter As New SqlDataAdapter(strSQL, conn)
adapter.Fill(dt1)
LogTaskEnd(strTask)
Return dt1
Catch ex1 As Exception
LogException(strTask, ex1)
Finally
' TODO: should I be disposing of resources here?
End Try
End Function
Private Function DBAccess2Oledb(ByVal strAccessFileName As String) As String
Return ("PROVIDER=Microsoft.Jet.OLEDB.4.0;DATA SOURCE=" & FileMapIfNeeded(strAccessFileName, "DBAccess2Oledb"))
End Function
Private Function DBAnalyzeConn(ByRef strParmConn As String) As String
' altered 16 nov 2003: inclusion of other SQL server connection string format
Dim strTempConn As String
Dim bolSQLserver As Boolean
Dim strTask As String = "DBAnalyzeConn"
LogTaskParms(strTask,"strParmConn",strParmConn)
Try
Dim bolappKeyFound As Boolean = False
strTempConn = strParmConn.ToLower()
If strTempConn.IndexOf("server=") > -1 Then bolSQLserver = True
If strTempConn.IndexOf("initial catalog=") > -1 Then bolSQLserver = True
' check for valid sqlserver
If Not (bolSQLserver) Then
' check for path if not a sqlserver conn string
Dim intProviderFound = strTempConn.IndexOf ("provider=")
Dim intSlashFound = strTempConn.IndexOf("\")
Dim intBackSlashFound = strTempConn.IndexOf("/")
Dim intPeriodFound = strTempConn.IndexOf(".")
Dim intFoundTotal As Integer = intProviderFound + intSlashFound + intBackSlashFound + intPeriodFound
' its an appkey go fetch
If intFoundTotal = -4 Then
logTask(strTask, "detected appkey connect string")
bolappKeyFound = True
strParmConn = appkey(strParmConn)
strTempConn = strParmConn.ToLower()
' check again for SQL server string
If strTempConn.IndexOf("server=") > -1 Then bolSQLserver = True
If strTempConn.IndexOf("initial catalog=") > -1 Then bolSQLserver = True
End If
End If
If bolSQLserver Then
logTask(strTask, "detected SQLserver connect string")
If bolappKeyFound = False Then
LogAdviceHardCodedConnectString(strTask, strParmConn)
End If
LogTaskEnd(strTask)
Return LogReturn(strTask,"sqlserver")
Else
' Is this check needed ??? ( .asp rename trick for .mdb )
If strTempConn.IndexOf(".mdb") <> -1 Then
logTask(strTask, "detected Access connect string")
If bolappKeyFound = False Then
LogAdviceHardCodedConnectString(strTask, strParmConn)
End If
' this seems to be the correct one
If strTempConn.IndexOf ("provider=microsoft.jet.oledb.4.0") = -1 Then
logTask(strTask, "detected Access filename without connect string")
strParmConn = DBAccess2Oledb(strParmConn)
End If
End If
LogTaskEnd(strTask)
Return LogReturn (strTask,"oledb")
End If
Catch ex1 As Exception
LogException(strTask, ex1)
Finally
End Try
End Function
Sub DBExec(ByVal strConn As String, ByVal strSQL As String)
Dim strTask As String = "DBExec"
LogTaskStart(strTask)
Select Case DBAnalyzeConn(strConn)
Case "sqlserver"
DBExecSQLClient(strConn, strSQL)
Case "oledb"
DBExecOLEDB(strConn, strSQL)
End Select
LogTaskEnd(strTask)
End Sub
Function DBExec(ByVal strConn As String, ByVal strSQL As String, ByRef htParms As Hashtable) As Integer
'-- Added by Paul Brophy, 31Mar03
Dim strTask As String = "DBExec hashtable"
logTaskParms(strTask, "strConn", strConn,"strSQL", strSQL, "htParms", htParms)
Dim intret As Integer = 0
LogTaskStart(strTask)
Select Case DBAnalyzeConn(strConn)
Case "sqlserver"
intret = SPSQLServer_DBExec(strConn, strSQL, htParms)
Case Else
Throw New EntryPointNotFoundException(strTask & "::" & DBAnalyzeConn(strConn) & " is not implemented")
End Select
LogTaskEnd(strTask)
Return intret
End Function
Private Sub DBExecOLEDB(ByVal strConn As String, ByVal strSQL As String)
Dim strTask As String = "DBExecOLEDB"
logTaskParms(strTask, "strConn", strConn,"strSQL", strSQL)
Dim Conn1 As OleDbConnection
Dim Cmd1 As OleDbCommand
Dim intReturn As Integer
Try
LogTaskStart(strTask)
LogTaskSQL(strTask, strSQL)
Conn1 = New OleDbConnection(strConn)
Cmd1 = New OleDbCommand(strSQL, Conn1)
Conn1.Open()
intReturn = Cmd1.ExecuteNonQuery()
logSQLReturn(strTask, intReturn, "intReturn")
LogTaskEnd(strTask)
Catch ex1 As Exception
LogException(strTask, ex1)
Finally
Release(Conn1)
End Try
End Sub
Private Sub DBExecSQLClient(ByVal strConn As String, ByVal strSQL As String)
Dim strTask As String = "SUB DBExecSQLClient"
logTaskParms(strTask, "strConn", strConn,"strSQL", strSQL)
Dim Conn1 As SqlConnection
Dim Cmd1 As SqlCommand
Dim intReturn As Integer
Try
LogTaskStart(strTask)
logParm(strTask, strConn, "strConn")
logParm(strTask, strSQL, "strSQL")
Conn1 = New SqlConnection(strConn)
Cmd1 = New SqlCommand(strSQL, Conn1)
Conn1.Open()
intReturn = Cmd1.ExecuteNonQuery()
logSQLReturn(strTask, intReturn, "intReturn")
Catch ex1 As Exception
LogException(strTask, ex1)
Finally
Release(Conn1)
End Try
End Sub
Sub DBPopulate(ByVal strConn As String, ByVal strSQL As String, ByRef arrDB As Array)
Dim strTask As String = "SUB DBPopulate / array = 3rd parm"
LogTaskStart(strTask)
LogAdviceAdHocSQL(strTask, strSQL)
ArrayFromDatatable(strConn, strSQL, arrDB)
LogTaskEnd(strTask)
End Sub
Sub DBPopulate(ByVal strConn As String, ByVal strSQL As String, ByRef string1 As String)
' The problem is that Strings are not byref in DBpopulate anymore
Dim strTask As String = "DBPopulate / string as 3rd parameter"
LogAdviceAdHocSQL(strTask, strSQL)
string1 = DBScalar(strConn, strSQL)
End Sub
Sub DBPopulate(ByVal strConn As String, ByVal strSQL As String, ByRef int1 As Integer)
' The problem is that Strings are not byref in DBpopulate anymore
Dim strTask As String = "DBPopulate / int as 3rd parameter"
LogAdviceAdHocSQL(strTask, strSQL)
int1 = DBScalar(strConn, strSQL)
End Sub
Sub DBPopulate(ByVal strConn As String, ByVal strSQL As String, ByRef objParm As Object)
' used to be SUB DBPopulate(strConn as string,strSQL as string,byref objParm as object)
' C# does not like byref on 3rd parameter
' because it can't convert anything to object byref
Dim strTypeName As String = TypeName(objParm).ToLower()
Dim strTask As String = "DBPopulate w/3 Params; (3rd Param obj type=" & strTypeName & ")"
LogTaskStart(strTask)
LogTaskParms(strTask, "strConn", strConn,"strSQL", strSQL,"objParm", objparm)
Try
LogAdviceAdHocSQL(strTask, strSQL)
If TypeOf (objParm) Is Control Then
Select Case strTypeName
Case "literal"
Dim litTemp As Literal
litTemp = objParm
litTemp.Text = DBScalar(strConn, strSQL)
Case "textbox"
Dim txtTemp As TextBox
txtTemp = objParm
txtTemp.text = DBScalar(strConn, strSQL)
Case Else
Trace.Warn ("DbPopulate",strTypeName)
DBPopulate_Control(strConn, strSQL, objParm)
End Select
Exit Sub
End If
Select Case strTypeName
Case "datatable"
objParm = DataTableGet(strConn, strSQL)
logWarning(strTask, "datatable rowcount=" & objParm.rows.count)
Case "dataview"
Dim dtTemp As New DataTable
dtTemp = DataTableGet(strConn, strSQL)
Dim dv1 As New System.data.DataView(dtTemp)
objParm = dv1
Case "textbox"
Dim txtTemp As TextBox
txtTemp = objParm
txtTemp.text = DBScalar(strConn, strSQL)
txtTemp = objParm
objParm.text = DBScalar(strConn, strSQL)
Case "string()", "string(,)"
ArrayFromDatatable(strConn, strSQL, objParm)
Case "nothing" '
ArrayFromDatatable(strConn, strSQL, objParm)
Case Else
Trace.Warn ("DbPopulate",strTypeName)
logWarning(strTask, "TypeName=" & strTypeName & " NOT recognized")
End Select
LogTaskEnd(strTask)
Catch ex1 As Exception
LogException(strTask, ex1)
Finally
End Try
End Sub
Sub DBPopulate(ByVal strConn As String, ByVal strSQL As String, ByRef htParm As Hashtable, ByRef objParm As Object)
Dim strTask As String = "SUB DBPopulate / hash=3rd parm object, object=4th parm"
LogTaskStart(strTask)
LogTaskParms(strTask, "strConn", strConn,"strSQL", strSQL,"htParm",htParm,"objParm", objparm)
Dim strTypeName As String
Try
strTypeName = TypeName(objParm).ToLower
If TypeOf (objParm) Is Control Then
Select Case strTypeName
Case "literal"
Dim litTemp As Literal
litTemp = objParm
litTemp.Text = SP_DBScalar(strConn, strSQL, htParm)
Case "textbox"
Dim txtTemp As TextBox
txtTemp = objParm
txtTemp.Text = SP_DBScalar(strConn, strSQL, htParm)
Case Else
SP_DBPopulate_Control(strConn, strSQL, htParm, objParm)
End Select
Exit Sub
End If
Select Case strTypeName
Case "datatable"
Dim dtTemp As New DataTable
dtTemp = objParm
SP_DBPopulate_DataTable(strConn, strSQL, htParm, dtTemp)
objParm=dtTemp
Case "integer", "string", "datetime"
objParm = DBScalar(strConn, strSQL)
Case "nothing"
' whatever
Case "string()"
SP_DBPopulate_Array1d(strConn, strSQL, htParm, objParm)
Case "string(,)"
SP_DBPopulate_Array2d(strConn, strSQL, htParm, objParm)
Case Else
logWarning(strTask, "TypeName=" & strTypeName & " NOT recognized")
End Select
LogTaskEnd(strTask)
Catch ex1 As Exception
LogException(strTask, ex1)
Finally
End Try
End Sub
private Sub DBPopulate(ByVal objParmDataSource As DataTable, ByVal objParmControl As Object)
DBPopulate_ControlFromDataViewOrDataTable(objParmDataSource,objParmControl)
End Sub
Sub DBPopulate(ByVal objParmDataSource As DataView, ByRef objParmControl As Object)
DBPopulate_ControlFromDataViewOrDataTable(objParmDataSource,objParmControl)
End Sub
Sub DBPopulate_ControlFromDataViewOrDataTable(ByVal objParmDataSource As object, ByRef objParmControl As Object)
DIM strTask as string="SUB DBPopulate_ControlFromDataViewOrDataTable"
LogTaskStart(strTask)
LogTaskParms(strTask, "objParmDataSource",objParmDataSource,"objParmControl", objparmControl)
Try
Dim intHowManyRows as integer
TRY
' works for DataTable
intHowManyRows=objParmDataSource.Rows.count
CATCH
' works for DataView
intHowManyRows=ObjParmDataSource.Count
END TRY
'Trace.Warn("intHowManyRows",intHowManyRows)
If intHowManyRows=0
' nothing to do
else
objParmControl.DataSource = objParmDataSource
objParmControl.DataBind()
end if
LogTaskEnd(strTask)
Catch ex1 As Exception
LogException(strTask, ex1)
Finally
End Try
end sub
Function DBPopulate(ByVal strConn As String, ByVal strSQL As String) As Object
Dim strTask As String = "Function DBPopulate returns object"
Dim strTypeName As String
LogTaskStart(strTask)
LogTaskParms(strTask, "strConn", strConn,"strSQL", strSQL)
Try
LogAdviceAdHocSQL(strTask, strSQL)
Select Case DBAnalyzeConn(strConn)
Case "sqlserver"
Return (DBPopulateSQLClientDatareader(strConn, strSQL))
Case "oledb"
Return (DBPopulateOleDBDatareader(strConn, strSQL))
End Select
LogTaskEnd(strTask)
Catch ex1 As Exception
LogException(strTask, ex1)
Finally
End Try
End Function
Private Sub DBPopulate_Control(ByVal strConn As String, ByVal strSQL As String, _
ByVal objParm As Object)
Dim strTask As String = "SUB DBPopulate_Control"
LogTaskStart(strTask)
LogTaskParms(strTask, "strConn", strConn,"strSQL", strSQL,"objParm", objparm)
Dim strTypeName As String
Try
Select Case DBAnalyzeConn(strConn)
Case "sqlserver"
DBPopulateSQLClient(strConn, strSQL, objParm)
Case "oledb"
DBPopulateOLEDB(strConn, strSQL, objParm)
End Select
LogTaskEnd(strTask)
Catch ex1 As Exception
LogException(strTask, ex1)
Finally
End Try
End Sub
sub spDBPopulate(ByVal ParamArray objParms As Object())
Dim strTask As String = "SUB spDBPopulate"
LogTaskStart(strTask)
dim strConnect as string=objParms(0)
dim strProcName as string=objParms(1)
dim objWhatToFill as object=objParms(2)
dim htParm as NEW HashTable()
Dim parmCount as integer=Ubound(objParms)
dim counter as integer
If (ParmCount) MOD 2 = 0
LogHint(strTask, "spDBPopulate Incorrect Number of Parameters")
Else
' fine odd number of parameters
End If
For counter = 4 to ParmCount step 2
htParm.Add(objParms(counter-1),objParms(counter))
next
DBPopulate(strConnect,strProcName,htParm,objWhatToFill)
end sub
Function DBPopulateSQLClientDatareader(ByVal strConn As String, ByVal strSQL As String) As SqlDataReader
Dim strTask As String = "DBPopulateSQLClient"
LogTaskStart(strTask)
LogTaskParms(strTask, "strConn", strConn,"strSQL", strSQL)
Dim Conn1 As SqlConnection
Dim Cmd1 As SqlCommand
Dim Rdr1 As SqlDataReader
Try
Conn1 = New SqlConnection(strConn)
Cmd1 = New SqlCommand(strSQL, Conn1)
Conn1.Open()
Rdr1 = Cmd1.ExecuteReader(System.Data.CommandBehavior.CloseConnection)
If Rdr1 Is Nothing Then
' nothing to do
logWarning(strTask, "Empty SQLDataReader")
Return (Nothing)
Else
intReaderUnClosedCount += 1
Return (Rdr1)
End If
LogTaskEnd(strTask)
Catch ex1 As Exception
LogException(strTask, ex1)
Finally
End Try
End Function
Private Sub DBPopulateOLEDB(ByVal strConn As String, ByVal strSQL As String, ByRef objToFill As Object)
Dim strTask As String = "SUB DBPopulateOLEDB"
LogTaskParms(strTask, "strConn", strConn,"strSQL", strSQL,"objToFill", objToFill)
Dim Conn1 As OleDbConnection
Dim Cmd1 As OleDbCommand
Dim Rdr1 As OleDbDataReader
Try
If bolCache_ Then
DBPopulateCachedOLEDB(strConn, strSQL, objToFill)
LogTaskEnd(strTask)
Exit Sub
End If
Conn1 = new OleDbConnection(strConn)
ObjectCreateTrack(strTask,Conn1)
LogTaskSQL(strTask, strSQL)
Cmd1 = New OleDbCommand(strSQL, Conn1)
Conn1.Open()
Rdr1 = Cmd1.ExecuteReader()
If Rdr1 Is Nothing Then
' nothing to do
logWarning(strTask, "Empty DataReader")
Else
objToFill.DataSource = Rdr1
objToFill.DataBind()
End If
LogTaskEnd(strTask)
Catch ex1 As Exception
If TypeName(ex1) = "OleDbException" Then
Dim strMessage As String
strMessage = ex1.Message
'LogException(strTask,ex1)
If strMessage = "No value given for one or more required parameters." Then
LogHint(strTask, "Most likely a mispelled a field name in a SQL statement", strSQL, "strSQL")
ElseIf strMessage.IndexOf("cannot find the input table or query") > -1 Then
LogHint(strTask, "Most likely a mispelled a table or query name in a SQL statement", strSQL, "strSQL")
ElseIf strMessage.IndexOf("Syntax error (missing operator) in query expression") > -1 Then
LogHint(strTask, "Syntax Error in your SQL statement", strSQL, "strSQL")
Else
LogException(strTask, ex1)
End If
Exit Sub
Else
LogException(strTask, ex1)
End If
Finally
Release(Rdr1)
Release(Conn1)
End Try
End Sub
Function DBPopulateOleDBDatareader(ByVal strConn As String, ByVal strSQL As String) As OleDbDataReader
Dim strTask As String = "DBPopulateOleDBDatareader"
LogTaskStart(strTask)
LogTaskParms(strTask, "strConn", strConn,"strSQL", strSQL)
Dim Conn1 As OleDbConnection
Dim Cmd1 As OleDbCommand
Dim Rdr1 As OleDbDataReader
Try
Conn1 = New OleDbConnection(strConn)
Cmd1 = New OleDbCommand(strSQL, Conn1)
Conn1.Open()
Rdr1 = Cmd1.ExecuteReader(System.Data.CommandBehavior.CloseConnection)
If Rdr1 Is Nothing Then
' nothing to do
logWarning(strTask, "Empty OLEDBDataReader")
Return (Nothing)
Else
intReaderUnClosedCount += 1
Return (Rdr1)
End If
LogTaskEnd(strTask)
Catch ex1 As Exception
LogException(strTask, ex1)
Finally
End Try
End Function
Private Sub DBPopulateCachedOLEDB(ByVal strConn As String, ByVal strSQL As String, ByRef objToFill As Object)
Dim strTask As String = "sub DBPopulateCachedOLEDB"
Try
LogTaskStart(strTask)
LogTaskParms(strTask, "strConn", strConn,"strSQL", strSQL,"objToFill", objToFill)
Dim dt1 As DataTable
dt1 = DataTableGetOLEDBCached(strConn, strSQL, intCacheMinutes_)
objToFill.DataSource = dt1
objToFill.DataBind()
LogTaskEnd(strTask)
Catch ex1 As Exception
LogException(strTask, ex1)
Finally
End Try
End Sub
Private Sub DBPopulateSQLClient(ByVal strConn As String, ByVal strSQL As String, ByRef objToFill As Object)
Dim strTask As String = "sub DBPopulateSQLClient "
LogTaskStart(strTask)
LogTaskParms(strTask, "strConn", strConn,"strSQL", strSQL,"objToFill", objToFill)
If bolLogSensitive_ Then
strTask &= "<br>" & vbCrLf & " object.id=" & objToFill.id
strTask &= "<br>" & vbCrLf & " strSQL=" & strSQL & vbCrLf
End If
Dim Conn1 As SqlConnection
Dim Cmd1 As SqlCommand
Dim Rdr1 As SqlDataReader
Try
If bolCache_ Then
DBPopulateCachedSQLClient(strConn, strSQL, objToFill)
LogTaskEnd(strTask)
Exit Sub
End If
Conn1=New SqlConnection(strConn)
ObjectCreateTrack(strTask,Conn1)
Cmd1 = New SqlCommand(strSQL, Conn1)
ObjectCreateTrack(strTask,Cmd1)
Conn1.Open()
Rdr1 = Cmd1.ExecuteReader()
ObjectCreateTrack(strTask,rdr1)
If Rdr1 Is Nothing Then
logWarning(strTask, "Empty DataReader")
Else
objToFill.DataSource = Rdr1
objToFill.DataBind()
End If
LogTaskEnd(strTask)
Catch ex1 As Exception
LogException(strTask, ex1)
Finally
Release(Rdr1)
Release(Conn1)
LogTaskEnd(strTask)
End Try
End Sub
Private Sub DBPopulateCachedSQLClient(ByVal strConn As String, ByVal strSQL As String, ByRef objToFill As Object)
Dim strTask As String = "sub DBPopulateCachedSQLClient"
Try
LogTaskStart(strTask)
LogTaskParms(strTask, "strConn", strConn,"strSQL", strSQL,"objToFill", objToFill)
Dim dt1 As DataTable
dt1 = DataTableGetSQLClientCached(strConn, strSQL, intCacheMinutes_)
objToFill.DataSource = dt1
objToFill.DataBind()
LogTaskEnd(strTask)
Catch ex1 As Exception
LogException(strTask, ex1)
Finally
End Try
End Sub
Function DBScalar(ByVal strConn As String, ByVal strSQL As String) As Object
Dim strTask As String = "DBScalar"
LogTaskStart(strTask)
LogTaskParms(strTask, "strConn", strConn,"strSQL", strSQL)
Select Case DBAnalyzeConn(strConn)
Case "sqlserver"
LogTaskEnd(strTask)
Return (DBScalarSqlClient(strConn, strSQL))
Case "oledb"
LogTaskEnd(strTask)
Return (DBScalarOLEDB(strConn, strSQL))
End Select
End Function
Private Function DBScalarOLEDB(ByVal strConn As String, ByVal strSQL As String) As Object
Dim strTask As String = "DBScalarOLEDB"
Dim Conn1 As OleDbConnection
Dim objTempReturn As Object
Try
LogTaskStart(strTask)
LogTaskParms(strTask, "strConn", strConn,"strSQL", strSQL)
Conn1 = New OleDbConnection(strConn)
ObjectCreateTrack(strtask,Conn1)
Dim Cmd1 As New OleDbCommand(strSQL, Conn1)
ObjectCreateTrack(strTask,cmd1)
Conn1.Open()
objTempReturn = Cmd1.ExecuteScalar()
LogTaskEnd(strTask)
logSQLReturn(strTask, objTempReturn, "objTempReturn")
Catch ex1 As InvalidCastException
Return (objNull_)
Catch ex1 As Exception
If TypeName(ex1) = "ArgumentException" Then
Dim strMessage As String
strMessage = ex1.message
If strMessage.IndexOf("An OLE DB Provider was not specified in the ConnectionString") > -1 Then
' ??? End of statement expected
' LogErrorWithSensitiveDetail(strTask,"Bad connection string",strConn,"strConn") exit function
Else
LogException(strTask, ex1)
End If
End If
Finally
Release(Conn1)
End Try
Return (objTempReturn)
End Function
Private Function DBScalarSqlClient(ByVal strConn As String, ByVal strSQL As String) As Object
Dim strTask As String = "DBScalarSQLClient"
Dim Conn1 As SqlConnection
Dim Cmd1 As SqlCommand
Dim objTempReturn As Object
Try
LogTaskStart(strTask)
LogTaskParms(strTask, "strConn", strConn,"strSQL", strSQL)
Conn1 = New SqlConnection(strConn)
ObjectCreateTrack(strTask,Conn1)
Cmd1 = New SqlCommand(strSQL, Conn1)
ObjectCreateTrack(strTask,Cmd1)
Conn1.Open()
objTempReturn = Cmd1.ExecuteScalar()
logSQLReturn(strTask, objTempReturn, "objTempReturn")
Return (objTempReturn)
Catch ex1 As Exception
LogException(strTask, ex1)
Finally
Release(Conn1)
End Try
End Function
Private SUB DisplayLogGrid(strNameOfGrid as string, dtLog as DataTable)
DisplayLogGridFromDataTableOrDataView(strNameOfGrid,dtLog)
END SUB
Private SUB DisplayLogGrid(strNameOfGrid as string, dtLog as DataView)
DisplayLogGridFromDataTableOrDataView(strNameOfGrid,dtLog)
END SUB
private sub DisplayLogGridFromDataTableOrDataView(strNameOfGrid as string, dtLog as object)
dim strTask as string="SUB DisplayLogGridFromDataTable; object=" & strNameOfGrid
LogTaskStart(strTask)
plcException.Controls.Add(New LiteralControl("<hr>"))
plcException.Controls.Add(New LiteralControl("<font color='red'>" & strNameOfGrid & "(option <b>" & strNameOfGrid & "=Off</b> will hide this)</font>"))
Dim dgTemp As New DataGrid
dim htGridOptions as new HashTable
htGridOptions("name") = strNameOfGrid
Gridformat(DgTemp, htGridOptions)
DBPopulate_ControlFromDataViewOrDataTable(dtLog, dgTemp)
plcException.Controls.Add(dgTemp)
LogTaskEnd(strTask)
end sub
Private Sub DisplayLog()
' Before We Analyze Errors and Hints
' We Must Check for Resources Not Disposed Of
Dim strTask as string="SUB DisplayLog"
LogTaskStart(strTask)
If intReaderUnClosedCount > 0 Then
LogHint("Dispose", "unclosedReaders=" & intReaderUnClosedCount)
End If
Dim intCountAllRows As Integer
Dim intTableAdviceRowCount As Integer = dsXray.Tables("Advice").Rows.Count
Dim intTableErrorsRowCount As Integer = dsXray.Tables("Errors").Rows.Count
Dim intTableHintsRowCount As Integer = dsXray.Tables("Hints").Rows.Count
Dim intTableMesagesRowCount As Integer = dsXray.Tables("Messages").Rows.Count
Dim intTableSuperTraceRowCount As Integer = dsXray.Tables("SuperTrace").Rows.Count
Dim intTableSuperTraceSummaryRowCount As Integer = dsXray.Tables("SuperTraceSummary").Rows.Count
intCountAllRows = intTableErrorsRowCount
If intCountAllRows > 0 Then
plcException.Controls.Add(New LiteralControl(strErrMessage_))
End If
If intTableHintsRowCount > 0 And BolHints_ = True Then
DisplayLogGrid("Hints",dsXray.Tables("Hints"))
End If
If intTableErrorsRowCount > 0 And bolErrorDetails_ = True Then
DisplayLogGrid("Errors",dsXray.Tables("Errors"))
End If
If intTableAdviceRowCount > 0 And BolAdvice_ = True Then
DisplayLogGrid("Advice",dsXray.Tables("Advice"))
End If
If intTableMesagesRowCount > 0 And bolMessages_ = True Then
DisplayLogGrid("Messages",dsXray.Tables("Messages"))
End If
If intTableSuperTraceRowCount > 0 And bolSuperTrace_ = True Then
SuperTracePostProcess()
'plcException.Controls.Add(New LiteralControl("<hr>"))
'plcException.Controls.Add(New LiteralControl("MinutesTotal=" & MinutesTotal & "<br>"))
Dim dv1 As New DataView(dsXray.Tables("SuperTrace"))
If strSuperTraceHide_ = "" And strSuperTraceShow_ <> "" Then
dv1.RowFilter = "EventCategory='" & strSuperTraceShow_ & "'"
Trace.Warn("DV1.rowfilter", dv1.RowFilter)
End If
If strSuperTraceHide_ <> "" And strSuperTraceShow_ = "" Then
dv1.RowFilter = "EventCategory<>'" & strSuperTraceSho |