向各位大虾求助。

Question

我最近用.net 3.5 vb.net写了一个程序，读数据库数据，然后筛选发送邮件的小程序。

程序开始运行时比较正常，可时间一长了就出现以下错误：
EventType clr20r3, P1 servermailremind.exe, P2 1.0.0.0, P3 4a091308, P4 system, P5 2.0.0.0, P6 471ebf0d, P7 341e, P8 31c, P9 system.net.mail.smtpexception, P10 NIL.

我搜索了一下，找到这个贴子：http://social.microsoft.com/Forums/zh-CN/2212/thread/f70b0292-6eb4-4a40-ac5f-c7590bdcb8a5/
这个贴子里描述的有些类似，只是我还有点疑惑，我的运行环境都是.net3.5，本地电脑测试的时候是很正常的(但程序连续运行的时候顶多只有十来分钟)，而在服务器上看似也挺正常，可发现，若是运行时间一到12小时以上，系统日志里就会报上述的错误，程序就自动关闭了。

我的服务器端的.net3.5安装的是英文版的，本地测试的安装的是vs2008中文版。程序读的数据库是Sql2000。

服务器上同时也运行着我用vs2008编写的asp.net程序，但这个运行是正常的，环境都一样。

Answer 1

你好，我想可能是程序上的问题，你可以把发关键代码贴出来看看

---

知识改变命运，奋斗成就人生!

Answer 2

看起来是垃圾回收的时候造成的？
是否做好了dispose呢？

---

工作突然有点忙 嘿嘿

Answer 3

以下代码是我的完整代码。请大虾帮我看看有否问题。


