构建了一个服务，但内存不断攀升

Question

我构建了一个查看数据库的服务，如果缺少参数，它会添加它。然后，它在读取其他参数时确保文件夹存在，如果不存在，则创建它们。然后，如果某个文件夹中存在文件，则会将其移动到另一个文件夹中进行处理。

我遇到的问题是，随着运行多天，内存会不断攀升。它从 35k 爬升至 1000 兆。

如有任何反馈，我们将不胜感激

这是代码

Imports log4net
Imports log4net.Config
Imports System.Configuration
Imports System.IO
Imports System.Reflection
Imports System.Security.AccessControl
Imports System.Security.Principal
Imports System.Threading
Imports System.Data.SqlClient
Imports Microsoft


Public Class EDIService
    Implements IDisposable

    Private Shared ReadOnly _log As ILog = LogManager.GetLogger(GetType(EDIService))

    Dim strStorageFolder As String = Environment.GetFolderPath(Environment.SpecialFolder.CommonApplicationData)
    Dim strWorkFolder As String = strStorageFolder & "\EDIService"
    Dim strLogFolder As String = strWorkFolder & "\Log"

    Dim objDSMS As DataSet
    Dim objDTMS As DataTable
    Dim objDSMT As DataSet
    Dim objDTMT As DataTable
    Dim objDSP As DataSet
    Dim objDTP As DataTable

    Private stopping As Boolean
    Private stoppedEvent As ManualResetEvent


    Public Sub New()
        InitializeComponent()
        'Init the log for net settings (must have in 4.0 Framework)
        log4net.Config.XmlConfigurator.Configure()
        Me.stopping = False
        Me.stoppedEvent = New ManualResetEvent(False)

        StartUp()

    End Sub

#Region " On Start "
    ''' <summary>
    ''' The function is executed when a Start command is sent to the service
    ''' by the SCM or when the operating system starts (for a service that 
    ''' starts automatically). It specifies actions to take when the service 
    ''' starts. In this code sample, OnStart logs a service-start message to 
    ''' the Application log, and queues the main service function for 
    ''' execution in a thread pool worker thread.
    ''' </summary>
    ''' <param name="args">Command line arguments</param>
    ''' <remarks>
    ''' A service application is designed to be long running. Therefore, it 
    ''' usually polls or monitors something in the system. The monitoring is 
    ''' set up in the OnStart method. However, OnStart does not actually do 
    ''' the monitoring. The OnStart method must return to the operating 
    ''' system after the service's operation has begun. It must not loop 
    ''' forever or block. To set up a simple monitoring mechanism, one 
    ''' general solution is to create a timer in OnStart. The timer would 
    ''' then raise events in your code periodically, at which time your 
    ''' service could do its monitoring. The other solution is to spawn a 
    ''' new thread to perform the main service functions, which is 
    ''' demonstrated in this code sample.
    ''' </remarks>
    Protected Overrides Sub OnStart(ByVal args() As String)
        ' Log a service start message to the Application log.
        _log.Info("EDI Service in OnStart.")

        ' Queue the main service function for execution in a worker thread.
        ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf ServiceWorkerThread))

    End Sub
#End Region

#Region " Startup "
    Public Sub StartUp()
        Try

            'Dim applicationName As String = Environment.GetCommandLineArgs()(0)
            'Dim exePath As String = System.IO.Path.Combine(Environment.CurrentDirectory, applicationName)
            'Dim cfg As Configuration = ConfigurationManager.OpenExeConfiguration(exePath)
            ''XmlConfigurator.Configure(New System.IO.FileInfo(Application.ExecutablePath + ".config"))
            '_log.Info("Got the config file " & cfg.ToString)

            _log.Info("--------------------------------------------------------------------------------")
            _log.Info("New Startup Date: " & Format(Now(), "yyyy-MM-dd HH:mm:ss"))
            _log.Info("--------------------------------------------------------------------------------")

            'set folder to be accessable from authenticated users
            Dim folderinfolog As DirectoryInfo = New DirectoryInfo(strLogFolder)
            Dim folderinfowork As DirectoryInfo = New DirectoryInfo(strWorkFolder)

            'Check to make sure log folder is there first
            If Not folderinfolog.Exists Then
                Directory.CreateDirectory(strLogFolder)
                _log.Info("Created Folder " & folderinfolog.ToString)
            End If

            If Not folderinfowork.Exists Then
                Directory.CreateDirectory(strWorkFolder)
                _log.Info("Created Folder " & folderinfowork.ToString)
            End If

            _log.Info("Setting folder and files permissions")
            Dim folderacllog As New DirectorySecurity(strLogFolder, AccessControlSections.Access)
            folderacllog.AddAccessRule(New FileSystemAccessRule(New SecurityIdentifier(WellKnownSidType.BuiltinUsersSid, Nothing), FileSystemRights.FullControl, InheritanceFlags.ContainerInherit Or InheritanceFlags.ObjectInherit, PropagationFlags.None, AccessControlType.Allow))
            folderinfolog.SetAccessControl(folderacllog)

            Dim folderaclwork As New DirectorySecurity(strWorkFolder, AccessControlSections.Access)
            folderaclwork.AddAccessRule(New FileSystemAccessRule(New SecurityIdentifier(WellKnownSidType.BuiltinUsersSid, Nothing), FileSystemRights.FullControl, InheritanceFlags.ContainerInherit Or InheritanceFlags.ObjectInherit, PropagationFlags.None, AccessControlType.Allow))
            folderinfowork.SetAccessControl(folderaclwork)


            ' Queue the main service function for execution in a worker thread.
            ' Uncomment to run manually
            'ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf ServiceWorkerThread))

        Catch ex As Exception
            _log.Error(ex.ToString & vbCrLf & ex.StackTrace.ToString)

        End Try
    End Sub
