none
向各位大虾求助。 RRS feed

  • 问题

  • 我最近用.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程序,但这个运行是正常的,环境都一样。

    2009年5月13日 0:46

答案

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

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

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

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

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

    感谢帮助。
    2009年6月1日 5:03

全部回复

  • 你好,我想可能是程序上的问题,你可以把发关键代码贴出来看看
    知识改变命运,奋斗成就人生!
    2009年5月13日 1:29
    版主
  • 看起来是垃圾回收的时候造成的?
    是否做好了dispose呢?
    工作突然有点忙 嘿嘿
    2009年5月13日 1:34
    版主
  • 以下代码是我的完整代码。请大虾帮我看看有否问题。


    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("System@dvt.dvt.com", 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("System@dvt.dvt.com", 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

    2009年5月15日 0:45
  • Clr20r3只是一个消息通知,表明有一个没有处理的Exception在你的程序中。这是开发者的责任去处理异常,CLR仅仅是记录这个异常让你知道。

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

    同时看一个英文的帖子 ,关于保存dump去分析引起问题的原因,或者你需要Attach一个Debugger 给程序,去发现具体的问题,然后来解决。 




    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.
    2009年5月15日 4:12
    版主
  • 因为你没有提供必要的信息跟贴 , 我们把问题的类型改为讨论 . 如果你有时间关注这个问题和提供必要的信息 , 请把类型改回为问题 , 通过帖子顶部的 ”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.
    2009年5月19日 10:20
    版主
  • 我调整了我的程序运行方式:将定时启动结束线程改成使用单一线程定时执行任务

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

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

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

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

    谢谢
    2009年5月26日 0:23
  • 你好!
         你用PerfMon.exe查看一下,看看有什么收获!
    周雪峰
    2009年5月26日 0:57
    版主
  • 你好,

    或者使用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.
    2009年5月26日 6:25
    版主
  • 各位好,我试着使用了楼上的工具,并未发现异常。实在是郁闷得慌了。

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

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

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

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

    感谢帮助。
    2009年6月1日 5:03
  • 这种状况可以使用 thread.timer 来处理 不一定要做sleep。


    恭喜您解决问题
    紫柔版主的头像真叫萌得一个不行啊。。。。
    2009年6月1日 5:12
    版主
  • 你好,

    如果你把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.
    2009年6月1日 7:45
    版主