classes/common.vb - main - ivan/ModMas

classes/common.vb
524 строки22 KB
i.krivokon
Initial commit
13 мар 2026, 13:49
13 мар 2026, 13:4900d9fb6
Imports System.Globalization
Imports System.Net.Mail
Imports System.Net
Imports sharedClasses.dbFunctions
Imports System.Web.UI.WebControls
Imports System.Web.UI
Imports System.Text
Imports System.Net.Mime
Imports System.IO

Namespace Common
    Public Class common
        Public Sub SendEmail(_recepient As String, _subject As String, _body As String, Optional mailGroupName As String = "")
            Dim sqlf As New SqlFunctions
            Dim com As New System.Data.SqlClient.SqlCommand
            com.CommandText = "msdb.dbo .sp_send_dbmail"
            With com.Parameters
                .AddWithValue("profile_name", "Orchestra")
                .AddWithValue("body_format", "HTML")
                .AddWithValue("subject", _subject)
                .AddWithValue("body", _body)
            End With
            com.CommandType = Data.CommandType.StoredProcedure
            If mailGroupName = "" Then
                com.Parameters.AddWithValue("recipients", _recepient)
                sqlf.NonQuery(com)
            Else
                Try
                    Dim dt As Data.DataTable = sqlf.GetData("SELECT * FROM UserModules.[user].[Mailing_List] WHERE enabled='Y' and group_name='" & mailGroupName & "'")
                    If dt.Rows.Count > 0 Then
                        For Each dr As Data.DataRow In dt.Rows
                            If com.Parameters.Contains("recipients") Then
                                com.Parameters("recipients").Value = dr("single_id") & "@samsung.com"
                            Else
                                com.Parameters.AddWithValue("recipients", dr("single_id") & "@samsung.com")
                            End If

                            sqlf.NonQuery(com)
                        Next
                    End If
                Catch ex As Exception
                End Try
            End If
        End Sub

        Public Sub TowerLamp(lamp As String, color As String, mode As String)
            Dim s As String = "NG"
            If Not IsNothing(lamp) And Not IsNothing(color) And Not IsNothing(mode) Then
                Dim colorNumber As String = 0
                Dim modeNumber As String = 0
                Select Case color
                    Case "red" : colorNumber = 1
                    Case "yellow" : colorNumber = 2
                    Case "green" : colorNumber = 3
                End Select
                Select Case mode
                    Case "on" : modeNumber = 1
                    Case "off" : modeNumber = 3
                    Case "blink" : modeNumber = 2
                End Select
                Try
                    Dim client As New Net.WebClient
                    client.Headers.Add("user-agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; .NET CLR 1.0.3705;)")
                    Dim url As String = "http://" & lamp & ".serk.lan/L?" & colorNumber & "=" & modeNumber
                    s = url
                    Dim data As Stream = client.OpenRead(url)
                    Dim reader As New StreamReader(data)

                    s = reader.ReadToEnd()
                    'Console.WriteLine(s)
                    data.Close()
                    reader.Close()

                Catch ex As Exception

                End Try
            End If
        End Sub

        Public Shared Function funSupr(xsu As Decimal, Optional mb As Byte = 0) As String
            ' прописью в рублях по-русски
            On Error GoTo ersupr
            funSupr = ""
            If Not IsNumeric(xsu) Then
                funSupr = ""
                Exit Function
            End If
            If xsu >= 10000000000000.0# Then
                funSupr = "слишком большое число"
                Exit Function
            End If
            Dim ssu As String, nsu, edi, des, sot, ind As Byte, i As Integer
            If Fix(xsu) = 0 Then
                funSupr = "ноль рублей "
            Else
                ssu = Mid$(Str$(Fix(xsu)), 2)
                nsu = (Len(ssu) + 2)
                ssu = Right$("00", nsu * 3 - Len(ssu)) + ssu
                For i = nsu To 1 Step -1
                    sot = Val(Mid$(ssu, (nsu - i) * 3 + 1, 1))
                    des = Val(Mid$(ssu, (nsu - i) * 3 + 2, 1))
                    edi = Val(Mid$(ssu, (nsu - i) * 3 + 3, 1))
                    If sot + des + edi > 0 Or i = 1 Then
                        If sot > 0 Then
                            funSupr = funSupr + Choose(sot, "сто", "двести", "триста", _
                            "четыреста", "пятьсот", "шестьсот", "семьсот", "восемьсот", _
                            "девятьсот") + " "
                        End If
                        If des = 1 Then
                            funSupr = funSupr + Choose(edi + 1, "десять", "одиннадцать", _
                            "двенадцать", "тринадцать", "четырнадцать", "пятнадцать", "шестнадцать", _
                            "семнадцать", "восемнадцать", "девятнадцать") + " "
                            ind = 3
                        Else
                            If des <> 0 Then
                                funSupr = funSupr + Choose(des - 1, "двадцать", _
                                "тридцать", "сорок", "пятьдесят", "шестьдесят", "семьдесят", "восемьдесят", _
                                "девяносто") + " "
                            End If
                            If edi <> 0 Then
                                If i = 2 And (edi = 1 Or edi = 2) Then
                                    ind = 9
                                Else
                                    ind = 0
                                End If
                                funSupr = funSupr + Choose(edi + ind, "один", "два", _
                                "три", "четыре", "пять", "шесть", "семь", "восемь", "девять", "одна", _
                                "две") + " "
                            End If
                            Select Case edi
                                Case 1
                                    ind = 1
                                Case 2, 3, 4
                                    ind = 2
                                Case Else
                                    ind = 3
                            End Select
                        End If
                        funSupr = funSupr + Choose((i - 1) * 3 + ind, "рубль", "рубля", _
                        "рублей", "тысяча", "тысячи", "тысяч", "миллион", "миллиона", "миллионов", _
                        "миллиард", "миллиарда", "миллиардов", "триллион", "триллиона", _
                        "триллионов") + " "
                    End If
                Next i
            End If
            ssu = Right$(Format$(xsu, "0.00"), 2)
            des = Val(Left$(ssu, 1))
            edi = Val(Right$(ssu, 1))
            If des = 1 Then
                ind = 3
            Else
                Select Case edi
                    Case 1
                        ind = 1
                    Case 2, 3, 4
                        ind = 2
                    Case Else
                        ind = 3
                End Select
            End If
            funSupr = funSupr + ssu + Choose(ind, " копейка", " копейки", " копеек")
            If mb = 0 Then
                funSupr = UCase$(Left$(funSupr, 1)) + Mid$(funSupr, 2)
            End If
            Exit Function
