MailRobotService/MailRobotService.vb - master - AstroJohn/MailRobot

MailRobotService/MailRobotService.vb
380 строк13 KB
AstroJohn
wcf service update
02 сен 2025, 10:48
02 сен 2025, 10:488079c17
Imports System.ServiceModel
Imports System.Configuration
Imports System.ServiceModel.Description
Imports System.ServiceProcess
Imports System.Collections.Generic
Imports System.IO
Imports System.Text
Imports System.Threading.Tasks
Imports System.Xml
Imports Common
Imports CsConfig
Imports Microsoft.Win32
Imports MailRobot.Checker
Imports MailRobot.WcfMailRobotService
Imports System.Threading

Public Class MailRobotService
    Inherits ServiceBase

    Private Const EncodingCp1251 As Integer = 1251

    Private _period As Integer '������ �������� ����� ����� � ������������� (������ �������)
    Private _periodRecalc As Integer '������ ������������ �������� � �������
    Private ReadOnly _cfgFilePath As New List(Of String)
    Private _checker As EmailChecker
    Private ReadOnly _correctLogs As New List(Of Integer)
    Private ReadOnly _correctLogsAtLastCrosscheck As New List(Of Integer)
    Private ReadOnly _timeAtLastCrosscheck As New List(Of Date)
    Private _mainPath As String
    Private _timer As Timers.Timer

