'ONLY contains shared methods/functions Imports Superbowl_Daily_2.SystemFunctions Imports System Imports System.Net.Mail Public Class ProjectFunctions Public Overloads Shared Function FormatPercent(ByVal MyValue As Object, Optional ByVal intDecimals As Integer = 0, Optional ByVal IncludeLeadingDigit As TriState = TriState.UseDefault, Optional ByVal UseParensForNeg As TriState = TriState.UseDefault, Optional ByVal GroupDigits As TriState = TriState.UseDefault) As String 'overloads the standard formatPerc function to add in "+" sign for positives Try If CDbl(MyValue) > 0 Then Return "+" & Microsoft.VisualBasic.FormatPercent(MyValue, intDecimals, IncludeLeadingDigit, UseParensForNeg, GroupDigits) Else Return Microsoft.VisualBasic.FormatPercent(MyValue, intDecimals, IncludeLeadingDigit, UseParensForNeg, GroupDigits) End If Catch ex As Exception Return "0.0" End Try End Function Public Overloads Shared Function FormatNumber(ByVal MyValue As Object, Optional ByVal intDecimals As Integer = 0, Optional ByVal IncludeLeadingDigit As TriState = TriState.UseDefault, Optional ByVal UseParensForNeg As TriState = TriState.UseDefault, Optional ByVal GroupDigits As TriState = TriState.UseDefault) As String 'rgbc's server is set up with number format = "999 999.99", which is lame. it should be "999,999.99" Try Return Microsoft.VisualBasic.FormatNumber(MyValue, intDecimals, IncludeLeadingDigit, UseParensForNeg, GroupDigits).ToString.Replace(Chr(160), ",") 'OMG! I HAVE NEVER SEEN SOMETHING THIS STUPID! LIVE SERVER SETTINGS NUMBER FORMATS NOT A SPACE CHARACTER, BUT A chr(160). WTF IS 160?! FUCKING PIECE OF SHIT! DIE! Catch ex As Exception Return "0.0" End Try End Function Public Shared Sub WriteLog(LogType As String, ProcessName As String, ProcessEvent As String, Log As String, Optional blnEmailed As Integer = 0, Optional tblLog As String = "stgSuperbowlLog") Dim sql As String sql = "INSERT INTO " & tblLog & " (strStamp, dtLog, strType, strProcess, strAction, txtLog, blnEmail) " & _ "VALUES ('" & Date.Now.Ticks.ToString() & "', '" & Date.Now.ToString("u") & "', '" & LogType & "', '" & ProcessName & "', '" & ProcessEvent & "', '" & db.CleanString(Log) & "', " & blnEmailed & ")" db.doQuery(sql) End Sub Public Shared Function getTextStream(strPathFilename As String) As IO.StreamReader Return IO.File.OpenText(strPathFilename) End Function Public Shared Sub EmailLog() Dim strTo, strBody, strColour, dtLogMAX As String Dim strFrom As String = "" #If DEBUG Then '20180830 - v2.1.8 - changed SMTP mail settings - maanie Dim smtpC As New System.Net.Mail.SmtpClient("smtp.office365.com", 587) smtpC.EnableSsl = True smtpC.UseDefaultCredentials = False smtpC.Credentials = New System.Net.NetworkCredential("smtp@overdrive.co.za", "Ram99144") strFrom = "Superbowl Daily 2 " #Else ' Live Dim smtpC As New System.Net.Mail.SmtpClient(My.Settings.SMTPHost) strFrom = "Superbowl Daily 2 " #End If Dim mm As Net.Mail.MailMessage Dim ds As DataSet Dim dr As DataRow dtLogMAX = "" ' 20140909 - v2.1.2 - updated email log: counting errors/warnings - pj 'ds = db.doQuery("SELECT 0 as intOrder, * FROM logSuperbowl WHERE blnEmail = 0 AND strType IN ('error') UNION ALL SELECT 1 as intOrder, * FROM logSuperbowl WHERE blnEmail = 0 AND strType <> 'debug' ORDER BY intOrder, strStamp") 'AND strType <> 'debug' ds = db.doQuery("SELECT logSuperbowl.dtLog, logSuperbowl.strType, logSuperbowl.strProcess, logSuperbowl.strAction, logSuperbowl.txtLog, logSuperbowl.strStamp " & _ "FROM logSuperbowl " & _ "WHERE (logSuperbowl.strType Not In ('warning','debug') OR strAction = 'ArchiveFile') AND blnEmail = 0 " & _ "UNION ALL " & _ "SELECT Max(logSuperbowl.dtLog) AS dtLog, logSuperbowl.strType, logSuperbowl.strProcess, logSuperbowl.strAction, CAST(COUNT(ID) AS varchar) AS txtLog, Max(logSuperbowl.strStamp) AS strStamp " & _ "FROM logSuperbowl " & _ "WHERE (logSuperbowl.strType In ('warning') AND strAction <> 'ArchiveFile') AND blnEmail = 0 " & _ "GROUP BY logSuperbowl.strType, logSuperbowl.strProcess, logSuperbowl.strAction " & _ "ORDER BY strStamp") 'build table strBody = "" & _ "
" & _ "" & _ "" Try If ds.Tables(0).Rows.Count > 0 Then For Each dr In ds.Tables(0).Rows Select Case dr!strType Case "error" strColour = "FFC2B7" Case "warning" strColour = "FFDBB7" Case "debug" strColour = "B7FFBC" Case "info" Try 'strColour = getHexColour(dr!strStamp.ToString.Substring(12)) strColour = getHexColourString(dr!strProcess) Catch ex As Exception strColour = "E0E0E0" End Try Case Else strColour = "E0E0E0" End Select strBody &= "" dtLogMAX = dr!dtLog.ToString Next Else strBody &= "" End If strBody &= "
Date TimeProcessActionTypeLog
" & dr!dtLog.ToString.Replace("Z", "") & "" & dr!strProcess & "" & dr!strAction & "" & dr!strType & "" & dr!txtLog & "
- No Log items found -
" db.doQuery("UPDATE logSuperbowl SET blnEmail = 1 WHERE blnEmail = 0") 'send email For Each strTo In My.Settings.EmailRgbc.Split(";") 'strTo = strEmails(0) 'superbowl@rgbc.co.za If strTo.Length > 0 Then mm = New Net.Mail.MailMessage(strFrom, strTo, "Superbowl Daily 2 Log [" & Date.Now.ToString("u") & "]", strBody) mm.IsBodyHtml = True smtpC.Send(mm) WriteLog("debug", "Superbowl Daily 2", "Email Log", "Email Sent: " & strTo, 1, "logSuperbowl") End If Next Catch OOMex As OutOfMemoryException WriteLog("warning", "Superbowl Daily 2", "Email Log", "EmailLog() OutOfMemoryException", 1, "logSuperbowl") ds = Nothing For Each strTo In My.Settings.EmailRgbc.Split(";") If strTo.Length > 0 Then mm = New Net.Mail.MailMessage(strFrom, strTo, "Superbowl Daily 2 Log [" & Date.Now.ToString("u") & "]", strBody) mm.IsBodyHtml = True smtpC.Send(mm) WriteLog("debug", "Superbowl Daily 2", "Email Log", "Email Sent: " & strTo, 1, "logSuperbowl") End If Next db.doQuery("UPDATE logSuperbowl SET blnEmail = 1 WHERE blnEmail = 0 AND dtLog <= '" & dtLogMAX & "'") Catch ex As Exception db.doQuery("UPDATE logSuperbowl SET blnEmail = -1 WHERE blnEmail = 0") WriteLog("error", "Superbowl Daily 2", "Email Log", ex.Message & " :: " & ex.StackTrace, 0, "logSuperbowl") Finally 'db.doQuery("UPDATE logSuperbowl SET blnEmail = 1 WHERE blnEmail = 0") End Try End Sub ' Track it All Outlet Sync - failure notification (sent when Thursday retry fails) Public Shared Sub SendTrackItAllFailureNotification(errorMessage As String) Dim strFrom As String = "" Dim strTo As String = "" Dim strBody As String = "" Dim mm As Net.Mail.MailMessage #If DEBUG Then Dim smtpC As New System.Net.Mail.SmtpClient("smtp.office365.com", 587) smtpC.EnableSsl = True smtpC.UseDefaultCredentials = False smtpC.Credentials = New System.Net.NetworkCredential("smtp@overdrive.co.za", "Ram99144") strFrom = "Superbowl Daily 2 " #Else Dim smtpC As New System.Net.Mail.SmtpClient(My.Settings.SMTPHost) strFrom = "Superbowl Daily 2 " #End If strBody = "" & "