Imports System.Xml
Imports System.Data
Imports System.Data.SqlClient
Imports System.Threading
Imports System.Net
Imports System.Net.Mail
Imports System.IO
Public Class Mains

    Public IsDept As Boolean = False 'False表示非研发部门
    Delegate Sub SetGroupBoxEnable(ByVal Ax As Boolean) '设置GroupgboxEnable状态
    Delegate Sub SetGroupBoxWiseN(ByVal t As Boolean, ByVal i As Integer) '设置Groupbox2参数
    Delegate Sub SetProgress(ByVal Max As Integer, ByVal i As Integer) '设置进度条值
    Delegate Sub SetLable9Value(ByVal Value As String) '设置进度栏文字
    Delegate Sub SetTimer1Status(ByVal t As Boolean) '设置Timer1的状态

    Sub SetTimer1(ByVal t As Boolean)
        If Me.InvokeRequired Then
            Dim d As New SetTimer1Status(AddressOf SetTimer1)
            Me.Invoke(d, New Object() {t})
        Else
            Timer1.Enabled = t
        End If
    End Sub

    Sub SetLable9(ByVal Value As String)
        If Me.Label9.InvokeRequired Then
            Dim d As New SetLable9Value(AddressOf SetLable9)
            Me.Invoke(d, New Object() {Value})
        Else
            Label9.Text = Value
            Label9.Left = (Me.GroupBox2.Width - Label9.Width) / 2
        End If
    End Sub

    Sub SetPro(ByVal Max As Integer, ByVal i As Integer)
        If Me.ProgressBar1.InvokeRequired Then
            Dim d As New SetProgress(AddressOf SetPro)
            Me.Invoke(d, New Object() {Max, i})
        Else
            ProgressBar1.Maximum = Max
            ProgressBar1.Value = i
        End If
    End Sub

    Sub SetGroupBoxWise(ByVal t As Boolean, ByVal i As Integer)
        If Me.GroupBox2.InvokeRequired Then
            Dim d As New SetGroupBoxWiseN(AddressOf SetGroupBoxWise)
            Me.Invoke(d, New Object() {t, i})
        Else
            If t = True Then
                Me.GroupBox2.Top = i
            Else
                Me.GroupBox2.Left = i
            End If
        End If
    End Sub

    Sub SetGroupEnable(ByVal Axs As Boolean)
        If Me.GroupBox1.InvokeRequired Then
            Dim d As New SetGroupBoxEnable(AddressOf SetGroupEnable)
            Me.Invoke(d, New Object() {Axs})
        Else
            Me.GroupBox1.Enabled = Axs
        End If
    End Sub

    Private Sub Main_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
        NotifyIcon1.Dispose()
        End
    End Sub

    Private Sub Main_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        '限制程序只能启动一次
        If UBound(Process.GetProcessesByName(Process.GetCurrentProcess.ProcessName)) > 0 Then
            'MsgBox(Process.GetCurrentProcess.StartTime)
            'For i = 0 To UBound(Process.GetProcessesByName(Process.GetCurrentProcess.ProcessName))
            'MsgBox(Process.GetProcessesByName(Process.GetCurrentProcess.ProcessName)(UBound(Process.GetProcessesByName(Process.GetCurrentProcess.ProcessName))).StartTime)
            'Process.GetProcessesByName(Process.GetCurrentProcess.ProcessName)(UBound(Process.GetProcessesByName(Process.GetCurrentProcess.ProcessName)))
            'Next
            Application.Exit()
        End If
        ''''''''''''''''''''''''''
        Writelog("ServerMailRemind启动。", Now.ToString("yyyy年MM月dd日HH时mm分ss秒"))
        Application.EnableVisualStyles()
        NotifyIcon1.Visible = True

        '初始化时间表
        Dim Temp As String = ""
        For i = 0 To 23
            Temp = i
            If Len(Temp) = 1 Then
                ComboBox1.Items.Add("0" & i)
                ComboBox6.Items.Add("0" & i)
            Else
                ComboBox1.Items.Add(i)
                ComboBox6.Items.Add(i)
            End If
        Next

        For i = 0 To 59
            Temp = i
            If Len(Temp) = 1 Then
                ComboBox2.Items.Add("0" & i)
                ComboBox3.Items.Add("0" & i)
                ComboBox4.Items.Add("0" & i)
                ComboBox5.Items.Add("0" & i)
            Else
                ComboBox2.Items.Add(i)
                ComboBox3.Items.Add(i)
                ComboBox4.Items.Add(i)
                ComboBox5.Items.Add(i)
            End If
        Next

        Timer2.Start()
        ReadConfig()
    End Sub

    Sub ReadConfig()
        Try
            Dim a As New Encryption("robackwindows")
            Dim doc As XmlDocument = New XmlDocument
            doc.Load(Application.StartupPath & "\config.xml")
            Dim rootnode As XmlElement = doc.DocumentElement
            Dim n As XmlNode = rootnode
            timeout.Text = rootnode.ChildNodes(0).ChildNodes(0).Value
            emailserver.Text = rootnode.ChildNodes(1).ChildNodes(0).Value
            emailuser.Text = rootnode.ChildNodes(2).ChildNodes(0).Value
            epassword.Text = a.Decrypt(rootnode.ChildNodes(3).ChildNodes(0).Value)
            Dim lastremind As String = rootnode.ChildNodes(4).ChildNodes(0).Value
            For i = 0 To ComboBox1.Items.Count - 1
                If ComboBox1.Items(i) = Hour(CDate(lastremind)) Then
                    ComboBox1.SelectedIndex = i
                End If
            Next
            For i = 0 To ComboBox2.Items.Count - 1
                If ComboBox2.Items(i) = Minute(CDate(lastremind)) Then
                    ComboBox2.SelectedIndex = i
                End If
            Next
            For i = 0 To ComboBox3.Items.Count - 1
                If ComboBox3.Items(i) = Second(CDate(lastremind)) Then
                    ComboBox3.SelectedIndex = i
                End If
            Next
            Dim devtime As String = rootnode.ChildNodes(5).ChildNodes(0).Value

            For i = 0 To ComboBox6.Items.Count - 1
                If ComboBox6.Items(i) = Hour(CDate(devtime)) Then
                    ComboBox6.SelectedIndex = i
                End If
            Next
            For i = 0 To ComboBox5.Items.Count - 1
                If ComboBox5.Items(i) = Minute(CDate(devtime)) Then
                    ComboBox5.SelectedIndex = i
                End If
            Next
            For i = 0 To ComboBox4.Items.Count - 1
                If ComboBox4.Items(i) = Second(CDate(devtime)) Then
                    ComboBox4.SelectedIndex = i
                End If
            Next
            subject.Text = rootnode.ChildNodes(6).ChildNodes(0).Value
            mess.Text = Replace(Replace(rootnode.ChildNodes(7).ChildNodes(0).Value, "<![CDATA[", ""), "]]>", "")
            messa.Text = Replace(Replace(rootnode.ChildNodes(8).ChildNodes(0).Value, "<![CDATA[", ""), "]]>", "")
            failsub.Text = rootnode.ChildNodes(9).ChildNodes(0).Value
            Timer1.Stop()
            Timer1.Interval = timeout.Text * 1000
            Timer1.Start()
        Catch ex As Exception
            MessageBox.Show("错误，配置文件无效。", "警告", MessageBoxButtons.OK, MessageBoxIcon.Warning)
            Exit Sub
        End Try
    End Sub

    '程序读写日志

    Sub Writelog(ByVal Mess As String, ByVal Tim As String)
        Dim path As String = Application.StartupPath & "\" & Now.ToString("yyyyMMdd") & ".log"
        'If File.Exists(path) = False Then
        'File.Create(path)
        'End If
        Dim a As New System.IO.StreamWriter(path, True, System.Text.Encoding.Default)
        a.WriteLine(Mess & " - " & Tim)
        a.Close()
        a.Dispose()
    End Sub

    Sub Save()
        Try
            Dim a As New Encryption("robackwindows")
            Dim myTW As New XmlTextWriter(Application.StartupPath & "\config.xml", Nothing)
            myTW.WriteStartDocument()
            myTW.Formatting = Formatting.Indented
            'myTW.WriteStartElement("Team")
            'myTW.WriteStartElement("player")
            'myTW.WriteAttributeString("Name", "George Zip")
            'myTW.WriteAttributeString("Position", "QB")
            'myTW.WriteElementString("JerseyNumber", XmlConvert.ToString(7))
            myTW.WriteStartElement("Config")
            myTW.WriteElementString("interval", timeout.Text)
            myTW.WriteElementString("emailserver", emailserver.Text)
            myTW.WriteElementString("email", emailuser.Text)
            myTW.WriteElementString("emailpassword", a.Encryption(epassword.Text))
            myTW.WriteElementString("remindtime", ComboBox1.Text & ":" & ComboBox2.Text & ":" & ComboBox3.Text)
            myTW.WriteElementString("devtime", ComboBox6.Text & ":" & ComboBox5.Text & ":" & ComboBox4.Text)
            myTW.WriteElementString("subject", subject.Text)
            myTW.WriteElementString("message", "<![CDATA[" & Replace(Replace(mess.Text, "<![CDATA[", ""), "]]>", "") & "]]>")
            myTW.WriteElementString("messagenew", "<![CDATA[" & Replace(Replace(messa.Text, "<![CDATA[", ""), "]]>", "") & "]]>")
            myTW.WriteElementString("failesub", failsub.Text)
            myTW.WriteEndElement()
            myTW.WriteEndDocument()
            myTW.Close()
            MessageBox.Show("恭喜您，配置保存成功。", "保存结果", MessageBoxButtons.OK, MessageBoxIcon.Information)
            Writelog("成功保存配置。", Now.ToString("yyyy年MM月dd日HH时mm分ss秒"))
            ReadConfig()
        Catch ex As Exception
            MessageBox.Show("配置保存失败，原因是：" & ex.Message, "保存结果", MessageBoxButtons.OK, MessageBoxIcon.Error)
        End Try
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        '加密解密类使用示例
        '''''''''''''''''''''''''''''''''''''''''''''''
        'Dim a As New Encryption("roback")            '
        'Dim temp As String = a.Encryption("roback")  '
        'MsgBox(temp)                                 '
        'MsgBox(a.Decrypt(temp))                      '
        '''''''''''''''''''''''''''''''''''''''''''''''
        If timeout.Text = "" Or IsNumeric(timeout.Text) = False Then
            MessageBox.Show("轮询时间必须为数字。", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
            Exit Sub
        End If
        If emailserver.Text = "" Then
            MessageBox.Show("邮件服务器不能为空。", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
            Exit Sub
        End If
        If emailuser.Text = "" Then
            MessageBox.Show("邮箱账号不能为空。", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
            Exit Sub
        End If
        If epassword.Text = "" Then
            MessageBox.Show("邮箱密码不能为空。", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
            Exit Sub
        End If

        If subject.Text = "" Or failsub.Text = "" Then
            MessageBox.Show("邮件主题不能为空。", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
            Exit Sub
        End If

        Save()
    End Sub

    Function checktime(ByVal str As String) As Boolean
        '判断时间是否合法
        If str.Length < 7 Or str.Length > 8 Then
            checktime = False
        ElseIf str.IndexOf(":") = 0 Then
            checktime = False
        ElseIf UBound(str.Split(":")) <> 2 Then
            checktime = False
        Else
            checktime = True
        End If

    End Function

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        NotifyIcon1.Dispose()
        Me.Close()
        End
    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        Writelog("循环查询打卡数据，时间： ", Now.ToString("yyyy年MM月dd日HH时mm分ss秒"))

        Dim a As New Threading.Thread(AddressOf WorkThread)

        a.IsBackground = True
        a.Start()
    End Sub

    '判断轮询时间间隔内有多少打卡数据

    Public Sub WorkThread()
        Try
            SetGroupEnable(False)
            SetGroupBoxWise(True, (Me.GroupBox1.Height - Me.GroupBox2.Height) / 2)
            SetGroupBoxWise(False, (Me.GroupBox1.Width - Me.GroupBox2.Width) / 2)
            SetPro(100, 1)
            Dim Conn As New SqlConnection("Server=127.0.0.1;database=CheckData;user id=sa;pwd=Aa123456")

            Dim Sql As String = ""
            Dim ds As New DataSet
            Dim temp As String = Now
            temp = CDate(temp).AddSeconds(-timeout.Text).ToString

            'Sql = "Select * from trans_normal where evttime between '" & CDate(temp) & "' and '" & Now & "'"
            Sql = "Select * from Users Where not Email is null"
            Dim mySqlAdapter As New SqlDataAdapter(Sql, Conn)
            mySqlAdapter.Fill(ds, "Users")
            mySqlAdapter.Dispose()
            Conn.Close()
            Conn.Dispose()
            'MsgBox(ds.Tables("Users").Rows.Count)
            If ds.Tables("Users").Rows.Count = 0 Then
                SetLable9("没有需要提醒的员工......")
                Thread.Sleep(2000)
                SetGroupBoxWise(True, 1000)
                SetGroupEnable(True)
                SetPro(100, 100)
            Else
                SetLable9("正在发送提醒邮件，请稍候......")
                SetPro(ds.Tables("Users").Rows.Count, 1)
                For i = 0 To ds.Tables("Users").Rows.Count - 1
                    SetLable9("正在发送提醒邮件，请稍候......" & i + 1 & "/" & ds.Tables("Users").Rows.Count)
                    With ds.Tables("Users").Rows(i)
                        Dim Temps As String = Checkkq(.Item("WorkerNO"))
                        If Temps <> "" Then
                            SysSend(.Item("email"), .Item("WorkerNO"), Temps)
                            Writelog("往员工 " & .Item("WorkerNO") & " 邮箱 " & .Item("Email") & " 发送提醒邮件，打卡时间为 " & Temps, Now.ToString("yyyy年MM月dd日HH时mm分ss秒"))
                        End If
                        'SendMail(.Item("userid"), .Item("evtcode"), .Item("evttime"))
                    End With
                    SetPro(ds.Tables("Users").Rows.Count, i + 1)
                Next
                SetLable9("邮件发送完毕......")
                Thread.Sleep(1000)
                SetGroupEnable(True)
                SetGroupBoxWise(True, 1000)
            End If
            ds.Dispose()
            'Threading.Thread.CurrentThread.Abort()
        Catch ex As ThreadAbortException
            'Threading.Thread.CurrentThread.Abort()
            'Thread.CurrentThread.Join()
            Thread.ResetAbort()
            'Thread.ResetAbort()
            Err.Clear()
        Finally
            'Threading.Thread.CurrentThread.Abort()
            Thread.CurrentThread.Join()
            Err.Clear()
        End Try
    End Sub

 

    '判断是否有打卡数据
    Function Checkkq(ByVal WorkerNO As String) As String
        Checkkq = ""
        If WorkerNO = "" Or IsNumeric(WorkerNO) = False Then
            Exit Function
        End If
        Dim Conn As New SqlConnection("Server=127.0.0.1;database=securedb;user id=sa;pwd=Aa123456")
        Dim t As String = ""
        Dim ts As String = Now
        t = CDate(ts).AddSeconds(CLng(-timeout.Text))
        Dim Sql As String = ""
        Sql = "Select evttime from trans_normal Where userid=(select userid from users where usercode=" & CLng(WorkerNO) & ") and cardzn=229 and unitid=1 and evttime between '" & t & "' and '" & CDate(ts) & "' order by evttime desc"
        'Sql = "Select Count(*) from trans_normal Where userid=(select userid from users where usercode=1576)"
        Dim ds As New DataSet
        Dim mySqlAdapter As New SqlDataAdapter(Sql, Conn)
        mySqlAdapter.Fill(ds, "trans_normal")
        'MsgBox(ds.Tables("trans_normal").Rows.Count)
        If ds.Tables("trans_normal").Rows.Count > 0 Then
            Checkkq = ds.Tables("trans_normal").Rows(0).Item("evttime")
        End If
        'mess.AppendText(ds.Tables("trans_normal").Rows.Count & "|" & Sql & "|" & Now & vbCrLf)
        mySqlAdapter.Dispose()
        ds.Dispose()
        Conn.Close()
        Conn.Dispose()
    End Function

    '判断当天是否有打卡数据
    Function Checkkqs(ByVal WorkerNO As String) As String
        Checkkqs = ""
        If WorkerNO = "" Or IsNumeric(WorkerNO) = False Then
            Exit Function
        End If
        Dim Conn As New SqlConnection("Server=127.0.0.1;database=securedb;user id=sa;pwd=Aa123456")
        Dim t As String = ""
        Dim ts As String = Now
        t = CDate(ts).ToString("yyyy-MM-dd") & " 00:00:00"
        Dim Sql As String = ""
        Sql = "Select evttime from trans_normal Where userid=(select userid from users where usercode=" & CLng(WorkerNO) & ") and cardzn=229 and unitid=1 and evttime between '" & CDate(t) & "' and '" & CDate(ts) & "' order by evttime desc"
        'Sql = "Select Count(*) from trans_normal Where userid=(select userid from users where usercode=1576)"
        Writelog("Sql语句： " & Sql, Now)
        Dim ds As New DataSet
        Dim mySqlAdapter As New SqlDataAdapter(Sql, Conn)
        mySqlAdapter.Fill(ds, "trans_normal")
        'MsgBox(ds.Tables("trans_normal").Rows.Count)
        If ds.Tables("trans_normal").Rows.Count > 0 Then
            Checkkqs = ds.Tables("trans_normal").Rows(0).Item("evttime")
        End If
        'mess.AppendText(ds.Tables("trans_normal").Rows.Count & "|" & Sql & "|" & Now & vbCrLf)
        mySqlAdapter.Dispose()
        ds.Dispose()
        Conn.Close()
        Conn.Dispose()
    End Function

    Sub SysSend(ByVal Email As String, ByVal WorkerNO As String, ByVal EvTime As String)

        Dim Temp As String = mess.Text
        '过滤参数
        Temp = Temp.Replace("%UserName%", ReadUserName(WorkerNO))
        Temp = Temp.Replace("%brushtime%", EvTime)
        Temp = Temp.Replace("%nowtime%", Now)
        SendMailMessage("[e-mail]", Email, "", "", subject.Text, Temp, emailserver.Text, emailuser.Text, epassword.Text)
    End Sub

    Sub SyslastSend(ByVal Email As String, ByVal WorkerNO As String, ByVal EvTime As String)
        Dim Temp As String = messa.Text
        '过滤参数
        Temp = Temp.Replace("%UserName%", ReadUserName(WorkerNO))
        Temp = Temp.Replace("%brushtime%", EvTime)
        Temp = Temp.Replace("%thisTime%", Now.ToString("yyyy年MM月dd日 HH点mm分ss秒"))
        Temp = Temp.Replace("%nowtime%", Now)
        SendMailMessage("[e-mail]", Email, "", "", failsub.Text, Temp, emailserver.Text, emailuser.Text, epassword.Text)
    End Sub
    Public Shared Sub SendMailMessage(ByVal from As String, ByVal recepient As String, ByVal bcc As String, ByVal cc As String, ByVal subject As String, ByVal body As String, ByVal emailserver As String, ByVal emailuser As String, ByVal emailpassword As String)
        ' Instantiate a new instance of MailMessage
        Dim mMailMessage As New MailMessage()

        ' Set the sender address of the mail message
        mMailMessage.From = New MailAddress(from)
        ' Set the recepient address of the mail message
        mMailMessage.To.Add(New MailAddress(recepient))

        mMailMessage.IsBodyHtml = True '设置为html邮件
        ' Check if the bcc value is nothing or an empty string
        If Not bcc Is Nothing And bcc <> String.Empty Then
            ' Set the Bcc address of the mail message
            mMailMessage.Bcc.Add(New MailAddress(bcc))
        End If

        ' Check if the cc value is nothing or an empty value
        If Not cc Is Nothing And cc <> String.Empty Then
            ' Set the CC address of the mail message
            mMailMessage.CC.Add(New MailAddress(cc))
        End If

        ' Set the subject of the mail message
        mMailMessage.Subject = subject
        ' Set the body of the mail message
        mMailMessage.Body = body

        ' Set the format of the mail message body as HTML
        mMailMessage.IsBodyHtml = True
        ' Set the priority of the mail message to normal
        mMailMessage.Priority = MailPriority.Normal

        ' Instantiate a new instance of SmtpClient
        Dim mSmtpClient As New SmtpClient(emailserver)
        mSmtpClient.Credentials = New NetworkCredential(emailuser, emailpassword)
        ' Send the mail message
        mSmtpClient.Send(mMailMessage)

    End Sub

    Private Sub Main_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize
        If Me.WindowState = FormWindowState.Minimized Then
            NotifyIcon1.Visible = True
            Me.ShowInTaskbar = False
        End If
    End Sub

    Private Sub NotifyIcon1_MouseDoubleClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles NotifyIcon1.MouseDoubleClick
        Me.WindowState = FormWindowState.Normal
        Me.ShowInTaskbar = True
        Me.Activate()
    End Sub

    Private Sub Timer2_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer2.Tick
        'MsgBox(lastremind.Text & "|" & Now.ToString("HH:mm:ss") & "|" & DateDiff(DateInterval.Second, CDate(lastremind.Text), CDate(Now.ToString("HH:mm:ss"))))
        'Timer2.Stop()
        'Writelog("循环查询未打卡数据，时间： ", Now.ToString("yyyy年MM月dd日HH时mm分ss秒"))
        If DateDiff(DateInterval.Second, CDate(Now.ToString("HH:mm:ss")), CDate(ComboBox1.Text & ":" & ComboBox2.Text & ":" & ComboBox3.Text)) = 0 Then
            '发送最终邮件提醒（非研发部门）
            IsDept = False
            SendMail()
        End If

        If DateDiff(DateInterval.Second, CDate(Now.ToString("HH:mm:ss")), CDate(ComboBox6.Text & ":" & ComboBox5.Text & ":" & ComboBox4.Text)) = 0 Then
            '发送最终邮件提醒（研发部门）
            IsDept = True
            SendMail()
        End If
    End Sub

    '最终邮件提醒

    Private Sub SendMail()
        Dim Week As String = ""
        Week = WeekdayName(Weekday(Now))
        If Week = "星期六" Or Week = "星期日" Then
            Exit Sub
        End If
        'Timer1.Stop() '暂停轮询
        SetTimer1(False) '暂停轮询
        Dim a As New Thread(AddressOf BackWorkThread)
        a.Start()
    End Sub

    '判断是否为弹性工作制的部门
    Function CheckDepart(ByVal DepartName As String) As Boolean
        CheckDepart = False
        Dim u As New StreamReader(Application.StartupPath & "\dep.ini", System.Text.Encoding.Default, True)
        Dim Temp As String = u.ReadToEnd
        u.Close()
        u.Dispose()
        If Temp <> "" Then
            Dim a As Object
            a = Split(Temp, vbCrLf)
            For i = 0 To UBound(a)
                If DepartName = a(i) Then
                    CheckDepart = True
                    Exit Function
                End If
            Next
        End If
    End Function
    '返回部门名称
    Function ReadDeName(ByVal WorkerNO As Object) As String
        ReadDeName = ""
        If WorkerNO Is DBNull.Value Or IsNumeric(WorkerNO) = False Then
            Exit Function
        End If
        Dim Conn As New SqlConnection("Server=127.0.0.1;database=securedb;user id=sa;pwd=Aa123456")
        Conn.Open()
        Dim Sql As String = ""
        Dim SqlAdapter As SqlDataAdapter
        Dim ds As New DataSet
        Sql = "Select deptname from depts where deptid in (select deptid from users where usercode=" & WorkerNO & ")"
        SqlAdapter = New SqlDataAdapter(Sql, Conn)
        SqlAdapter.Fill(ds, "depts")
        If ds.Tables("depts").Rows.Count = 1 Then
            ReadDeName = ds.Tables("depts").Rows(0).Item("deptname")
        End If
        SqlAdapter.Dispose()
        ds.Dispose()
        Conn.Close()
        Conn.Dispose()

    End Function

    Protected Sub BackWorkThread() '非研发部门
        SetGroupEnable(False)
        SetGroupBoxWise(True, (Me.GroupBox1.Height - Me.GroupBox2.Height) / 2)
        SetGroupBoxWise(False, (Me.GroupBox1.Width - Me.GroupBox2.Width) / 2)
        SetPro(100, 1)
        Dim Conn As New SqlConnection("Server=127.0.0.1;database=CheckData;user id=sa;pwd=Aa123456")

        Dim Sql As String = ""
        Dim ds As New DataSet
        Dim temp As String = Now
        temp = CDate(temp).AddSeconds(-timeout.Text).ToString

        'Sql = "Select * from trans_normal where evttime between '" & CDate(temp) & "' and '" & Now & "'"
        Sql = "Select * from Users Where not Email is null"
        Dim mySqlAdapter As New SqlDataAdapter(Sql, Conn)
        mySqlAdapter.Fill(ds, "Users")
        mySqlAdapter.Dispose()
        Conn.Close()
        Conn.Dispose()
        'MsgBox(ds.Tables("trans_normal").Rows.Count)
        If ds.Tables("Users").Rows.Count = 0 Then
            SetLable9("没有需要提醒的员工......")
            Thread.Sleep(2000)
            SetGroupBoxWise(True, 1000)
            SetGroupEnable(True)
            SetPro(100, 100)
        Else
            SetLable9("正在发送最终提醒邮件，请稍候......")
            SetPro(ds.Tables("Users").Rows.Count, 1)
            For i = 0 To ds.Tables("Users").Rows.Count - 1
                SetLable9("正在发送最终提醒邮件，请稍候......" & i + 1 & "/" & ds.Tables("Users").Rows.Count)
                With ds.Tables("Users").Rows(i)

                    Dim Tempd As String = Checkkqs(.Item("WorkerNO"))
                    'MsgBox(Tempd)
                    If Tempd = "" Then
                        If IsDept = True Then '研发部门
                            If CheckDepart(ReadDeName(.Item("WorkerNO"))) = True Then '研发部门
                                SyslastSend(.Item("email"), .Item("WorkerNO"), Tempd)
                                Writelog("往员工 " & .Item("WorkerNO") & " 邮箱 " & .Item("Email") & " 发送未打卡提醒邮件", Now.ToString("yyyy年MM月dd日HH时mm分ss秒"))
                            End If
                        Else
                            If CheckDepart(ReadDeName(.Item("WorkerNO"))) = False Then '非研发部门
                                SyslastSend(.Item("email"), .Item("WorkerNO"), Tempd)
                                Writelog("往员工 " & .Item("WorkerNO") & " 邮箱 " & .Item("Email") & " 发送未打卡提醒邮件", Now.ToString("yyyy年MM月dd日HH时mm分ss秒"))
                            End If
                        End If

                    End If
                    'SendMail(.Item("userid"), .Item("evtcode"), .Item("evttime"))
                End With
                SetPro(ds.Tables("Users").Rows.Count, i + 1)
            Next
            SetLable9("邮件发送完毕......")
            Thread.Sleep(1000)
            SetGroupEnable(True)
            SetGroupBoxWise(True, 1000)
        End If
        ds.Dispose()
        SetTimer1(True) '重启轮询
        Try
            Threading.Thread.CurrentThread.Abort()
        Catch ex As ThreadAbortException
            'Threading.Thread.CurrentThread.Abort()
            Thread.ResetAbort()
            Err.Clear()
        Finally
            'Threading.Thread.CurrentThread.Abort()
            Err.Clear()
        End Try
    End Sub

    '根据工号返回用户姓名
    Function ReadUserName(ByVal WorkerNO As Object) As String
        ReadUserName = ""
        If WorkerNO Is DBNull.Value Then
            Exit Function
        End If
        Dim ds As New DataSet
        Dim Conn As New SqlConnection("Server=127.0.0.1;database=securedb;user id=sa;pwd=Aa123456")

        Dim SQL As String = ""
        SQL = "Select [name] from users where usercode=" & CLng(WorkerNO)
        Dim SqlAdapter As New SqlDataAdapter(SQL, Conn)
        SqlAdapter.Fill(ds, "users")
        If ds.Tables("users").Rows.Count > 0 Then
            ReadUserName = ds.Tables("users").Rows(0).Item("name")
        End If
        SqlAdapter.Dispose()
        Conn.Close()
        Conn.Dispose()
    End Function

    Private Sub LinkLabel1_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles LinkLabel1.LinkClicked
        Try
            Process.Start(Application.StartupPath & "\Help.txt")
        Catch ex As Exception
            MessageBox.Show("找不到帮助文件：" & Application.StartupPath & "\Help.txt", "警告", MessageBoxButtons.OK, MessageBoxIcon.Warning)
            Exit Sub
        End Try
    End Sub
End Class

Class ThreadAbortTest
    Public Shared Sub Main()
        Dim myThreadDelegate As New ThreadStart(AddressOf Mains.WorkThread)
        Dim myThread As New Thread(myThreadDelegate)
        myThread.Start()
        'Thread.Sleep(100)
        'Console.WriteLine("Main - aborting my thread.")
        myThread.Abort()
        myThread.Join()
        'Console.WriteLine("Main ending.")
    End Sub 'Main
End Class 'ThreadAbortTest

Answer 4

Clr20r3只是一个消息通知，表明有一个没有处理的Exception在你的程序中。这是开发者的责任去处理异常，CLR仅仅是记录这个异常让你知道。

为了处理这个问题，你需要检查你的代码，并且处理可能的所有异常，这是唯一的方法。

同时看一个英文的帖子 ，关于保存ｄｕｍｐ去分析引起问题的原因，或者你需要Ａｔｔａｃｈ一个Ｄｅｂｕｇｇｅｒ 给程序，去发现具体的问题，然后来解决。　

---

Please remember to mark the replies as answers if they help and unmark them if they provide no help.
Welcome to the All-In-One Code Framework! If you have any feedback, please tell us.

Answer 5

因为你没有提供必要的信息跟贴 , 我们把问题的类型改为讨论 . 如果你有时间关注这个问题和提供必要的信息 , 请把类型改回为问题 , 通过帖子顶部的 ”Change Type” 选项。如果问题已经解决，我们希望你能够共享解决方案以便这个答案能够被其他有同样问题的论坛成员看到，谢谢你！

---

Please remember to mark the replies as answers if they help and unmark them if they provide no help.
Welcome to the All-In-One Code Framework! If you have any feedback, please tell us.

Answer 6

我调整了我的程序运行方式：将定时启动结束线程改成使用单一线程定时执行任务

经过连续48小时以上的测试，目前程序仍正常。

初步推测导致错误的原因如下：

运行过程中由于系统原因原出现线程未及时结束和释放资源，导致内存消耗上升，最后导致内存出现泄漏。

改变运行方式后限制了程序消耗的内存，目前是未发现报错。

谢谢

Answer 7

你好！
     你用PerfMon.exe查看一下，看看有什么收获！

---

周雪峰

Answer 8

你好，

或者使用StressLog去分析CLR的信息，看有没有帮助：

http://blog.csdn.net/ATField/archive/2009/04/15/4077157.aspx

---

Please remember to mark the replies as answers if they help and unmark them if they provide no help.
Welcome to the All-In-One Code Framework! If you have any feedback, please tell us.

Answer 9

各位好，我试着使用了楼上的工具，并未发现异常。实在是郁闷得慌了。

我跑服务器上安装了个vs2008，再直接在服务器上调试，此时发现，居然出现了无限递归的错误，可仔细检查了程序，我的程序就是属于长时间在线运行的程序，任务肯定是无限循环下去的，原代码中有在线程执行完一次任务后thread.sleep(500)的代码，我将此句注释掉，再运行。目前已经连续运行了150小时以上了，没有出现任何错误。

至此，我推断错误正是在thread.sleep(500)这句上。

我的程序是让子线程每10秒读取一次数据库，扫描新加的记录，依此执行任务，而加了thread.sleep(500)后，让子线程执行任务的间隔时间不再是相等的，当运行到一定时间的时候，也就是说thread.sleep(500)让当前线程的运行时间与其他线程发生了冲突(此处我未考虑同步的问题)，从而造成了无限递归的错误。

而改成单线程后就不存在上述错误了，从而运行正常(至少到目前是的)

感谢帮助。

Answer 10

这种状况可以使用 thread.timer 来处理 不一定要做sleep。

恭喜您解决问题

---

紫柔版主的头像真叫萌得一个不行啊。。。。

Answer 11

你好，

如果你把Thread。Sleep直接放到子线程上，在主线程用互斥（信号等）同步子线程的执行，结果如何呢?

---

Please remember to mark the replies as answers if they help and unmark them if they provide no help.
Welcome to the All-In-One Code Framework! If you have any feedback, please tell us.