#Region " Component Designer generated code "

    Public Sub New()

        MyBase.New()

        InitializeComponent()

    End Sub

    'UserService overrides dispose to clean up the component list.
    Protected Overloads Overrides Sub Dispose(disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub

    ' The main entry point for the process
    <MTAThread()>
    Shared Sub Main()
        Dim ServicesToRun() As ServiceBase

        ' More than one NT Service may run within the same process. To add
        ' another service to this process, change the following line to
        ' create a second service object. For example,
        '
        '   ServicesToRun = New ServiceBase () {New Service1, New MySecondUserService}
        '
        ServicesToRun = New ServiceBase() {New MailRobotService}

        Run(ServicesToRun)
    End Sub

    'Required by the Component Designer
    Private components As ComponentModel.IContainer

    ' NOTE: The following procedure is required by the Component Designer
    ' It can be modified using the Component Designer.  
    ' Do not modify it using the code editor.
    <DebuggerStepThrough()> Private Sub InitializeComponent()
        '
        'MailRobotService
        '
        ServiceName = "MailRobotService"

    End Sub

#End Region

    Protected Overrides Sub OnStart(args() As String)

        Try

            _mainPath = Path.GetDirectoryName(Reflection.Assembly.GetExecutingAssembly().GetName().CodeBase).Substring(6)

            _cfgFilePath.Add(Path.Combine(Path.Combine(_mainPath, ConfigReader.ConfigFolderName), "MailRobot.Config.xml"))

            Dim regKey As RegistryKey

            regKey = Registry.LocalMachine.OpenSubKey(ConfigReader.RegistryKeyPath, True)

            If regKey Is Nothing Then
                regKey = Registry.LocalMachine.OpenSubKey(ConfigReader.RegistryKeyPath32Bit, True)
            End If

            If Not (regKey Is Nothing) Then

                _period = CType(regKey.GetValue(ConfigReader.PeriodRegistryValueName, 2), Integer) '2 ������
                _periodRecalc = CType(regKey.GetValue(ConfigReader.RecalcRegistryValueName, 30), Integer) '30 �����

                Dim i As Integer = 0

                Do
                    i = i + 1

                    If i = 1 Then
                        _cfgFilePath(0) = regKey.GetValue(ConfigReader.XmlConfigFileNameRegistryValueName, _cfgFilePath(0)).ToString()
                    Else
                        _cfgFilePath.Add(regKey.GetValue(ConfigReader.XmlConfigFileNameRegistryValueName + (i - 1).ToString).ToString())
                    End If

                Loop Until Not regKey.GetValueNames.Contains(ConfigReader.XmlConfigFileNameRegistryValueName + i.ToString)

                regKey.Close()

            End If

            For Each fileName As String In _cfgFilePath
                If Not My.Computer.FileSystem.FileExists(fileName) Then
                    Throw New Exception(String.Format("���� ������������ {0} �� ������.", fileName))
                End If
            Next

            CmdRun()

            StartWcfService()

        Catch ex As Exception
            Dim msg As String = "������ ������� ������ MailRobotService: " + ex.Message + Environment.NewLine + ex.StackTrace
            While Not ex.InnerException Is Nothing
                msg = msg + Environment.NewLine + ex.InnerException.Message
                msg = msg + Environment.NewLine + ex.InnerException.StackTrace
                ex = ex.InnerException
            End While
            EventLog.WriteEntry(msg, EventLogEntryType.Error)
            Throw
        End Try

    End Sub

    Private Sub StartWcfService()

        If Not ServiceHost Is Nothing Then
            ServiceHost.Close()
        End If

        Dim httpBaseAddress As Uri = New Uri(ConfigurationManager.AppSettings("HttpBaseAddress"))
        Dim binding As New BasicHttpBinding()
        Dim quotas As New XmlDictionaryReaderQuotas
        quotas.MaxArrayLength = 2147483647
        binding.ReaderQuotas = quotas

        ServiceHost = New ServiceHost(GetType(CheckLogService))

        ServiceHost.AddServiceEndpoint(GetType(ICheckLogService), binding, httpBaseAddress)

        Dim serviceBehavior As New ServiceMetadataBehavior
        serviceBehavior.HttpGetEnabled = True
        serviceBehavior.HttpGetUrl = httpBaseAddress
        ServiceHost.Description.Behaviors.Add(serviceBehavior)

        ServiceHost.Open()

    End Sub

    Public Property ServiceHost As ServiceHost

    Private Sub CmdRun()
        Try

            _timer = New Timers.Timer(_period * 60000)
            AddHandler _timer.Elapsed, AddressOf Timer_Elapsed

            Dim msg As String =
                "������ MailRobotService �������� � ��������� {0} � {1} ���." _
                + Environment.NewLine _
                + "���� � ����������: {2}" _
                + Environment.NewLine _
                + "���� � ����� ������������: {3}"

            Dim filePaths As String = String.Empty

            Dim i As Integer = 0

            For Each filePath As String In _cfgFilePath
                i = i + 1
                If i <> 1 Then
                    filePaths = filePaths + Environment.NewLine
                End If
                filePaths = filePaths + filePath
                _correctLogs.Add(0)
                _correctLogsAtLastCrosscheck.Add(0)
                _timeAtLastCrosscheck.Add(Now)
            Next

            EventLog.WriteEntry(String.Format(msg, _period, _periodRecalc, _mainPath, filePaths), EventLogEntryType.Information)

            _timer.Start()

        Catch ex As Exception
            EventLog.WriteEntry("������ � ������ MailRobotService: " + ex.Message, EventLogEntryType.Error)
        End Try

    End Sub

    Protected Overrides Sub OnStop()
        Try           ' Add code here to perform any tear-down necessary to stop your service.
            _timer.Stop()
            _timer = Nothing
            _checker = Nothing

            If Not ServiceHost Is Nothing Then
                ServiceHost.Close()
                ServiceHost = Nothing
            End If

        Catch ex As Exception
            EventLog.WriteEntry("������ � ������ MailRobotService: " + ex.Message, EventLogEntryType.Error)
        End Try
    End Sub

    Private Function CheckMessages() As Task(Of Integer)

        Dim newlogs As Integer

        Try
            newlogs = _checker.CheckMessages()
        Catch ex As Exception
            newlogs = 0
            EventLog.WriteEntry("MailRobotService: ������ �������� ����� ����� � ��������: " + ex.GetLoggingTrace(), EventLogEntryType.Error)
        End Try

        Return Task.FromResult(newlogs)

    End Function

    Private Function Completed() As Task(Of Integer)

        Return Task.FromResult(0)

    End Function


    Private Function Delay(timeout As Integer) As Task(Of Integer)

        Dim tcs As TaskCompletionSource(Of Integer) = New TaskCompletionSource(Of Integer)

        Task.Delay(timeout).ContinueWith(Function(t) Completed())

        Return tcs.Task

    End Function


    Private Async Sub Timer_Elapsed(myObject As Object, myEventArgs As Timers.ElapsedEventArgs)
        Try

            _timer.Stop()

            Dim i As Integer = 0

            For Each filePath As String In _cfgFilePath

                EventLog.WriteEntry("MailRobotService: ��������� " + filePath, EventLogEntryType.Information)

                Dim ir As New ConfigReader(filePath)

                If ir.LoadConfig() Then
                    _checker = New EmailChecker(ir.CheckerParameters, , Me)
                End If

                EventLog.WriteEntry($"MailRobotService: ������ �������� ����������� ����� {ir.CheckerParameters.ParserParameters.ContestName}", EventLogEntryType.Information)

                Dim newlogs As Integer

                Const timeout As Integer = 120000 ' 120 ���. �� = 2 ���.

                Try
                    ' newlogs = Await CheckMessages()

                    Dim task As Task(Of Integer) = CheckMessages()

                    Dim completedTask As Task = Await Tasks.Task.WhenAny(task, Delay(timeout))

                    If completedTask Is task Then

                        ' Task completed within timeout.
                        ' Consider that the task may have faulted Or been canceled.
                        ' We re-await the task so that any exceptions/cancellation Is rethrown.
                        newlogs = task.Result
                        EventLog.WriteEntry($"MailRobotService: �������� �������� ����������� ����� {ir.CheckerParameters.ParserParameters.ContestName}, ����� �����: {newlogs:D}.", EventLogEntryType.Information)

                    Else
                        newlogs = 0
                        EventLog.WriteEntry($"MailRobotService: ������� �������� ����� ����� � �������� {ir.CheckerParameters.ParserParameters.ContestName} (2 ������).", EventLogEntryType.Warning)
                    End If
                Catch ex As Exception
                    newlogs = 0
                    EventLog.WriteEntry($"MailRobotService: ������ �������� ����� ����� � �������� {ir.CheckerParameters.ParserParameters.ContestName}: " + ex.GetLoggingTrace(), EventLogEntryType.Error)
                End Try

                _correctLogs(i) = _correctLogs(i) + newlogs

                If (_correctLogsAtLastCrosscheck(i) = 0 _
                    And _correctLogs(i) > 0) _
                OrElse (_correctLogsAtLastCrosscheck(i) < _correctLogs(i) _
                        AndAlso Math.Abs(DateDiff(DateInterval.Minute, _timeAtLastCrosscheck(i), Date.Now)) >= _periodRecalc) Then

                    EventLog.WriteEntry("MailRobotService: ������ ��������� ����������� � �� �������", EventLogEntryType.Information)

                    AddHandler _checker.LogScoringGate.KeepInTouch, AddressOf WriteFileLog

                    Try

                        Dim watch As New Stopwatch
                        watch.Start()
                        _checker.LogScoringGate.RescoreResults(False)
                        watch.Stop()
                        Dim elapsed As Integer = Convert.ToInt32(Math.Round(watch.ElapsedMilliseconds / 1000.0, 0, MidpointRounding.AwayFromZero))
                        WriteFileLog($"������������ �������� ��������� �� {elapsed:D} ���.")

                        Dim resultsOnly As Boolean = Not _checker.FtpAutoSave

                        _checker.SaveResults(resultsOnly:=resultsOnly)
                        _checker.UploadResults(resultsOnly)

                    Catch ex As Exception
                        EventLog.WriteEntry("������ ��������� ����������� � �� ������� � ������ MailRobotService: " + ex.GetLoggingTrace(), EventLogEntryType.Error)
                    Finally
                        RemoveHandler _checker.LogScoringGate.KeepInTouch, AddressOf WriteFileLog
                    End Try

                    _correctLogsAtLastCrosscheck(i) = _correctLogs(i)
                    _timeAtLastCrosscheck(i) = Date.Now()
                End If

                i = i + 1

            Next

            EventLog.WriteEntry("MailRobotService: ��������� ������� ���������", EventLogEntryType.Information)

        Catch ex As Exception
            EventLog.WriteEntry("������ � ������ MailRobotService: " + ex.Message, EventLogEntryType.Error)
        Finally
            _timer.Enabled = True
        End Try
    End Sub

    Private Sub WriteLog(text As string)
        EventLog.WriteEntry(text, EventLogEntryType.Error)
    End Sub

    Private Sub WriteFileLog(message As String)
        Dim fileName As String
        Dim file As FileStream = Nothing
        Dim writer As StreamWriter = Nothing
        Try
            fileName = _checker.Parameters.GetWorkingDirectoryPath() + "\" + _checker.Parameters.MailRobot_Log_FileName
            file = New FileStream(fileName, FileMode.Append)
            writer = New StreamWriter(file, Encoding.GetEncoding(EncodingCp1251))
            message = Now.ToString("dd.MM.yyyy HH:mm:ss") + ": " + message
            writer.WriteLine(message)
        Catch ex As Exception
            WriteLog("������ � ������ """ + ServiceName + """: " + message)
        Finally
            If Not writer Is Nothing Then
                writer.Close()
            End If
            If Not file Is Nothing Then
                file.Close()
            End If
        End Try
    End Sub

End Class