Track it All Outlet Sync failed on the second attempt (Thursday retry).

" & "

Date/Time: " & Date.Now.ToString("u") & "

" & "

Error:

" & System.Net.WebUtility.HtmlEncode(errorMessage) & "

" & "" Try For Each strTo In My.Settings.TrackItAllFailureNotificationEmails.Split(";"c) strTo = strTo.Trim() If strTo.Length > 0 Then mm = New Net.Mail.MailMessage(strFrom, strTo, "Track it All Outlet Sync - Second Attempt Failed", strBody) mm.IsBodyHtml = True smtpC.Send(mm) WriteLog("info", "Track it All Outlets", "Failure Notification", "Email sent to: " & strTo, 0, "stgSuperbowlLog") End If Next Catch ex As Exception WriteLog("error", "Track it All Outlets", "Failure Notification", "Failed to send email: " & ex.Message, 0, "stgSuperbowlLog") End Try End Sub Public Shared Sub EmailUnIinvoicedRequisitions() '20141020 - v2.1.3 - added process to email requisitions on Mondays with no invoice no after 2 weeks of being approved. - Maanie Dim mm As Net.Mail.MailMessage Dim strFrom As String = "" #If DEBUG Then '20180830 - v2.1.8 - changed SMTP mail settings - maanie Dim smtpC As New System.Net.Mail.SmtpClient("smtp.office365.com", 587) smtpC.EnableSsl = True smtpC.UseDefaultCredentials = False smtpC.Credentials = New System.Net.NetworkCredential("smtp@overdrive.co.za", "Ram99144") strFrom = "FreeStock Requisition " #Else ' Live Dim smtpC As New System.Net.Mail.SmtpClient(My.Settings.SMTPHost) strFrom = "FreeStock Requisition " #End If Dim ds As DataSet Dim dr As DataRow Dim strBody As String = "" Dim strTo As String = "" Dim dtTwoWeeksAgo = Date.Now.AddDays(-14) If DateTime.Parse(Date.Now).DayOfWeek.ToString = "Monday" Then ds = db.doQuery("SELECT fsrRequisition.RequisitionID, strPinkSlipNumber, mstUser.strUserName, fsrRequestType.strRequestType, LEFT(CONVERT(varchar(24),fsrRequisition.dtDate,120), 10) AS dtDate, fsrRequisition.strRegion,fsrRequisition.strExpense,ISNULL(tBillTo.strCustomerName, '') AS strBillToAccount, ISNULL(tShipTo.strCustomerName, '') AS strShipToAccount, fsrRequisition.strContactPerson ,fsrRequisition.txtRequestDetail, fsrRequisition.strContactNumber, fsrRequisition.blnDelivery, fsrRequisition.strStatus, fsrRequisition.strInvoiceNumber, fsrRequisition.dtLastEdit, fsrRequisition.strAuthorizedBy, Item.TotalValue FROM fsrRequisition INNER JOIN mstUser ON fsrRequisition.refUserID = mstUser.UserID INNER JOIN fsrRequestType ON fsrRequisition.refRequestTypeID = fsrRequestType.RequestTypeID LEFT OUTER JOIN (SELECT refRequisitionID, SUM(dblTotal) AS TotalValue FROM fsrItem GROUP BY refRequisitionID) AS Item ON fsrRequisition.RequisitionID = Item.refRequisitionID LEFT OUTER JOIN dwdCustomer AS tShipTo ON fsrRequisition.strShipToAccount = tShipTo.strCustomerNo LEFT OUTER JOIN dwdCustomer AS tBillTo ON fsrRequisition.strBillToAccount = tBillTo.strCustomerNo WHERE (fsrRequestType.blnActive = 1) AND strStatus = 'Approved' AND (strInvoiceNumber IS NULL OR strInvoiceNumber = '') AND dtDate < '" & dtTwoWeeksAgo & "' ORDER BY fsrRequisition.dtDate DESC, mstUser.strUserName, fsrRequestType.strRequestType, fsrRequisition.strStatus, fsrRequisition.strBillToAccount, fsrRequisition.strShipToAccount") If ds.Tables.Count > 0 Then strBody &= "" & "
" & "" & "" For Each requisition In ds.Tables(0).Rows ' Get the manager, alternative manager, executive manager email addresses for each requisition dr = db.getRow("SELECT fsrRequisition.RequisitionID, ISNULL(fsrRequisition.refManagerID, '0') AS refManagerID, ISNULL(fsrRequisition.refAlternateManagerID, '0') AS refAlternateManagerID, ISNULL(mstUser.strEmail, '') AS ManagerEmail, ISNULL(mstUser.refManagerExecutiveID, '0') AS refManagerExecutiveID, ISNULL(mstUser_2.strEmail, '') AS ExecutiveManagerEmail, ISNULL(mstUser_1.strEmail, '') AS AltManagerEmail FROM fsrRequisition LEFT OUTER JOIN mstUser AS mstUser_2 ON fsrRequisition.refExecutiveManagerID = mstUser_2.UserID LEFT OUTER JOIN mstUser AS mstUser_1 ON fsrRequisition.refAlternateManagerID = mstUser_1.UserID LEFT OUTER JOIN mstUser ON fsrRequisition.refManagerID = mstUser.UserID WHERE(fsrRequisition.RequisitionID = " & requisition!RequisitionID & ")") strBody &= "" Next strBody &= "
Pink Slip NumberRequested ByDateBill-To AccountShip-To AccountRequest Type Detail of Request Contact Manager Email AddressAlternative Manager Email Address Executive Manager Email Address
" & requisition!strPinkSlipNumber & "" & requisition!strUserName & "" & requisition!dtDate & " " & requisition!strBillToAccount & " " & requisition!strShipToAccount & " " & requisition!strRequestType & " " & requisition!txtRequestDetail & " " & requisition!strContactPerson & " - " & requisition!strContactNumber & " " & dr!ManagerEmail & " " & dr!AltManagerEmail & " " & dr!ExecutiveManagerEmail & "
" strTo = "Genevieve@rgbc.co.za" 'strTo = "gareth@overdrive.co.za" If strTo.Length > 0 Then mm = New Net.Mail.MailMessage(strFrom, strTo, "Un-Invoiced Requisitions ", strBody) mm.IsBodyHtml = True Dim copy As MailAddress = New MailAddress("pj@overdrive.co.za") mm.CC.Add(copy) Dim copy1 As MailAddress = New MailAddress("maanie@overdrive.co.za") mm.CC.Add(copy1) smtpC.Send(mm) End If End If End If End Sub Public Shared Sub CheckPeriods() 'log handle: check mstPeriods Dim dr As DataRow Dim sql As String Dim maxPeriod, newPeriod As Duodecimal Dim dblPeriod As Double Dim intFiscalYear, intFiscalMonth, intFiscalQuater As Integer dr = db.getRow("SELECT TOP 1 * FROM mstPeriod ORDER BY strPeriod DESC") maxPeriod = New Duodecimal(dr!strPeriod.ToString) dblPeriod = maxPeriod.Diff(Date.Now.ToString("yyyyMM")) dr = db.getRow("SELECT * FROM mstCompany WHERE strCompany = 'RGBC'") If dblPeriod < 30 Then For i As Integer = 1 To 6 Try maxPeriod.Add(1) newPeriod = New Duodecimal(maxPeriod.getPeriod) If maxPeriod.Month < CInt(dr!strFYStart) Then intFiscalYear = maxPeriod.Year Else intFiscalYear = maxPeriod.Year + 1 End If intFiscalMonth = newPeriod.Add(-1 * CInt(dr!strFYStart) + 1) intFiscalQuater = ((intFiscalMonth - 1) \ 3) + 1 's &= Chr(13) & "M = " & maxPeriod.getPeriod & " : M= " & maxPeriod.Month & ":" & intFiscalMonth & " : Q = " & ((maxPeriod.Month - 1) \ 3) + 1 & ":" & intFiscalQuater & " " sql = Chr(13) & "INSERT INTO mstPeriod(strPeriod, intFiscalYear, intCalendarYear, intFiscalQuarter, intCalendarQuarter, intFiscalMonth, intCalendarMonth, strMonth) " & _ " VALUES('" & maxPeriod.getPeriod & "'," & intFiscalYear & "," & maxPeriod.Year & "," & intFiscalQuater & "," & ((maxPeriod.Month - 1) \ 3) + 1 & "," & intFiscalMonth & "," & maxPeriod.Month & ",'" & maxPeriod.DuoDate.ToString("MMMM") & "');" db.doQuery(sql) Catch ex As Exception WriteLog("error", "Superbowl Daily 2", "Check mstPeriod", ex.Message & " :: " & ex.StackTrace) Finally End Try Next End If End Sub Public Shared Sub LogDWD() 'log handle: Log DWD Try db.doQuery("INSERT INTO dlyDataWarehouse(dtStamp, strDate, intCustomers, intProducts) " & _ "SELECT '" & Date.Now.Ticks & "' AS dt,'" & Date.Now.ToString("yyyyMMdd") & "' AS strDate,(SELECT COUNT(strCustomerNo) FROM dwdCustomer) as C,(SELECT COUNT(strProdCode) FROM dwdProduct) as P") Catch ex As Exception WriteLog("error", "Superbowl Daily 2", "Log DWD", ex.Message & " :: " & ex.StackTrace) End Try End Sub Public Shared Sub BackupMintPromos() 'log handle: Backup Off/OnconPromo If Date.Today.DayOfWeek = DayOfWeek.Monday Then Try db.doQuery("SELECT * INTO xOffconPromo_" & Date.Now.ToString("yyyyMMdd") & " FROM dwfOffconPromo") WriteLog("info", "Superbowl Daily 2", "Backup OffconPromo", "Backup Complete") Catch ex As Exception WriteLog("error", "Superbowl Daily 2", "Backup OffconPromo", ex.Message & " :: " & ex.StackTrace) End Try Try db.doQuery("SELECT * INTO xOnconPromo_" & Date.Now.ToString("yyyyMMdd") & " FROM dwfOnconPromo") WriteLog("info", "Superbowl Daily 2", "Backup OnconPromo", "Backup Complete") Catch ex As Exception WriteLog("error", "Superbowl Daily 2", "Backup OnconPromo", ex.Message & " :: " & ex.StackTrace) End Try End If End Sub End Class