VB.Net程序设计：自动运行任务计划

最新推荐文章于 2021-02-07 17:17:43 发布
沐NeMo
最新推荐文章于 2021-02-07 17:17:43 发布
阅读量4.6k
点赞数
分类专栏： 2.VB.Net 文章标签：任务 vb.net 正则表达式 windows c
本文链接：https://blog.csdn.net/linjimu/article/details/3023532
版权
2.VB.Net 专栏收录该内容
120 篇文章 4 订阅
订阅专栏
一位朋友说。他的电脑要每一个小时自动打开一个程序。想到用系统自带的那个任务计划。达不到我要的效果。于是自己写一个这样的程序。
让程序在某一个时间开始。每隔一个时间段就自动运行选择的程序。可以只运行一次或者多次。
程序源代码下载地址：http://download.csdn.net/source/685070
下面是源代码：
 
 Imports System.IO
Imports Microsoft.Win32.Registry
Imports System.Diagnostics
Imports System.Text.RegularExpressions
Public Class MainFrm
    Private Class Consts
        Public Const RegSetString As String = "LinjimuAutoRunTask"
    End Class
    Public Enum MsgType
        Err
        Ok
    End Enum
    Private Pid As Integer
    Private PName As String
    Private Proc As Process
    Dim NowStr As String
    '判断时间的正则表达式 
    Dim RexTime As String = "^([0-1]?[0-9]|2[0-3])((:([0-5][0-9]|[0-9])){1,2})$"
    Dim RexInteger As String = "^[1-9][0-9]*$"
    '^[0~9]+$ ==== ^/d+$  
    '只能输入数字：“^[0-9]*$” 
    '只能输入n位的数字：“^/d{n}$” 
    '只能输入至少n位数字：“^/d{n,}$” 
    '只能输入m-n位的数字：“^/d{m,n}$” 
    '只能输入零和非零开头的数字：“^(0|[1-9][0-9]*)$” 
    '只能输入有两位小数的正实数：“^[0-9]+(.[0-9]{2})?$” 
    '只能输入有1-3位小数的正实数：“^[0-9]+(.[0-9]{1,3})?$” 
    '只能输入非零的正整数：“^/+?[1-9][0-9]*$” 
    '只能输入非零的负整数：“^/-[1-9][0-9]*$” 
    '只能输入长度为3的字符：“^.{3}$” 
    Dim Reg As Microsoft.Win32.RegistryKey
    ''' <summary> 
    ''' 判断TextStr是否匹配Rex规则 
    ''' </summary> 
    ''' <param name="TextStr"></param> 
    ''' <param name="Rex"></param> 
    ''' <returns>匹配则返回True，否则返回False。</returns> 
    ''' <remarks></remarks> 
    Public Function RexMatch(ByVal TextStr As String, ByVal Rex As String) As Boolean
        Return System.Text.RegularExpressions.Regex.Match(TextStr, Rex).Success
    End Function
    ''' <summary> 
    ''' 显示信息在LB上。 
    ''' </summary> 
    ''' <param name="Msg"></param> 
    ''' <param name="mType"></param> 
    ''' <remarks></remarks> 
    Private Sub ShowMsg(ByVal Msg As String, Optional ByVal mType As MsgType = MsgType.Ok)
        If mType = MsgType.Ok Then
            Me.LB.ForeColor = Color.Black
            Me.LB.Text = Msg
        Else
            Me.LB.ForeColor = Color.Red
            Me.LB.Text = "出错：" & Msg
        End If
        Me.LB.Refresh()
    End Sub
    Private Sub NotifyIcon1_MouseDoubleClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles NotifyIcon1.MouseDoubleClick
        If Me.Visible Then
            HideWin()
        Else
            ShowWin()
        End If
    End Sub
    Private Sub TSMIShow_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TSMIShow.Click
        ShowWin()
    End Sub
    Private Sub TSMIHide_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TSMIHide.Click
        HideWin()
    End Sub
    Private Sub TSMIExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TSMIExit.Click
        Me.Close()
        Application.Exit()
    End Sub
    Sub ShowWin()
        Me.Show()
        Me.WindowState = FormWindowState.Normal
        Me.Activate()
    End Sub
    Sub HideWin()
        Me.Hide()
    End Sub
    Private Sub MainFrm_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize
        If Me.WindowState = FormWindowState.Minimized Then
            HideWin()
        Else
            ShowWin()
        End If
    End Sub
    Private Sub BtExit_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles BtExit.Click
        Me.Close()
        Application.Exit()
    End Sub
    Private Sub BtChoseFilePath_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtChoseFilePath.Click
        Dim fd As New OpenFileDialog()
        'fd.InitialDirectory = "c:/" 
        fd.Title = "选择你要运行的文件."
        fd.Filter = "所有文件All File(*.*)|*.*"
        If fd.ShowDialog() = Windows.Forms.DialogResult.OK Then
            Me.TxtBoxFilePath.Text = fd.FileName
        End If
    End Sub
    Private Sub BtStartRunTask_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtStartRunTask.Click
        ShowMsg(".")
        If Me.TxtBoxFilePath.Text.Trim.Equals(String.Empty) Then
            ShowMsg("程序文件能为空，请输入。", MsgType.Err)
            Exit Sub
        End If
        If File.Exists(Me.TxtBoxFilePath.Text) = False Then
            ShowMsg("你选择的程序文件不存在。", MsgType.Err)
            Exit Sub
        End If
        '--检测时间状态。 
        If ChkTimeSettingIsOk() = False Then
            Exit Sub
        End If
        If Me.ChkBoxRunOneTimes.Checked = False Then
            If RexMatch(Me.TxtBoxTimeIntervle.Text.Trim, RexInteger) = False Then
                ShowMsg("时间间隔：只能输入非零的正整数。", MsgType.Err)
                Exit Sub
            End If
        End If
        '--开始知道运行任务计划。 
        Dim t1, t2 As DateTime
        Dim tspan As TimeSpan
        t1 = Convert.ToDateTime(Me.TxtBoxStratTime.Text)
        t2 = Convert.ToDateTime(Me.TxtBoxNow.Text)
        '--比较开始时间和现在时间。tspan.TotalSeconds转换为多少秒 
        tspan = t1.Subtract(t2)
        Me.TimerOnceRunTask.Enabled = True
        Me.TimerOnceRunTask.Interval = tspan.TotalSeconds * 1000
        '--设置按钮 
        Me.BtStartRunTask.Enabled = False
        Me.BtStopRunTask.Enabled = True
        If Me.ChkBoxRunOneTimes.Checked Then
            ShowMsg(String.Format("自动运行任务计划开始时间:{0} 自动运行一次。", Me.TxtBoxStratTime.Text))
        Else
            ShowMsg(String.Format("自动运行任务计划开始时间:{0} 每隔{1}分钟自动运行一次。", Me.TxtBoxStratTime.Text, Me.TxtBoxTimeIntervle.Text))
        End If
        'Dim tspan As TimeSpan 
        'tspan = Now - Now.AddMinutes(-5) 
        'LB.Text = tspan.ToString 
        'LB.Text = Today.AddDays(1 - Today.DayOfWeek) 
        'LB.Text = Today.Subtract(Today.AddMinutes(-10)).ToString 
    End Sub
    Private Function ChkTimeSettingIsOk() As Boolean
        If Me.TxtBoxStratTime.Text = String.Empty Then
            ShowMsg("开始运行时间没有填写！", MsgType.Err)
            Return False
        ElseIf RexMatch(Me.TxtBoxStratTime.Text.Trim, RexTime) = False Then
            ShowMsg("输入的时间不正确。", MsgType.Err)
            Return False
        End If
        Try
            Dim a As Integer
            a = Date.Compare(Convert.ToDateTime(Me.TxtBoxStratTime.Text), Convert.ToDateTime(Me.TxtBoxNow.Text))
            If a > 0 Then
                Return True
            Else
                ShowMsg("设置的时间已经过期了。", MsgType.Err)
                Return False
            End If
        Catch ex As Exception
            ShowMsg("设置的时间格式无效。", MsgType.Err)
            Return False
        End Try
        Return True
    End Function
    Private Sub TxtBoxStratTime_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles TxtBoxStratTime.DoubleClick
        Me.TxtBoxStratTime.Text = Date.Now.AddMinutes(30).ToString
    End Sub
    Private Sub RunTaskFirstTime()
        RunTask()
        If Me.ChkBoxRunOneTimes.Checked = False Then
            Me.TimerRunTask.Interval = Me.TxtBoxTimeIntervle.Text * 60000
            Me.TimerRunTask.Enabled = True
        End If
        Me.TimerOnceRunTask.Enabled = False
        Me.TimerOnceRunTask.Interval = 1000
    End Sub
    Private Sub RunTask()
        If Me.ChkBoxKillPrc.Checked Then
            Try
                If Proc IsNot Nothing And Proc.HasExited = False Then
                    Proc.Kill()
                    Proc.Dispose()
                End If
            Catch ex As Exception
                ShowMsg(ex.Message, MsgType.Err)
            End Try
        End If
        Try
            Proc = New Process
            Proc = System.Diagnostics.Process.Start(Me.TxtBoxFilePath.Text)
            If Me.ChkBoxRunOneTimes.Checked Then
                StopRunTask()
                ShowMsg("任务计划已经停止.")
            End If
        Catch ex As Exception
            ShowMsg(ex.Message, MsgType.Err)
        End Try
    End Sub
    Private Sub TimerNow_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TimerNow.Tick
        Me.TxtBoxNow.Text = String.Format("{0}:{1}:{2}", Date.Now.Hour, Date.Now.Minute, Date.Now.Second)
    End Sub
    Private Sub TimerOnceRunTask_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TimerOnceRunTask.Tick
        RunTaskFirstTime()
    End Sub
    Private Sub TimerRunTask_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TimerRunTask.Tick
        RunTask()
    End Sub
    Private Sub BtStopRunTask_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtStopRunTask.Click
        StopRunTask()
        ShowMsg("任务计划已经停止.")
    End Sub
    Private Sub MainFrm_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        StopRunTask()
        InitVarRegSet()
    End Sub
    Private Sub StopRunTask()
        Me.BtStartRunTask.Enabled = True
        Me.BtStopRunTask.Enabled = False
        Me.TimerOnceRunTask.Enabled = False
        Me.TimerRunTask.Enabled = False
        Me.TimerOnceRunTask.Interval = 1000
        Me.TimerRunTask.Interval = 1000
    End Sub
    '--注册表操作 
    Private Sub InitVarRegSet()
        Reg = CurrentUser.OpenSubKey("Software/Microsoft/Windows/CurrentVersion/Run", True)
        If Reg.GetValue(Consts.RegSetString) <> "" Then
            Me.ChkBoxAutoRunWithWindow.Checked = True
        Else
            Me.ChkBoxAutoRunWithWindow.Checked = False
        End If
        Reg.Close()
    End Sub
    Private Sub SaveSettings()
        If Me.ChkBoxAutoRunWithWindow.Checked = True Then
            Reg = CurrentUser.OpenSubKey("Software/Microsoft/Windows/CurrentVersion/Run", True)
            Reg.SetValue(Consts.RegSetString, Application.ExecutablePath)
            Reg.Close()
            ShowMsg("你已经设置了:启动windows时自动运行本程序。")
        Else
            Reg = CurrentUser.OpenSubKey("Software/Microsoft/Windows/CurrentVersion/Run", True)
            If Reg.GetValue(Consts.RegSetString) <> "" Then
                '--删除键值-会把整个 regsetstring 删除了。 
                Reg.DeleteValue(Consts.RegSetString)
            End If
            '--可以设置:Reg.SetValue(Consts.RegSetString, "") 
            Reg.Close()
            ShowMsg("取消启动windows时自动运行本程序。")
        End If
    End Sub
    Private Sub ChkBoxAutoRunWithWindow_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ChkBoxAutoRunWithWindow.Click
        SaveSettings()
    End Sub
    Private Sub ChkBoxRunOneTimes_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ChkBoxRunOneTimes.Click
        If Me.ChkBoxRunOneTimes.Checked Then
            Me.TxtBoxTimeIntervle.Enabled = False
            Me.ChkBoxKillPrc.Enabled = False
        Else
            Me.TxtBoxTimeIntervle.Enabled = True
            Me.ChkBoxKillPrc.Enabled = True
        End If
    End Sub
End Class
 