form1.frm

自己写的基于VB6.0平台的KMP字符串匹配算法

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "KMP算法"
   ClientHeight    =   2205
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4125
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   2205
   ScaleWidth      =   4125
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   1200
      TabIndex        =   2
      Top             =   840
      Width           =   2055
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   1200
      TabIndex        =   1
      Top             =   120
      Width           =   2055
   End
   Begin VB.CommandButton Command1 
      Caption         =   "计算"
      Height          =   615
      Left            =   1440
      TabIndex        =   0
      Top             =   1440
      Width           =   1215
   End
   Begin VB.Label Label2 
      Caption         =   "源字符串："
      Height          =   255
      Left            =   240
      TabIndex        =   4
      Top             =   960
      Width           =   975
   End
   Begin VB.Label Label1 
      Caption         =   "匹配字符串："
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   240
      Width           =   1095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim getNext() As Integer
'字符串匹配的KMP算法

Private Sub Command1_Click()
    If Text1.Text = "" Or Text2.Text = "" Then
        MsgBox "请输入源字符串和匹配字符串！"
        Exit Sub
    End If
    '* 需匹配的字节数组
    Dim P() As String
    '* 源文件字节数组
    Dim S() As String
    Dim I As Long

    ReDim P(Len(Text1.Text))
    For I = 1 To Len(Text1.Text)
        P(I) = CStr(Mid(Text1.Text, I, 1))
    Next

    ReDim S(Len(Text2.Text))
    For I = 1 To Len(Text2.Text)
        S(I) = CStr(Mid(Text2.Text, I, 1))
    Next

    If UBound(P()) > UBound(S()) Then
        MsgBox "源字符串要大于匹配字符串，请重新输入！"
        Exit Sub
    End If

    ReDim getNext(1 To UBound(P()))

    Dim Pos As Long
    Get_Next P()
    Pos = KMP(P(), S())

    MsgBox Pos

End Sub

'*************************************************************************
'**函 数 名：KMP
'**输 入：P()(Byte) - 需匹配的字节数组
'** ：S()(Byte) - 源文件字节数组
'**输 出：(Long) -　 在源文件中匹配的位置
'**功能描述：字符串匹配的KMP算法，本函数用在字节数组中
'**全局变量：
'**调用模块：
'**作 者：zhx
'**日 期：2008年07月08日
'**修 改 人：
'**日 期：
'**版 本：V1.0
'*************************************************************************
Function KMP(P() As String, S() As String) As Long
    Dim SLen As Integer
    Dim PLen As Integer
    Dim intTLen As Integer

    PLen = UBound(P())
    SLen = UBound(S())

    Dim X As Integer: Dim Y As Integer
    X = 0: Y = 1

    Do While (X <= SLen - 1 And Y <= PLen - 1)

        If Y = 0 Or S(X) = P(Y) Then
            X = X + 1: Y = Y + 1
        Else

            Y = getNext(Y)
        End If

        '      If S(X) = P(Y) Then
        '         X = X + 1: Y = Y + 1
        '      Else
        '         X = X - Y + 1
        '         Y = 0
        '      End If
    Loop
    
    '如果匹配的话X会停在匹配字符的最后，可以利用这个特性来求匹配串的起始位置
    If Y >= PLen Then
        KMP = X + 1 - PLen
    Else
        KMP = 0
    End If

End Function

'*************************************************************************
'**函 数 名：Get_Next
'**输    入：p()(String) -
'**输    出：无
'**功能描述：得到next数组，确定向右移动的位置
'**全局变量：
'**调用模块：
'**作    者：zhx
'**日    期：2008-07-08
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Private Function Get_Next(P() As String)
    Dim X As Integer: Dim Y As Integer
    X = 1: Y = 0
    getNext(1) = 0

    Do While (X < UBound(P()))

        If Y = 0 Or P(X) = P(Y) Then

            X = X + 1: Y = Y + 1
            If (P(X) <> P(Y)) Then
                getNext(X) = Y
            Else
                getNext(X) = getNext(Y)
            End If

        Else
            Y = getNext(Y)
        End If

    Loop

End Function

Private Sub Form_Load()
    '    If Text1.Text <> "" And Text2.Text <> "" Then
    '       Text1.Text = CStr(Text1.Text)
    '       Text2.Text = CStr(Text2.Text)
    '    Else
    '
    '    End If
'    Text1.Text = "1010"
'    Text2.Text = "01001010100001"

         Text1.Text = "abaabcac"
         Text2.Text = "acabaabaabcacaabc"
    '
End Sub