⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mainform.vb

📁 一个好用的正则表达式验证程序源码,可以参考
💻 VB
字号:
Imports System.IO
Imports System.Text.RegularExpressions
Imports System.Text
Imports System.Collections.Generic
Imports System.Reflection
Imports System.Xml

Public Class MainForm

   ' The current ProjectOptions instance
   Friend Options As New ProjectOptions
   ' The current regular expression
   Friend re As Regex
   ' The compileform 
   Friend CompileForm As CompileForm

   '------------------------------------------------
   ' Main commands
   '------------------------------------------------

   Sub ExecuteCommand()
      Dim sw As New Stopwatch()
      Dim matches As MatchCollection
      Dim matchCount As Integer
      Dim resultText As String = ""
      Dim splitLines() As String = Nothing

      Try
         ' Attempt to create the regex
         re = New Regex(rtbRegex.Text, Options.RegexOptions)
      Catch ex As Exception
         ' Exit if any syntax error
         staMatches.Text = "Parsing Error"
         MessageBox.Show(ex.Message, "Parsing error", MessageBoxButtons.OK, MessageBoxIcon.Error)
         Return
      End Try

      ' Execute the regex
      Try
         ' Find all matches, regardless of the command 
         sw.Start()
         matches = re.Matches(rtbSource.Text)
         ' We need this to force full evaluation of regex.
         matchCount = matches.Count
         sw.Stop()

         ' Apply the Replace or Split command
         If Options.Command = Command.Replace Then
            sw.Start()
            resultText = re.Replace(rtbSource.Text, rtbReplace.Text)
            sw.Stop()
         ElseIf Options.Command = Command.Split Then
            splitLines = re.Split(rtbSource.Text)
            sw.Start()
            sw.Stop()
         End If
         ' Display results
         staExecutionTime.Text = String.Format("Execution: {0} msecs.   ", sw.ElapsedMilliseconds)
         staMatches.Text = String.Format("Found {0} matches   ", matchCount)
      Catch ex As Exception
         ' Exit if any syntax error
         staMatches.Text = "Execution error"
         MessageBox.Show(ex.Message, "Execution error", MessageBoxButtons.OK, MessageBoxIcon.Error)
         Return
      End Try

      ' Get all results
      Dim matchList As New List(Of Match)
      For Each m As Match In matches
         matchList.Add(m)
      Next

      ' Display results
      staMatchInfoText = ""
      Me.Refresh()
      Dim count As Integer = 0

      ' Sort as required
      Select Case Options.Sort
         Case SortOption.Alphabetic
            matchList.Sort(New AlphaComparer())
         Case SortOption.ShortestFirst
            matchList.Sort(New ShortestComparer())
         Case SortOption.LargestFirst
            matchList.Sort(New LargestComparer())
      End Select

      ' Display results in treeview
      tvwResults.Nodes.Clear()
      For index As Integer = 0 To matchList.Count - 1
         Dim m As Match = matchList(index)
         Dim node As TreeNode = tvwResults.Nodes.Add(m.Value)
         node.Tag = New NodeInfo(m, index.ToString())
         ' Add a dummy node if necessary
         If Options.Detail <> DetailOption.NoDetails AndAlso m.Groups.Count > 0 Then node.Nodes.Add("*")
         ' exit if found enough matches
         count += 1
         If count = Options.MaxMatches Then Exit For
      Next
      If matches.Count > Options.MaxMatches Then
         Me.staItemInfo.Text = String.Format("(Only the first {0} are displayed)", Options.MaxMatches)
      End If

      ' Display results in result textbox
      count = 0
      If Options.Command = Command.Find Then

         Dim sb As New StringBuilder()
         For maIndex As Integer = 0 To matchList.Count - 1
            Dim m As Match = matchList(maIndex)
            sb.AppendFormat("MATCH[{0}]: '{1}'   [index={2}]", maIndex, m.Value, m.Index)
            sb.AppendLine()
            ' Skip remainder if groups must not be displayed
            If Options.Detail = DetailOption.NoDetails Then Continue For
            ' skip group (0)
            For grpIndex As Integer = 1 To m.Groups.Count - 1
               Dim g As Group = m.Groups(grpIndex)
               ' Skip empty groups if so required
               If g.Length = 0 AndAlso Not Options.IncludeEmptyGroups Then Continue For

               sb.AppendFormat("   GROUP[{0}]: '{1}'   [index={2}]", re.GroupNameFromNumber(grpIndex), g.Value, g.Index)
               sb.AppendLine()
               ' Skip remainder if captures must not be displayed
               If Options.Detail = DetailOption.Groups Then Continue For

               For caIndex As Integer = 0 To g.Captures.Count - 1
                  Dim c As Capture = g.Captures(caIndex)
                  sb.AppendFormat("      CAPTURE[{0}]: '{1}'   [index={2}]", caIndex, c.Value, c.Index)
                  sb.AppendLine()
               Next
            Next

            count += 1
            If count = Options.MaxMatches Then Exit For
         Next
         resultText = sb.ToString()
      ElseIf Options.Command = Command.Split Then
         Dim sb As New StringBuilder
         For Each line In splitLines
            sb.AppendFormat("[{0,3}]: {1}", count, line)
            sb.AppendLine()
            count += 1
            If count = Options.MaxMatches Then Exit For
         Next
         resultText = sb.ToString()
      End If

      rtbResults.Text = resultText
      rtbResults.Select(0, 0)
   End Sub

   '------------------------------------------------
   ' Helper procedures
   '------------------------------------------------

   Sub UpdateOptionFiels()
      ' update options fields
      Options.RegexText = rtbRegex.Text
      Options.ReplaceText = rtbReplace.Text
      Options.SourceText = rtbSource.Text
   End Sub

   ' Check whether current regex has been modified and offer to save it
   Function OkToProceed() As Boolean
      UpdateOptionFiels()
      ' exit if no change has been done
      If Not Options.HasChanged Then Return True

      Dim msg As String = String.Format("Current regex has been modified.{0}{0}Do you wish to save it?", ControlChars.CrLf)
      Select Case MessageBox.Show(msg, "Confirm action", MessageBoxButtons.YesNoCancel, MessageBoxIcon.Question)
         Case Windows.Forms.DialogResult.Cancel
            Return False
         Case Windows.Forms.DialogResult.No
            Return True
         Case Windows.Forms.DialogResult.Yes
            If Not SaveRegex(Options.RegexFile) Then Return False
            Return True
      End Select
   End Function

   ' Open a regex to file
   Function OpenRegex(ByVal fileName As String) As Boolean
      ' Ask for the filename if necessary
      If String.IsNullOrEmpty(fileName) Then
         If dlgOpenRegex.ShowDialog() <> Windows.Forms.DialogResult.OK Then Return False
         fileName = dlgOpenRegex.FileName
      End If

      Try
         Me.Options = ProjectOptions.Load(fileName)
         RefreshControlState()
         Return True
      Catch ex As Exception
         MessageBox.Show(ex.Message, "Unable to open regex file", MessageBoxButtons.OK, MessageBoxIcon.Error)
         Return False
      End Try
   End Function

   ' Save current regex to file
   Function SaveRegex(ByVal fileName As String) As Boolean
      ' Check that this regex has a name and description
      If Options.RegexName.Length = 0 Then
         Dim name As String = InputBox("Please assign a name to the current regex", "Saving Regex file")
         If name = "" Then
            MessageBox.Show("Current regex hasn't been saved.", "Missing regex name", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
            Return False
         End If
         Options.RegexName = name
      End If

      ' Ask for the filename if necessary
      If String.IsNullOrEmpty(fileName) Then
         If dlgSaveRegex.ShowDialog() <> Windows.Forms.DialogResult.OK Then Return False
         fileName = dlgSaveRegex.FileName
      End If

      Try
         Me.Options.Save(fileName)
         RefreshControlState()
         Return True
      Catch ex As Exception
         MessageBox.Show(ex.Message, "Unable to save regex file", MessageBoxButtons.OK, MessageBoxIcon.Error)
         Return False
      End Try
   End Function

   ' Refresh the state of all controls

   Sub RefreshControlState()
      rtbRegex.Text = Options.RegexText
      rtbReplace.Text = Options.ReplaceText
      rtbSource.Text = Options.SourceText
      RefreshOptionsState()

      Dim title As String = My.Application.Info.Title
      If String.IsNullOrEmpty(Options.RegexName) Then
         Me.Text = title & " - (unnamed regex)"
      Else
         Me.Text = title & " - " & Options.RegexName
      End If
   End Sub

   ' Refresh the status of all menu commands
   Sub RefreshOptionsState()
      mnuEditWordWrap.Checked = Options.WordWrap

      mnuCommandsFind.Checked = (Options.Command = Command.Find)
      mnuCommandsReplace.Checked = (Options.Command = Command.Replace)
      mnuCommandsSplit.Checked = (Options.Command = Command.Split)

      mnuOptionsCompiled.Checked = (Options.RegexOptions And RegexOptions.Compiled) = RegexOptions.Compiled
      mnuOptionsCultureInvariant.Checked = (Options.RegexOptions And RegexOptions.CultureInvariant) = RegexOptions.CultureInvariant
      mnuOptionsEcmaScript.Checked = (Options.RegexOptions And RegexOptions.ECMAScript) = RegexOptions.ECMAScript
      mnuOptionsExplicitCapture.Checked = (Options.RegexOptions And RegexOptions.ExplicitCapture) = RegexOptions.ExplicitCapture
      mnuOptionsIgnoreCase.Checked = (Options.RegexOptions And RegexOptions.IgnoreCase) = RegexOptions.IgnoreCase
      mnuOptionsIgnoreWhitespace.Checked = (Options.RegexOptions And RegexOptions.IgnorePatternWhitespace) = RegexOptions.IgnorePatternWhitespace
      mnuOptionsMultiline.Checked = (Options.RegexOptions And RegexOptions.Multiline) = RegexOptions.Multiline
      mnuOptionsRightToLeft.Checked = (Options.RegexOptions And RegexOptions.RightToLeft) = RegexOptions.RightToLeft

      mnuResultsAuto.Checked = (Options.Format = FormatOption.Auto)
      mnuResultsTreeView.Checked = (Options.Format = FormatOption.TreeView)
      mnuResultsReport.Checked = (Options.Format = FormatOption.Report)
      mnuResultsNoDetails.Checked = (Options.Detail = DetailOption.NoDetails)
      mnuResultsGroups.Checked = (Options.Detail = DetailOption.Groups)
      mnuResultsCaptures.Checked = (Options.Detail = DetailOption.GroupAndCaptures)
      txtViewMaxMatches.Text = Options.MaxMatches.ToString()
      mnuResultsIncludeEmptyGroups.Checked = Options.IncludeEmptyGroups
      mnuResultsDontSort.Checked = (Options.Sort = SortOption.Position)
      mnuResultsSortAlphabetically.Checked = (Options.Sort = SortOption.Alphabetic)
      mnuResultsShortest.Checked = (Options.Sort = SortOption.ShortestFirst)
      mnuResultsLargest.Checked = (Options.Sort = SortOption.LargestFirst)

      tvwResults.Visible = (Options.Format = FormatOption.TreeView OrElse (Options.Format = FormatOption.Auto AndAlso Options.Command = Command.Find))
      rtbResults.Visible = Not tvwResults.Visible
      staItemInfo.Visible = tvwResults.Visible
      If tvwResults.Visible Then
         lblMatches.Text = "Matches"
      Else
         lblMatches.Text = "Report"
      End If

      If Options.Command = Command.Replace Then
         rtbRegex.Size = New Size(rtbRegex.Width, rtbReplace.Top - rtbRegex.Top - 10)
         rtbReplace.Visible = True
         lblReplace.Visible = True
      Else
         rtbRegex.Size = New Size(rtbRegex.Width, rtbReplace.Bottom - rtbRegex.Top)
         rtbReplace.Visible = False
         lblReplace.Visible = False
      End If

      rtbRegex.WordWrap = Options.WordWrap
      rtbReplace.WordWrap = Options.WordWrap
      rtbSource.WordWrap = Options.WordWrap
      rtbResults.WordWrap = Options.WordWrap
      If Options.WordWrap Then
         rtbRegex.ScrollBars = RichTextBoxScrollBars.Vertical
         rtbReplace.ScrollBars = RichTextBoxScrollBars.Vertical
         rtbSource.ScrollBars = RichTextBoxScrollBars.Vertical
         rtbResults.ScrollBars = RichTextBoxScrollBars.Vertical
      Else
         rtbRegex.ScrollBars = RichTextBoxScrollBars.Both
         rtbReplace.ScrollBars = RichTextBoxScrollBars.Both
         rtbSource.ScrollBars = RichTextBoxScrollBars.Both
         rtbResults.ScrollBars = RichTextBoxScrollBars.Both
      End If
   End Sub

   ' Build the regex context menu

   Sub BuildRegexMenu()
      ' Read the embedded XML document.
      Dim st As Stream = Assembly.GetExecutingAssembly().GetManifestResourceStream("RegexTester.Regexes.xml")
      Dim sr As New StreamReader(st)
      Dim xmlText As String = sr.ReadToEnd()
      sr.Close()

      ' Parse it.
      Dim xmlDoc As New XmlDocument()
      xmlDoc.LoadXml(xmlText)

      BuildRegexMenu_Sub(xmlDoc, ctxPattern, 1)
      BuildRegexMenu_Sub(xmlDoc, ctxReplace, 2)

   End Sub

   Sub BuildRegexMenu_Sub(ByVal xmlDoc As XmlDocument, ByVal rootMenu As ContextMenuStrip, ByVal bitMask As Integer)
      ' Parse groups
      For Each groupNode As XmlElement In xmlDoc.SelectNodes("//group")
         Dim includeBits As Integer = CInt(groupNode.GetAttribute("includeBits"))
         If (includeBits And bitMask) = 0 Then Continue For

         ' Create the group menu
         Dim groupText As String = groupNode.GetAttribute("text").Replace("

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -