'--------------------------------------------------------------------------------------------------------------------------------------------------- 'Program Listing for: ef_main_stats.aspx.vb 'Project: webstats 'Namespace: vb.net '---------------------------------------------------------------------------------------------------------------------------------------------------- Imports System.Data Imports System.Data.OleDb Public Class WebForm1 Inherits System.Web.UI.Page Protected WithEvents timelabel As System.Web.UI.WebControls.Label Protected WithEvents Label3 As System.Web.UI.WebControls.Label Protected WithEvents lblEFPendings As System.Web.UI.WebControls.Label Protected WithEvents lblTime As System.Web.UI.WebControls.Label Protected WithEvents Label1 As System.Web.UI.WebControls.Label Protected WithEvents Label4 As System.Web.UI.WebControls.Label Protected WithEvents Label5 As System.Web.UI.WebControls.Label Protected WithEvents Label6 As System.Web.UI.WebControls.Label Protected WithEvents Label7 As System.Web.UI.WebControls.Label Protected WithEvents Label8 As System.Web.UI.WebControls.Label Protected WithEvents Label9 As System.Web.UI.WebControls.Label Protected WithEvents Label10 As System.Web.UI.WebControls.Label Protected WithEvents Label11 As System.Web.UI.WebControls.Label Protected WithEvents Label12 As System.Web.UI.WebControls.Label Protected WithEvents Image1 As System.Web.UI.WebControls.Image Protected WithEvents lblToday As System.Web.UI.WebControls.Label Protected WithEvents lblLastImport As System.Web.UI.WebControls.Label Protected WithEvents lblHR As System.Web.UI.WebControls.Label Protected WithEvents lblAssr As System.Web.UI.WebControls.Label Protected WithEvents lblNod As System.Web.UI.WebControls.Label Protected WithEvents lblNoh As System.Web.UI.WebControls.Label Protected WithEvents lblBulkEF As System.Web.UI.WebControls.Label Protected WithEvents lblIndEF As System.Web.UI.WebControls.Label Protected WithEvents Label13 As System.Web.UI.WebControls.Label Protected WithEvents DropDownList1 As System.Web.UI.WebControls.DropDownList Protected WithEvents Label14 As System.Web.UI.WebControls.Label Protected WithEvents submitButton As System.Web.UI.WebControls.Button Protected WithEvents Panel1 As System.Web.UI.WebControls.Panel Protected WithEvents Label2 As System.Web.UI.WebControls.Label #Region " Web Form Designer Generated Code " 'This call is required by the Web Form Designer. <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent() End Sub Private Sub Page_Init(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Init 'CODEGEN: This method call is required by the Web Form Designer 'Do not modify it using the code editor. InitializeComponent() End Sub #End Region ' connection string, same as old ADO conn string Dim connstring = "REDACTED;Driver={Microsoft Visual FoxPro Driver};" & _ "removed;" & _ "Collate=Machine;Null=Yes;Deleted=Yes;" Private Sub Page_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Dim listChoice As String Dim dateTo As DateTime Dim startPeriod, endPeriod As String Dim processList As New PROCESS_LISTERLib.ProcessLister() Dim strCheck As String = "Automailer" ' use COM object to see if the automailer program is up and running Dim nInstances As Int32 = processList.CheckProcessByWindowTitle(strCheck) Dim whereClause As String ' if this is a response to a submit, refigure the date parameters for email stats If IsPostBack Then dateTo = DateTime.Now listChoice = Request.Form("DropDownList1").ToString() If (listChoice = "This Week") Then dateTo = dateTo.AddDays(-7) endPeriod = String.Format("{0}/{1}/{2}", DateTime.Now.Month, DateTime.Now.Day, DateTime.Now.Year) ElseIf listChoice = "This Month" Then dateTo = dateTo.AddDays(-30) endPeriod = String.Format("{0}/{1}/{2}", DateTime.Now.Month, DateTime.Now.Day, DateTime.Now.Year) ElseIf listChoice = "Yesterday" Then dateTo = dateTo.AddDays(-1) endPeriod = Nothing 'for clarity not really necessary to explicitly do this Else endPeriod = Nothing ' for clarity End If startPeriod = String.Format("{0}/{1}/{2}", dateTo.Month, dateTo.Day, dateTo.Year) If endPeriod Is Nothing Then lblToday.Text = String.Format("{0}/{1}/{2}", dateTo.Month, dateTo.Day, dateTo.Year) Else lblToday.Text = String.Format("{0}/{1}/{2}", dateTo.Month, dateTo.Day, dateTo.Year) & " - " & endPeriod End If ' otherwise, if not in a submit, set date parameters to today for email stats Else lblToday.Text = String.Format("{0}/{1}/{2}", DateTime.Now.Month, DateTime.Now.Day, DateTime.Now.Year) ' startPeriod = lblToday.Text startPeriod = "12/06/2001" End If ' this where clause is common to the selects below so define it as a var ' if no end period, it's just one day If endPeriod Is Nothing Then whereClause = "where ttod(lsentwhen) = ctod([" & startPeriod & "])" ' otherwise include the end period, if over a week or a month Else whereClause = "where ttod(lsentwhen) >= ctod([" & startPeriod & "]) and ttod(lsentwhen) <= ctod([" & endPeriod & "])" End If ' control label, shows time page was refreshed lblTime.Text = _ String.Format(" {0}/{1}/{2} {3:d2}:{4:d2}:{5:d2}", _ DateTime.Now.Month, DateTime.Now.Day, DateTime.Now.Year, DateTime.Now.Hour, DateTime.Now.Minute, DateTime.Now.Second) ' use singleValueSelect function below to grab values for the email stats displays lblEFPendings.Text = singleValueSelect("select cnt(*) as ncnt from ef_main where lactive").ToString lblIndEF.Text = singleValueSelect("select cnt(*) as ncnt from mailer " & whereClause).ToString lblNod.Text = singleValueSelect("select cnt(*) as ncnt from mailer " & _ whereClause & " and ctype = [NODSUM]").ToString lblNoh.Text = singleValueSelect("select cnt(*) as ncnt from mailer " & _ whereClause & " and ctype = [NOHSUM]").ToString lblNoh.Text = nInstances.ToString() lblHR.Text = singleValueSelect("select cnt(*) as ncnt from mailer " & _ whereClause & " and ctype = [HROFF]").ToString lblBulkEF.Text = singleValueSelect("select cnt(*) as ncnt from mailer " & _ whereClause & " and ctype = [BULKRSP]").ToString lblAssr.Text = singleValueSelect("select cnt(*) as ncnt from mailer " & _ whereClause & " and ctype = [BULKRSP]").ToString lblLastImport.Text = singleValueSelectStr("select twhen from efimport " & _ "order by twhen desc") End Sub ' process a select that returns a single value, one version here returns integer, ' an overloaded version returns a string (below) Private Function singleValueSelect(ByVal selectString As String) As Integer Dim rows_affected As Integer Dim error_string As String = "" Dim currentKeyVal As Integer ' use old ADODB stuff since connecting to Foxpro (ODBC driver only) Dim adoConnection As New ADODB.Connection() Dim adoRecordSet As New ADODB.Recordset() Dim DataSet1 As New DataSet() Dim odda As New OleDbDataAdapter() Dim returnVal As Integer Try adoConnection.Open(connstring) ' process the select adoRecordSet.Open(selectString, adoConnection, _ ADODB.CursorTypeEnum.adOpenKeyset, ADODB.LockTypeEnum.adLockOptimistic) ' I tried doing this with the ADODB command's execute statement rather than this more roundable way but had an error, ' I don't think it supports all the parameters as calling it from VB 6 ' so for now I'm using a dataset type call odda.Fill(DataSet1, adoRecordSet, "table1") ' see if any data was returned from last select If DataSet1.Tables(0).Rows.Count = 0 Then Return -1 End If Try ' try to get the actual data, if wrong type this will raise exception returnVal = DataSet1.Tables(0).Rows(0).Item(0) ' if the item has no default to integer conversion than we catch this and set return value to -1 Catch ex As Exception returnVal = -1 Finally End Try Catch ex As Exception Finally ' dont close the recordset, the Fill method does that already with AdoDB recordsets Try adoConnection.Close() ' if error with close don't do anything with exception, sometimes ADODB is already closed ' and calling close again will sometimes raise an exception (but handle to avoid a runtime) Catch ex As Exception End Try End Try Return returnVal End Function ' same as above but returns string for a select that returns a string, I could consolidate these two ' functions a bit but for now this is quick and dirty Private Function singleValueSelectStr(ByVal selectString As String) As String Dim rows_affected As Integer Dim error_string As String = "" Dim currentKeyVal As Integer Dim adoConnection As New ADODB.Connection() Dim adoRecordSet As New ADODB.Recordset() Dim DataSet1 As New DataSet() Dim odda As New OleDbDataAdapter() Dim returnVal As String Try adoConnection.Open(connstring) ' process the select adoRecordSet.Open(selectString, adoConnection, _ ADODB.CursorTypeEnum.adOpenKeyset, ADODB.LockTypeEnum.adLockOptimistic) ' I tried doing this with the command's execute statement rather than this more roundable way but had an error ' so for now I'm using a dataset odda.Fill(DataSet1, adoRecordSet, "table1") ' see if any data was returned from last select If DataSet1.Tables(0).Rows.Count = 0 Then Return "no data matched query" End If Try returnVal = DataSet1.Tables(0).Rows(0).Item(0) ' if the item has no default to integer conversion than we catch this and return error Catch ex As Exception returnVal = "exception" Finally End Try Catch ex As Exception Finally ' dont close the recordset, the Fill method does that already with AdoDB recordsets Try adoConnection.Close() Catch ex As Exception End Try End Try Return returnVal End Function End Class