#End Region

#Region "Loop Message Systems"
    Public Sub LoopMessageSystems()
        Try

            Dim builder As New SqlConnectionStringBuilder()
            builder.DataSource = My.Settings.MsSQLHostName
            _log.Info("Set the MsSQL Hostname to " & My.Settings.MsSQLHostName)
            builder.InitialCatalog = My.Settings.MsSQLDataBaseName
            _log.Info("Set the MsSQL Database Name to " & My.Settings.MsSQLDataBaseName)
            builder.IntegratedSecurity = True
            builder.MultipleActiveResultSets = True

            Using comm As New SqlConnection(builder.ConnectionString)
                Try
                    comm.Open()
                    If comm.State Then
                        _log.Info("Connected to SQL Database...")
                    Else
                        _log.Error("Not connected to SQL Database...")
                        Return
                    End If

                    'Clean up logs files
                    Dim logFiles As String() = Directory.GetFiles(strLogFolder)
                    For Each logFile As String In logFiles
                        Dim fileInfo As New FileInfo(logFile)

                        'set file to be accessable from authenticated users
                        'Dim fileacl As New FileSecurity(fileInfo.FullName, AccessControlSections.Access)
                        'fileacl.AddAccessRule(New FileSystemAccessRule(New SecurityIdentifier(WellKnownSidType.AuthenticatedUserSid, Nothing), FileSystemRights.FullControl, AccessControlType.Allow))
                        'fileInfo.SetAccessControl(fileacl)

                        If fileInfo.CreationTime < DateTime.Now.AddMonths("-" & My.Settings.PurgeLogFilesMonth) Then
                            _log.Info("Found Log file(s) that are more then " & My.Settings.PurgeLogFilesMonth & " month old to delete " & fileInfo.ToString)

                            _log.Info("Verifying that the old file ends with .txt")
                            If fileInfo.Name.Contains(".txt") Then
                                fileInfo.Delete()
                                _log.Info("Deleted the file " & fileInfo.Name.ToString)
                            Else
                                _log.Info("Did not delete the file " & fileInfo.Name.ToString)
                            End If
                        Else
                            _log.Info("This file" & fileInfo.Name.ToString & " is not older then " & My.Settings.PurgeLogFilesMonth & " month")
                        End If

                    Next

                    'Clean up work files
                    Dim strFiles As String() = Directory.GetFiles(strWorkFolder)
                    For Each strFile As String In strFiles
                        Dim fileInfo As New FileInfo(strFile)

                        'set file to be accessable from authenticated users
                        'Dim fileacl As New FileSecurity(fileInfo.FullName, AccessControlSections.Access)
                        'fileacl.AddAccessRule(New FileSystemAccessRule(New SecurityIdentifier(WellKnownSidType.AuthenticatedUserSid, Nothing), FileSystemRights.FullControl, AccessControlType.Allow))
                        'fileInfo.SetAccessControl(fileacl)

                        If fileInfo.CreationTime < DateTime.Now.AddMonths("-" & My.Settings.PurgeLogFilesMonth) Then
                            _log.Info("Found file(s) that are more then " & My.Settings.PurgeLogFilesMonth & " month old to delete " & fileInfo.ToString)
                            fileInfo.Delete()
                            _log.Info("Deleted the file " & fileInfo.Name.ToString)
                        End If
                    Next

                    _log.Info("Building a list of active message systems")
                    Dim command As SqlCommand = Nothing
                    Dim sqlda As SqlDataAdapter = Nothing

                    Dim strSQL = "select * from mscmessagesystem where adapter='Folder' and status =0"
                    '_log.Info(strSQL)

                    command = New SqlCommand(strSQL, comm)
                    command.CommandType = CommandType.Text
                    command.CommandTimeout = 0
                    sqlda = New SqlDataAdapter
                    sqlda.SelectCommand = command
                    objDSMS = New DataSet
                    sqlda.Fill(objDSMS)

                    objDTMS = objDSMS.Tables(0)
                    objDTP = New DataTable
                    objDTP.Columns.Add("SectionID", Type.GetType("System.Int32"))
                    objDTP.Columns.Add("Name", Type.GetType("System.String"))
                    objDTP.Columns.Add("Value", Type.GetType("System.String"))

                    Dim pr As DataRow = objDTP.NewRow

                    Dim intInputFileCount As Int32 = 0
                    Dim strInputFolder As String = ""
                    Dim strEDIServiceFolder As String

                    For Each msr As DataRow In objDTMS.Rows

                        _log.Info("Looking at message system parameter called " & msr.Item("Name"))

                        strSQL = "select sectionID,[Name],Value from infParameter where sectionID = " & msr.Item("sectionID").ToString & " and ([name] like 'Input Folder Name%' or [name] like 'EDIService Folder%') order by ID asc"
                        '_log.Info(strSQL)

                        command = New SqlCommand(strSQL, comm)
                        command.CommandType = CommandType.Text
                        command.CommandTimeout = 0
                        sqlda = New SqlDataAdapter
                        sqlda.SelectCommand = command
                        objDSP = New DataSet
                        sqlda.Fill(objDSP)
                        objDTP = objDSP.Tables(0)

                        For Each r As DataRow In objDTP.Rows

                            If objDTP.Rows.Count < 2 Then
                                _log.Info("Looks like we do not have a EDIService Folder setup")
                                strSQL = "INSERT INTO [dbo].[infParameter]
                                       ([mainttime]
                                       ,[userID]
                                       ,[name]
                                       ,[scope]
                                       ,[value]
                                       ,[comments]
                                       ,[sectionID]
                                       ,[helpcontextid]
                                       ,[isaudited]
                                       ,[datatype]
                                       ,[allowpersonalvalues]
                                       ,[allowgroupvalues]
                                       ,[allowplantvalues]
                                       ,[parametertype]
                                       ,[obsolete]
                                       ,[enumeration]
                                       ,[businessClassID]
                                       ,[configurationchangereference]
                                       ,[configurationnotes])
                                 VALUES
                                       (getdate(),system_user,'EDIService Folder',0,'',null," & r.Item("SectionID") & ",null,-1,0,null,null,null,0,null,null,null,null,null)"
                                command = New SqlCommand(strSQL, comm)
                                command.CommandType = CommandType.Text
                                command.CommandTimeout = 0
                                command.ExecuteNonQuery()
                                _log.Info("Added the EDIService folder to the section ID " & r.Item("SectionID"))
                                Exit For
                            End If

                            _log.Info("Looking at infparameter row ID " & String.Join(", ", r.ItemArray))


                            If r.Item("Name") = "Input Folder Name" Then
                                If IsDBNull(r.Item("value")) Then
                                    _log.Info("The input folder is null for message system named " & msr.Item("Name") & ", you must have it set moving on to the next one")
                                    Exit For
                                End If
                                If r.Item("Name") = "Input Folder Name" AndAlso r.Item("Value") = Nothing Then
                                    _log.Info("The input folder does not have a value for message system named " & msr.Item("Name") & ", you must have it set")
                                    Exit For
                                Else
                                    _log.Info("The input folder does have a value set as " & r.Item("Value") & " continue to verify the Input Folder")
                                    strInputFolder = r.Item("value")
                                    If Not strInputFolder = Nothing Then
                                        If Directory.Exists(strInputFolder) = False Then
                                            _log.Info("Creating directory " & strInputFolder)
                                            Directory.CreateDirectory(strInputFolder)
                                            _log.Info("Created directory " & strInputFolder)
                                        Else
                                            _log.Info("Folder already exists " & strInputFolder)
                                        End If
                                    Else
                                        _log.Info("Folder value is blank, quiting and moving on to the next folder")
                                        Exit For
                                    End If

                                    'look if file exist to be processed
                                    _log.Info("Looking in folder: " & strInputFolder)

                                    _log.Info("Sorting the files in write time ascending order")
                                    Dim files = From file In New DirectoryInfo(strInputFolder).GetFileSystemInfos Where file.Name Like "*.*"
                                                Order By file.LastWriteTime Ascending Select file
                                    _log.Info("Done sorting the files in write time ascending order")

                                    If files.Count > 0 Then
                                        intInputFileCount = files.Count
                                        _log.Info("Found " & files.Count.ToString & " files..., so we are exiting for this message system until files are processed by KMC")
                                    Else
                                        _log.Info("Did not find any files..., lets go look to see if there are any files waiting to be moved")
                                    End If
                                End If
                            End If


                            If r.Item("Name") = "EDIService Folder" AndAlso intInputFileCount = 0 Then
                                If IsDBNull(r.Item("value")) Then
                                    _log.Info("The EDIService folder is null for message system named " & msr.Item("Name") & ", you must have it set moving on to the next one")
                                    Exit For
                                End If
                                If r.Item("Name") = "EDIService Folder" AndAlso r.Item("Value") = Nothing Then
                                    _log.Info("The EDIService folder does not have a value for message system named " & msr.Item("Name") & ", you must have it set")
                                    Exit For
                                Else
                                    _log.Info("The EDIService folder does have a value set as " & r.Item("Value") & " continue to verify the ESIService Folder")
                                    strEDIServiceFolder = r.Item("value")
                                    If Not strEDIServiceFolder = Nothing Then
                                        If Directory.Exists(strEDIServiceFolder) = False Then
                                            _log.Info("Creating directory " & strEDIServiceFolder)
                                            Directory.CreateDirectory(strEDIServiceFolder)
                                            _log.Info("Created directory " & strEDIServiceFolder)
                                        Else
                                            _log.Info("Folder already exists " & strEDIServiceFolder)
                                        End If
                                    Else
                                        _log.Info("Folder value is blank, quiting and moving on to the next folder")
                                        Exit For
                                    End If

                                    'look if file exist to be processed
                                    _log.Info("Looking in folder: " & strEDIServiceFolder)

                                    Dim files = From file In New DirectoryInfo(strEDIServiceFolder).GetFileSystemInfos Where file.Name Like "*.*"
                                                Order By file.LastWriteTime Ascending Select file

                                    If files.Count > 0 Then
                                        _log.Info("Found " & files.Count.ToString & " files... going to move on file ")
                                        File.Copy(strEDIServiceFolder & "\" & files(0).Name, strInputFolder & "\" & files(0).Name)
                                        _log.Info("Copied file " & strEDIServiceFolder & "\" & files(0).Name & " to " & strInputFolder & "\" & files(0).Name)
                                        File.Delete(strEDIServiceFolder & "\" & files(0).Name)
                                        _log.Info("Deleted file " & strEDIServiceFolder & "\" & files(0).Name)
                                    Else
                                        _log.Info("Did not find any files to process...")
                                    End If
                                End If
                            Else
                                intInputFileCount = 0
                                _log.Info("Resetting the file count in that folder of " & intInputFileCount & " to 0")
                            End If

                            'Dim _Dir As New DirectoryInfo(r.Item("value"))

                            'If Directory.Exists(r.Item("value")) Then
                            '    _log.Info("Looking in folder: " & _Dir.ToString)
                            '    Dim files = From file In _Dir.GetFileSystemInfos Where file.Name Like "*.*"
                            '                Order By file.CreationTime Ascending Select file

                            '    _log.Info("Found " & files.Count.ToString & " files...")


                            'End If

                        Next
                        objDSP.Clear()
                        objDTP.Clear()

                    Next

                Catch ex As Exception
                    _log.Error(ex.ToString & vbCrLf & ex.StackTrace.ToString)
                Finally
                    comm.Close()
                    _log.Info("Closed the connection")
                End Try
                GC.Collect()
                GC.WaitForPendingFinalizers()
            End Using

        Catch ex As Exception
            _log.Error(ex.ToString & vbCrLf & ex.StackTrace.ToString)
        Finally

        End Try

    End Sub
#End Region

#Region " Service Work Thread "
    ''' <summary>
    ''' The method performs the main function of the service. It runs on a 
    ''' thread pool worker thread.
    ''' </summary>
    ''' <param name="state"></param>
    Private Sub ServiceWorkerThread(ByVal state As Object)
        ' Periodically check if the service is stopping.
        Do While Not Me.stopping

            _log.Info("We are starting to loop through the message systems")
            LoopMessageSystems()
            _log.Info("We are finished looping through the message systems")
            _log.Info("Sent to garbage collector")

            Dispose(True)
            ' Perform main service function here...
            _log.Info("Sleeping for " & My.Settings.TimerMilliseconds / 1000 & " seconds")
            Thread.Sleep(My.Settings.TimerMilliseconds)  ' Simulate some lengthy operations.
        Loop

        ' Signal the stopped event.
        Me.stoppedEvent.Set()

    End Sub
#End Region

#Region " On Stop "
    ''' <summary>
    ''' The function is executed when a Stop command is sent to the service 
    ''' by SCM. It specifies actions to take when a service stops running. In 
    ''' this code sample, OnStop logs a service-stop message to the 
    ''' Application log, and waits for the finish of the main service 
    ''' function.
    ''' </summary>
    Protected Overrides Sub OnStop()
        ' Log a service stop message to the Application log.
        _log.Info("EDIService in OnStop.")

        ' Indicate that the service is stopping and wait for the finish of 
        ' the main service function (ServiceWorkerThread).
        Me.stopping = True
        Me.stoppedEvent.WaitOne()
    End Sub
#End Region

End Class

Answer 1

下面展示了如何在VB.NET中创建使用BackgroundWorker的Windows服务。 OP 中未提供数据库表定义，因此需要修改代码才能使用您的数据库。

VS 2022：

• 打开 Visual Studio 2022
• 点击
• 单击文件
• 选择新建
• 选择项目
• 对于过滤器，选择：
• 
• 单击下一步
• 输入所需的项目名称（例如：WindowsServiceTestRH）
• 选择所需的 .NET Framework（例如：.NET Framework 4.8）
• 单击创建

打开工具箱：

• 在 VS 菜单中，点击 View
• 选择工具箱

打开解决方案资源管理器：

• 在 VS 菜单中，点击 View
• 选择解决方案资源管理器

打开属性窗口

• 在 VS 菜单中，点击 View
• 选择属性窗口

添加项目参考:

• 在 VS 菜单中，单击 Project
• 选择添加参考...
• 单击组件
• 检查系统.配置

下载/安装 NuGet 包:

• 在解决方案资源管理器中，右键单击 （例如：WindowsServiceTestRH）
• 选择管理 NuGet 包...
• 单击浏览选项卡
• 在搜索框中输入：log4net
• 选择log4net
• 选择所需版本（例如：2.0.15）
• 点击安装
• 如果出现消息框，请单击 确定

添加一个类：（名称：CurrentState.vb）

• 在 VS 菜单中，单击 Project
• 选择添加新项目...
• 选择Class（名称：CurrentState.vb）
• 单击添加

当前状态.vb：

Public Class CurrentState
    'ToDo: if desired, add additional properties
    Public Property Status As String
    Public Property PercentDone As Integer
End Class

添加一个类：（名称：Helper.vb）

注意：没有必要为 BackgoundWorker 运行的代码创建单独的类。请参阅here了解如何在不创建单独的类的情况下执行此操作。

• 在 VS 菜单中，单击 Project
• 选择添加新项目...
• 选择Class（名称：Helper.vb）
• 单击添加

助手.vb:

'Add reference
'Project => Add reference... => Assemblies => System.Configuration


Imports log4net
Imports System.Configuration
Imports System.IO
Imports System.Data
Imports System.Data.SqlClient

Public Class Helper

    Private _cleanLogFiles As Boolean = False
    Private _connectionStr As String = String.Empty
    Private _log As ILog = Nothing
    Private _logFolder As String = String.Empty
    Private _purgeLogFilesMonth As Integer = 0
    Private _workFolder As String = String.Empty

    Public Property CleanLogFiles As Boolean
        Get
            Return _cleanLogFiles
        End Get
        Set(value As Boolean)
            'set value
            _cleanLogFiles = value
        End Set
    End Property

    Public Property Log As ILog
        Get
            Return _log
        End Get
        Set(value As ILog)
            _log = value
        End Set
    End Property

    Public Property LogFolder As String
        Get
            Return _logFolder
        End Get
        Set(value As String)
            'set value
            _logFolder = value
        End Set
    End Property

    Public Property PurgeLogFilesMonth As Integer
        Get
            Return _purgeLogFilesMonth
        End Get
        Set(value As Integer)
            'set value
            _purgeLogFilesMonth = value
        End Set
    End Property

    Public Property WorkFolder As String
        Get
            Return _workFolder
        End Get
        Set(value As String)
            'set value
            _workFolder = value
        End Set
    End Property

    Public Sub New()
        'Windows authentication
        '_connectionStr = ConfigurationManager.ConnectionStrings("TestRH").ConnectionString
        _connectionStr = ConfigurationManager.ConnectionStrings("TestRHSqlServerAuthentication").ConnectionString
    End Sub

    Private Sub CleanUpLogs(worker As System.ComponentModel.BackgroundWorker, e As System.ComponentModel.DoWorkEventArgs)
        'Dim state As CurrentState = New CurrentState()

        If worker.CancellationPending Then
            'set value
            e.Cancel = True
            Return
        End If

        Try
            'Clean up logs files
            Dim logFiles As String() = Directory.GetFiles(_logFolder)

            For Each logFile As String In logFiles

                If worker.CancellationPending Then
                    'set value
                    e.Cancel = True
                    Return
                End If

                'state.Status = $"Processing file {logFile}..."

                'report progress (raise event)
                'worker.ReportProgress(0, state)

                Dim fileInfo As New FileInfo(logFile)

                'set file to be accessable from authenticated users
                'Dim fileacl As New FileSecurity(fileInfo.FullName, AccessControlSections.Access)
                'fileacl.AddAccessRule(New FileSystemAccessRule(New SecurityIdentifier(WellKnownSidType.AuthenticatedUserSid, Nothing), FileSystemRights.FullControl, AccessControlType.Allow))
                'fileInfo.SetAccessControl(fileacl)

                If fileInfo.CreationTime < DateTime.Now.AddMonths(_purgeLogFilesMonth * -1) Then
                    _log.Info("Found Log file(s) that are more then " & _purgeLogFilesMonth.ToString() & " month old to delete " & fileInfo.ToString)

                    _log.Info("Verifying that the old file ends with .txt")

                    If fileInfo.Name.Contains(".txt") Then
                        fileInfo.Delete()
                        _log.Info("Deleted the file " & fileInfo.Name.ToString)
                    Else
                        _log.Info("Did not delete the file " & fileInfo.Name.ToString)
                    End If
                Else
                    _log.Info("This file" & fileInfo.Name.ToString & " is not older then " & _purgeLogFilesMonth.ToString() & " month")
                End If
            Next
        Catch ex As Exception
            _log.Error("CleanUpLogs - {ex.Message}")
            Throw
        End Try
    End Sub

    Private Sub CleanUpWorkFiles(worker As System.ComponentModel.BackgroundWorker, e As System.ComponentModel.DoWorkEventArgs)
        'Dim state As CurrentState = New CurrentState()

        If worker.CancellationPending Then
            'set value
            e.Cancel = True
            Return
        End If

        Try
            'Clean up work files
            Dim strFiles As String() = Directory.GetFiles(_workFolder)
            For Each strFile In strFiles
                If worker.CancellationPending Then
                    'set value
                    e.Cancel = True
                    Return
                End If

                'state.Status = $"Processing file {strFile}..."

                'report progress (raise event)
                'worker.ReportProgress(0, state)

                Dim fileInfo As New FileInfo(strFile)

                'set file to be accessable from authenticated users
                'Dim fileacl As New FileSecurity(fileInfo.FullName, AccessControlSections.Access)
                'fileacl.AddAccessRule(New FileSystemAccessRule(New SecurityIdentifier(WellKnownSidType.AuthenticatedUserSid, Nothing), FileSystemRights.FullControl, AccessControlType.Allow))
                'fileInfo.SetAccessControl(fileacl)

                If fileInfo.CreationTime < DateTime.Now.AddMonths(_purgeLogFilesMonth * -1) Then
                    _log.Info("Found file(s) that are more then " & _purgeLogFilesMonth.ToString() & " month old to delete " & fileInfo.ToString)
                    fileInfo.Delete()
                    _log.Info("Deleted the file " & fileInfo.Name.ToString)
                End If
            Next
        Catch ex As Exception
            _log.Error("CleanUpWorkFiles - {ex.Message}")
            Throw
        End Try
    End Sub

    Public Sub Execute(worker As System.ComponentModel.BackgroundWorker, e As System.ComponentModel.DoWorkEventArgs)
        'ToDo: add desired code

        If worker.CancellationPending Then
            'set value
            e.Cancel = True
            Return
        End If

        _log.Info("In Sub Execute.")

        If _cleanLogFiles Then
            CleanUpLogs(worker, e)
            CleanUpWorkFiles(worker, e)
        End If

        'update database
        UpdateDatabase(worker, e)
    End Sub

    Private Sub UpdateDatabase(worker As System.ComponentModel.BackgroundWorker, e As System.ComponentModel.DoWorkEventArgs)
        'ToDo: re-write this method
        'ensure that tables have been properly designed (search "database normalization")
        'and perform a JOIN

        Dim strSql As String = String.Empty
        Dim dtMscMessageSystem As DataTable = New DataTable()
        Dim dtInfParameter As DataTable = New DataTable()

        _log.Info("In Sub UpdateDatabase.")

        If worker.CancellationPending Then
            'set value
            e.Cancel = True
            Return
        End If

        Try
            Using con As SqlConnection = New SqlConnection(_connectionStr)
                'open
                con.Open()

                Using cmd As SqlCommand = New SqlCommand("select * from mscmessagesystem where adapter = @adapter and status = @status", con)
                    With cmd
                        .Parameters.Add("@adapter", SqlDbType.VarChar).Value = "Folder"
                        .Parameters.Add("@status", SqlDbType.Int).Value = 0
                    End With

                    'set value
                    strSql = cmd.CommandText

                    Using da As SqlDataAdapter = New SqlDataAdapter(cmd)
                        'get data from database
                        da.Fill(dtMscMessageSystem)
                    End Using
                End Using

                If dtMscMessageSystem.Rows.Count = 1 Then
                    _log.Info($"Retrieved {dtMscMessageSystem.Rows.Count} row from table 'mscmessagesystem' (SQL: '{strSql}')")
                Else
                    _log.Info($"Retrieved {dtMscMessageSystem.Rows.Count} rows from table 'mscmessagesystem' (SQL: '{strSql}')")
                End If

                For Each msr As DataRow In dtMscMessageSystem.Rows
                    Using cmd As SqlCommand = New SqlCommand("SELECT ID, sectionID, name, value from infParameter WHERE sectionID = @sectionID AND ([name] like @name1 OR [name] like @name2) order by ID asc", con)
                        With cmd
                            .Parameters.Add("@sectionID", SqlDbType.VarChar).Value = 1
                            .Parameters.Add("@name1", SqlDbType.VarChar).Value = $"Input Folder Name%"
                            .Parameters.Add("@name2", SqlDbType.VarChar).Value = $"EDIService Folder%"
                        End With

                        'set value
                        strSql = cmd.CommandText

                        'create new instance
                        'ToDo: consider renaming this
                        Dim dtP As DataTable = New DataTable()

                        Using da As SqlDataAdapter = New SqlDataAdapter(cmd)
                            'get data from database
                            da.Fill(dtP)
                        End Using

                        If dtP.Rows.Count = 1 Then
                            _log.Info($"Retrieved {dtP.Rows.Count} row from table 'infParameter' (SQL: '{strSql}')")
                        Else
                            _log.Info($"Retrieved {dtP.Rows.Count} rows from table 'infParameter' (SQL: '{strSql}')")
                        End If

                        For Each row As DataRow In dtP.Rows
                            'ToDo: add desired code
                            _log.Info($"Processing SectionID: '{row("sectionID")?.ToString()}' Name: '{row("name")}'")
                        Next
                    End Using

                    'ToDo: add desired code

                Next
            End Using
        Catch ex As SqlException
            _log.Error($"UpdateDatabase - {ex.Message} (SQL: '{strSql}')")
            Throw ex
        Catch ex As Exception
            _log.Error("UpdateDatabase - {ex.Message}")
            Throw ex
        End Try

    End Sub
End Class

注意：上面的代码中，方法“UpdateDatabase”需要修改为您想要的代码。虽然我没有使用“ReportsProgress”，但我添加了代码（并将其注释掉），以防您希望使用它。有关更多信息，请参阅 BackgroundWorker.ReportsProgress 和 BackgroundWorker.ProgressChanged Event 的文档。数据库连接字符串是从“App.config”中检索的（见下文），并且需要修改。

重命名Service1.vb：

• 在解决方案资源管理器中，右键单击“Service1.vb”

• 选择重命名

• 输入所需名称（例如：EDIService.vb）

• 当出现以下MessageBox时：

  

  单击是

添加事件日志:

• 在解决方案资源管理器中，右键单击 EDIService.vb
• 选择视图设计器
• 打开工具箱，然后选择EventLog
• 将EventLog拖至设计（灰色）区域

修改代码（EDIService.vb）：

• 在解决方案资源管理器中，右键单击 EDIService.vb
• 选择查看代码

EDIService.vb：

Imports log4net
Imports System.Configuration
Imports System.IO
Imports System.Reflection
Imports System.Security.AccessControl
Imports System.Security.Principal
Imports System.Timers
Imports System.ComponentModel

Public Class EDIService

    Private _backgroundWorker1 As BackgroundWorker = Nothing
    Private _cleanLogFileIntervalMinutes As Integer
    Private _helper As Helper = Nothing
    Private _log As ILog = Nothing
    Private _logFilesLastCleaned As DateTime = DateTime.MinValue
    Private _purgeLogFilesMonth As Integer = 0
    Private _strStorageFolder As String = Environment.GetFolderPath(Environment.SpecialFolder.CommonApplicationData) 'C:\ProgramData
    Private _strWorkFolder As String = Path.Combine(_strStorageFolder, "EDIService")
    Private _strLogFolder As String = Path.Combine(_strWorkFolder, "Logs")
    Private _timer1 As System.Timers.Timer = Nothing

    Public Sub New()

        ' This call is required by the designer.
        InitializeComponent()

        ' Add any initialization after the InitializeComponent() call.

        'Init the log for net settings (must have in 4.0 Framework)
        log4net.Config.XmlConfigurator.Configure()

        _log = LogManager.GetLogger(MethodBase.GetCurrentMethod().DeclaringType)

        'set properties
        EventLog1.Log = "Application"
        EventLog1.Source = "EDI"

        If Not EventLog.SourceExists("EDI") Then
            EventLog.CreateEventSource("EDI", "EDI Log")
        End If
    End Sub

    Private Sub BackgroundWorker1_DoWork(sender As Object, e As DoWorkEventArgs)
        Dim worker As BackgroundWorker = DirectCast(sender, BackgroundWorker)
        Dim helper1 As Helper = DirectCast(e.Argument, Helper)

        'execute (call sub)
        helper1.Execute(worker, e)
    End Sub

    Private Sub BackgroundWorker1_ProgressChanged(sender As Object, e As ProgressChangedEventArgs)
        Dim state As CurrentState = DirectCast(e.UserState, CurrentState)

    End Sub

    Private Sub BackgroundWorker1_RunWorkerCompleted(sender As Object, e As RunWorkerCompletedEventArgs)
        'ToDo: add any code here that needs to execute after the BackgroundWorker finishes

        If e.Error IsNot Nothing Then
            'handle errors here. such as logging them
            'replace newline in message with space
            _log.Error($"{e.Error.Message.Replace("\r\n", "\n").Replace("\r", "\n").Replace("\n", " ")} InnerException: {e.Error.InnerException} StackTrace: {e.Error.StackTrace}")
        ElseIf e.Cancelled Then
            'user cancelled the operation

            'ToDo: add desired code
        Else
            'completed successfully 

            'ToDo: add desired code
        End If
    End Sub

    Protected Overrides Sub OnStart(ByVal args() As String)
        ' Add code here to start your service. This method should set things
        ' in motion so your service can do its work.

        'initialize
        StartUp()

        ' Log a service start message to the Application log.
        _log.Info("EDI Service in OnStart.")

        'EventLog1.WriteEntry($"EDI service started. Log location: {_strLogFolder}")
    End Sub

    Protected Overrides Sub OnStop()
        ' Add code here to perform any tear-down necessary to stop your service.

        'stop timer
        _timer1.Stop()

        If _backgroundWorker1.IsBusy Then
            'cancel BackgroundWorker
            _backgroundWorker1.CancelAsync()
        End If

        Do
            System.Threading.Thread.Sleep(300)
        Loop While _backgroundWorker1.IsBusy()

        'unsubscribe from events
        RemoveHandler _timer1.Elapsed, AddressOf Timer1_Elapsed

        'unsubscribe to events (add event handlers)
        RemoveHandler _backgroundWorker1.DoWork, AddressOf BackgroundWorker1_DoWork
        RemoveHandler _backgroundWorker1.ProgressChanged, AddressOf BackgroundWorker1_ProgressChanged
        RemoveHandler _backgroundWorker1.RunWorkerCompleted, AddressOf BackgroundWorker1_RunWorkerCompleted

        _timer1 = Nothing
        _backgroundWorker1 = Nothing
        _helper = Nothing

        'EventLog1.WriteEntry($"EDI service stopped. Log location: {_strLogFolder}")
    End Sub

    Private Sub Timer1_Elapsed(sender As Object, e As ElapsedEventArgs)
        'ToDo: add desired code

        _log.Info("Timer1_Elapsed event.")

        Dim elapsed As TimeSpan = DateTime.Now.Subtract(_logFilesLastCleaned)

        'clean log files every 6 hours
        If elapsed.Minutes >= _cleanLogFileIntervalMinutes Then
            'set value
            _logFilesLastCleaned = DateTime.Now
            RunTasks(True)
        Else
            RunTasks(False)
        End If
    End Sub

    Public Sub StartUp()
        Try
            '_log = LogManager.GetLogger(GetType(EDIService))
            '_log = LogManager.GetLogger(MethodBase.GetCurrentMethod().DeclaringType)

            _log.Info("EDI service starting...")
            _log.Info("Reading app.config 'CleanLogFileIntervalMinutes'...")

            Dim cleanLogFileIntervalMinutesStr As String = ConfigurationManager.AppSettings("CleanLogFileIntervalMinutes")
            Dim purgeLogFilesMonthStr As String = ConfigurationManager.AppSettings("PurgeLogFilesMonth")

            If Not String.IsNullOrEmpty(cleanLogFileIntervalMinutesStr) Then
                If Not Integer.TryParse(cleanLogFileIntervalMinutesStr, _cleanLogFileIntervalMinutes) Then
                    'log error
                    _log.Error("Couldn't parse CleanLogFileIntervalMinutesStr.")

                End If
            End If

            If Not String.IsNullOrEmpty(purgeLogFilesMonthStr) Then
                If Not Integer.TryParse(purgeLogFilesMonthStr, _purgeLogFilesMonth) Then
                    'log error
                    _log.Error("Couldn't parse PurgeLogFilesMonthStr.")

                End If
            End If

            _log.Info("Initializing backgroundworker...")

            'create new instance
            _backgroundWorker1 = New BackgroundWorker()

            'set properties
            _backgroundWorker1.WorkerReportsProgress = True
            _backgroundWorker1.WorkerSupportsCancellation = True

            'subscribe to events (add event handlers)
            AddHandler _backgroundWorker1.DoWork, AddressOf BackgroundWorker1_DoWork
            AddHandler _backgroundWorker1.ProgressChanged, AddressOf BackgroundWorker1_ProgressChanged
            AddHandler _backgroundWorker1.RunWorkerCompleted, AddressOf BackgroundWorker1_RunWorkerCompleted

            _log.Info("Initializing timer...")

            'timer
            _timer1 = New System.Timers.Timer()

            'set properties
            _timer1.Interval = 60000 'ms 

            'subscribe to events
            AddHandler _timer1.Elapsed, AddressOf Timer1_Elapsed

            'Dim applicationName As String = Environment.GetCommandLineArgs()(0)
            'Dim exePath As String = System.IO.Path.Combine(Environment.CurrentDirectory, applicationName)
            'Dim cfg As Configuration = ConfigurationManager.OpenExeConfiguration(exePath)
            ''XmlConfigurator.Configure(New System.IO.FileInfo(Application.ExecutablePath + ".config"))
            '_log.Info("Got the config file " & cfg.ToString)

            _log.Info("--------------------------------------------------------------------------------")
            _log.Info("New Startup Date: " & Format(Now(), "yyyy-MM-dd HH:mm:ss"))
            _log.Info("--------------------------------------------------------------------------------")

            'set folder to be accessable from authenticated users
            Dim folderinfolog As DirectoryInfo = New DirectoryInfo(_strLogFolder)
            Dim folderinfowork As DirectoryInfo = New DirectoryInfo(_strWorkFolder)

            'Check to make sure log folder is there first
            If Not folderinfolog.Exists Then
                Directory.CreateDirectory(_strLogFolder)
                _log.Info("Created Folder " & folderinfolog.ToString)
            End If

            If Not folderinfowork.Exists Then
                Directory.CreateDirectory(_strWorkFolder)
                _log.Info("Created Folder " & folderinfowork.ToString)
            End If

            _log.Info("Setting folder and files permissions")

            Dim folderacllog As New DirectorySecurity(_strLogFolder, AccessControlSections.Access)
            folderacllog.AddAccessRule(New FileSystemAccessRule(New SecurityIdentifier(WellKnownSidType.BuiltinUsersSid, Nothing), FileSystemRights.FullControl, InheritanceFlags.ContainerInherit Or InheritanceFlags.ObjectInherit, PropagationFlags.None, AccessControlType.Allow))
            folderinfolog.SetAccessControl(folderacllog)

            Dim folderaclwork As New DirectorySecurity(_strWorkFolder, AccessControlSections.Access)
            folderaclwork.AddAccessRule(New FileSystemAccessRule(New SecurityIdentifier(WellKnownSidType.BuiltinUsersSid, Nothing), FileSystemRights.FullControl, InheritanceFlags.ContainerInherit Or InheritanceFlags.ObjectInherit, PropagationFlags.None, AccessControlType.Allow))
            folderinfowork.SetAccessControl(folderaclwork)

            _log.Info("Starting timer...")

            'start
            _timer1.Start()

        Catch ex As Exception
            _log.Error($"Error: {ex.Message} InnerException: {ex.InnerException} StackTrace: {ex.StackTrace}")
        End Try
    End Sub


    Private Sub RunTasks(cleanLogFiles As Boolean)
        If _helper Is Nothing Then
            'create new instance and set properties
            _helper = New Helper() With {.Log = _log, .LogFolder = _strLogFolder, .PurgeLogFilesMonth = _purgeLogFilesMonth, .WorkFolder = _strWorkFolder}
        End If

        'set value
        _helper.CleanLogFiles = cleanLogFiles

        If Not _backgroundWorker1.IsBusy Then
            _backgroundWorker1.RunWorkerAsync(_helper)
        End If
    End Sub
End Class

添加安装程序:

• 在解决方案资源管理器中，右键单击 EDIService.vb

• 选择视图设计器

  

• 右键单击灰色区域，然后选择添加安装程序

  

设置安装程序属性

• 在解决方案资源管理器中，单击 ProjectInstaller.vb
• 单击 ServiceInstaller1 选择它
• 在“属性”窗口中，设置所需的属性（例如：描述、显示名称、服务名称）值

修改App.config:

注意：需要修改连接字符串才能与您的数据库配合使用。

<?xml version="1.0" encoding="utf-8" ?>
<configuration>
    <!-- configSections MUST be the first element -->
    <configSections>
        <section name="log4net" type="log4net.Config.Log4NetConfigurationSectionHandler, log4net" />
    </configSections>
    <appSettings>
        <add key="CleanLogFileIntervalMinutes" value="360"/>
        <add key="PurgeLogFilesMonth" value="1"/>
    </appSettings>
    <connectionStrings>
        <add name="TestRH" connectionString="Server='.\SQLExpress'; Database='TestRH'; Trusted_Connection=True" providerName="System.Data.SqlClient" />
        <add name="TestRHSqlServerAuthentication" connectionString="Server=.\SQLExpress; Database=TestRH; User Id=EDIUser; Password=*mysecretpassword*;" providerName="System.Data.SqlClient" />
    </connectionStrings>
    <log4net>
        <appender name="LogFileAppender" type="log4net.Appender.RollingFileAppender">
            <param name="File" value="C:\ProgramData\EDIService\Logs\log.txt"/>
            <lockingModel type="log4net.Appender.FileAppender.MinimalLock" />
            <appendToFile value="true" />
            <rollingStyle value="Size" />
            <maxSizeRollBackups value="2" />
            <maximumFileSize value="1MB" />
            <staticLogFileName value="true" />
            <layout type="log4net.Layout.PatternLayout">
                <param name="ConversionPattern" value="%d [%t] %-5p %c %m%n"/>
            </layout>
        </appender>

        <root>
            <level value="ALL" />
            <appender-ref ref="LogFileAppender" />
        </root>
    </log4net>
    <startup>
        <supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.8" />
    </startup>
</configuration>

编译为 x64

将文件从“bin”文件夹复制到所需位置

安装服务:

• %windir%\Microsoft.NET\Framework64\\installutil.exe

卸载服务:

• %windir%\Microsoft.NET\Framework64\\installutil.exe /u

注意：如果您搜索，可能还有其他安装选项。

资源：

• 教程：创建 Windows 服务应用程序
• 异步/等待与BackgroundWorker
• 无法让 log4net 与 .net windows 服务一起使用