ersupr:
            funSupr = "ошибка"
        End Function

        Public Sub Log(whoLog As String, whatLog As String, whenLog As String, resultLog As String)
            Dim sqlf As New SqlFunctions
            Dim com As New SqlClient.SqlCommand
            com.CommandText = "INSERT INTO UserModules.[user].[LOG] ([WHO],[WHAT],[WHEN],[RESULT]) VALUES (@WHO, @WHAT, @WHEN, @RESULT)"
            With com.Parameters
                .AddWithValue("WHO", whoLog)
                .AddWithValue("WHAT", whatLog)
                .AddWithValue("WHEN", whenLog)
                .AddWithValue("RESULT", resultLog)
            End With
            sqlf.NonQuery(com)
        End Sub

    End Class

    Public Class weekOfYear
        Private _year As Integer = 1900
        Private _weekNumber As Integer = 1
        Private _firstDayOfWeek As Date = Nothing

        Public Property yearAndWeek As String
            Set(value As String)
                If value.ToString.Length = 6 Then
                    _year = Convert.ToInt16(value.ToString.Substring(0, 4))
                    _weekNumber = Convert.ToInt16(value.ToString.Substring(4, 2))
                    _firstDayOfWeek = FirstDateOfWeekISO8601(_year, _weekNumber)
                End If
            End Set
            Get
                Return Convert.ToInt32(_year.ToString & _weekNumber.ToString.PadLeft(2, "0"))
            End Get
        End Property

        Public ReadOnly Property firstDateOfWeek As Date
            Get
                Return _firstDayOfWeek
            End Get
        End Property

        Public ReadOnly Property monthNumber As Integer
            Get
                Return _firstDayOfWeek.Month
            End Get
        End Property

        Public ReadOnly Property monthName As String
            Get
                Return _firstDayOfWeek.ToString("MMMM", CultureInfo.InvariantCulture)
            End Get
        End Property

        Public Shared Function FirstDateOfWeekISO8601(year As Integer, weekNumber As Integer) As Date
            Dim jan1 As Date = New Date(year, 1, 1)
            Dim daysOffSet = DayOfWeek.Thursday - jan1.DayOfWeek
            Dim firstThursday As Date = jan1.AddDays(daysOffSet)
            Dim cal = CultureInfo.CurrentCulture.Calendar
            Dim firstWeek As Integer = cal.GetWeekOfYear(firstThursday, CalendarWeekRule.FirstFourDayWeek, DayOfWeek.Monday)

            Dim weekNum As Integer = weekNumber
            If firstWeek <= 1 Then
                weekNum -= 1
            End If
            Dim result As Date = firstThursday.AddDays(weekNum * 7)
            Return result.AddDays(-3)
        End Function

        Public Shared Function WeekStartEnd(week As Integer, mode As Boolean, year As String, fdow As Microsoft.VisualBasic.FirstDayOfWeek) As Date 'mode false - Week Start, true  - Week end
            Dim selectDate As Date = Date.ParseExact(year & "0101", "yyyyMMdd", CultureInfo.InvariantCulture)
            Dim Days As Integer = DatePart(DateInterval.Weekday, selectDate, fdow) - fdow
            Dim week_start As Date = selectDate.AddDays(-Days)
            If week_start.Year < selectDate.Year Then
                week_start = week_start.AddDays(7)
            End If
            Dim week_end As Date = week_start.AddDays(6)
            week_start = week_start.AddDays(7 * (week - 2) - 1)
            week_end = week_end.AddDays(7 * (week - 2) - 1)

            If mode Then
                Return week_end
            Else
                Return week_start
            End If
        End Function
    End Class

    Public Class Mailer
        Enum MailMessagePart
            ToAddress
            FromAddress
            Subject
            Message
        End Enum

        Public Function send(fromAddress As String, toAddress As String, subject As String, body As String, Optional att As String = "") As String
            ' Set mailServerName to be the name of the mail server
            ' you wish to use to deliver this message
            Const mailServerName As String = "smtp.w1.samsung.com"
            Try
                ' MailMessage is used to represent the e-mail being sent
                Using m As New MailMessage() 'fromAddress, "", subject, body)
                    m.From = New MailAddress(fromAddress)

                    Dim aList() As String = toAddress.Split(";")
                    For Each address In aList
                        If address.Trim <> "" Then
                            m.To.Add(address)
                        End If
                    Next
                    m.Subject = subject
                    m.Body = body
                    m.IsBodyHtml = True

                    If att <> "" Then
                        Dim attList() As String = att.Split(";")
                        For Each AttachmentFile In attList
                            Dim a As New Attachment(AttachmentFile, MediaTypeNames.Application.Octet)
                            m.Attachments.Add(a)
                        Next
                    End If

                    ' SmtpClient is used to send the e-mail
                    Dim mailClient As New SmtpClient(mailServerName)

                    mailClient.Credentials = New NetworkCredential("serk.notify", "samsung1")
                    mailClient.UseDefaultCredentials = False
                    'mailClient.EnableSsl = True

                    ' UseDefaultCredentials tells the mail client to use the 
                    ' Windows credentials of the account (i.e. user account) 
                    ' being used to run the application

                    'mailClient.UseDefaultCredentials = True

                    ' Send delivers the message to the mail server
                    mailClient.Send(m)
                End Using
                'Return "Sended to " & toAddress

            Catch ex As FormatException
                Return ex.Message
            Catch ex As SmtpException
                Return ex.Message
            End Try
            Return "Send"

        End Function
    End Class

    Public Class powerTable
        Public Property pt As Table
        Public Property hLinkTemplate As String = ""

        Public TemplateFields() As String
        Public TemplateIndexes() As Integer
        Public TemplateValues() As String
        Public TemplateMode() As String
        Public HiddenColumn() As String
        Public Property TemplateColNumber As Integer

        Public Property Width() As Unit
            Get
                Return pt.Width
            End Get
            Set(ByVal value As Unit)
                pt.Width = value
            End Set
        End Property

        Public Property CellPadding() As Integer
            Get
                Return pt.CellPadding
            End Get
            Set(ByVal value As Integer)
                pt.CellPadding = value
            End Set
        End Property

        Public Property CellSpacing() As Integer
            Get
                Return pt.CellSpacing
            End Get
            Set(ByVal value As Integer)
                pt.CellSpacing = value
            End Set
        End Property

        Public Property myPage As Page
        Public Property TableStyle As Style
        Public Property HeaderStyle As Style
        Private Property howerColor As String = "#B5C6FF"

        Public Sub New(ByVal tb As Table)
            pt = tb
            TableStyle = New Style
            HeaderStyle = New Style
            pt.Width = Width
            pt.CellPadding = CellPadding
            pt.CellSpacing = CellSpacing
        End Sub

        Public Sub New()
            pt = Nothing
            TableStyle = New Style
            HeaderStyle = New Style
        End Sub

        Public Sub DrawTable(ByVal dt As DataTable, Optional ByVal mode As String = "text",
                              Optional ByVal enableRowHower As Boolean = True)
            Dim dr As DataRow
            Dim tr As TableRow
            Dim bColorFlag As Boolean = False
            Dim i As Integer = 0
            If enableRowHower Then
                RegisterJava(myPage)
            End If
            tr = CreateHeaderRow(dt)
            tr.ApplyStyle(HeaderStyle)
            pt.Rows.Add(tr)
            For Each dr In dt.Rows
                Select Case mode
                    Case "text" : tr = CreateTextRow(dr)
                    Case "hLink" : tr = CreatehLinkRow(dr, hLinkTemplate, 1, TemplateMode)
                    Case Else : tr = CreateTextRow(dr)
                End Select
                If enableRowHower Then
                    If bColorFlag Then
                        SetRowColor(tr, "EEEEEE")
                    Else
                        SetRowColor(tr, "FFFFFF")
                    End If
                End If
                pt.Rows.Add(tr)
                bColorFlag = Not bColorFlag
            Next
            pt.ApplyStyle(TableStyle)
        End Sub

        Private Function CreateTextRow(ByVal dr As DataRow) As TableRow
            Dim dt As DataTable = dr.Table
            Dim tr As TableRow
            tr = CreateRowTemplate(dt)
            For i = 0 To dr.ItemArray.Length - 1
                tr.Cells(i).Text = dr.ItemArray(i).ToString
            Next
            Return tr
        End Function

        Private Function CreatehLinkRow(ByVal dr As DataRow, ByVal hLinkTemplate As String, ByVal hLinkStartCell As Integer,
                                         Optional ByVal mode() As String = Nothing) As TableRow
            Dim dt As DataTable = dr.Table
            Dim tr As TableRow
            Dim s As String = hLinkTemplate
            tr = CreateRowTemplate(dt)
            For i = 0 To dr.ItemArray.Length - 1
                If i >= hLinkStartCell Then
                    SetTemplateValues(TemplateValues, dr, mode, TemplateColNumber, i)
                    tr.Cells(i).Controls.Add(CreateHLink(dr.ItemArray(i).ToString,
                                                            PreparehLinkFromTemplate(s, TemplateFields, TemplateValues,
                                                                                      TemplateIndexes, dr)))
                Else
                    tr.Cells(i).Text = dr.ItemArray(i).ToString
                End If
            Next
            Return tr
        End Function

        Private Function PreparehLinkFromTemplate(ByVal hlinkTemplate As String, ByVal params() As String,
                                                   Optional ByVal paramsValues() As String = Nothing,
                                                   Optional ByVal indexes() As Integer = Nothing,
                                                   Optional ByVal dr As DataRow = Nothing) As String
            Dim i As Integer
            If IsNothing(paramsValues) Then
                For i = 0 To params.Length - 1
                    hlinkTemplate = hlinkTemplate.Replace(params(i), dr.Item(indexes(i)))
                Next
            Else
                For i = 0 To params.Length - 1
                    hlinkTemplate = hlinkTemplate.Replace(params(i), paramsValues(i))
                Next
            End If
            Return hlinkTemplate
        End Function

        Private Sub SetTemplateValues(ByRef templateValues() As String, ByVal dr As DataRow, ByVal mode() As String,
                                       Optional ByVal colNumber As Integer = 0, Optional ByVal colOfset As Integer = 0)
            Dim i As Integer
            For i = 0 To mode.Length - 1
                Select Case mode(i)
                    Case "c" : templateValues(i) = dr.Table.Columns(colOfset).ColumnName
                    Case "r" : templateValues(i) = dr.ItemArray(i).ToString
                    Case "f" : templateValues(i) = dr.ItemArray(colNumber).ToString
                End Select
            Next
        End Sub

        Private Function CreateRowTemplate(ByVal dt As DataTable) As TableRow
            Dim dc As DataColumn
            Dim tr As New TableRow
            For Each dc In dt.Columns
                Dim tc As New TableCell
                tr.Cells.Add(tc)
            Next
            Return tr
        End Function

        Private Function CreateHLink(ByVal txt As String, ByVal hlinkUrl As String) As HyperLink
            Dim hlink As New HyperLink
            hlink.NavigateUrl = hlinkUrl
            hlink.Text = txt
            Return hlink
        End Function

        Private Function CreateHLinkCell(ByVal txt As String, ByVal hlinkUrl As String) As TableCell
            Dim hlink As New HyperLink
            hlink.NavigateUrl = hlinkUrl
            hlink.Text = txt
            Dim c As New TableCell
            c.Controls.Add(hlink)
            Return c
        End Function

        Private Function CreateHeaderRow(ByVal dt As DataTable) As TableRow
            Dim dc As DataColumn
            Dim tr As New TableRow
            For Each dc In dt.Columns
                Dim tc As New TableCell
                tc.Text = dc.ColumnName
                tr.Cells.Add(tc)
            Next
            Return tr
        End Function

        Public Sub RegisterJava(ByVal p As Page)
            Const csname As String = "rowHowerScript"
            Dim cstype As Type = Me.GetType()
            Dim cs As ClientScriptManager = p.ClientScript
            If (Not cs.IsClientScriptBlockRegistered(cstype, csname)) Then
                Dim cstext2 As New StringBuilder()
                cstext2.Append("<script type=""text/javascript"">")
                cstext2.Append("function MOver(MySrc,MyColor) { MySrc.style.cursor=""auto""; MySrc.bgColor=MyColor; }")
                cstext2.Append("function MOut (MySrc,MyColor) { MySrc.style.cursor=""auto""; MySrc.bgColor=MyColor; }")
                cstext2.Append("</script>")
                cs.RegisterClientScriptBlock(cstype, csname, cstext2.ToString(), False)
            End If
        End Sub

        Private Sub SetRowColor(ByRef tr As TableRow, Optional ByVal color As String = "")
            tr.Attributes("bgColor") = color
            tr.Attributes("onMouseOut") = "MOut(this,'#" & color & "')"
            tr.Attributes("onMouseOver") = "MOver(this,'" & howerColor & "')"
        End Sub
    End Class


End Namespace