form1.frm

vb做的词法分析器

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   Caption         =   "词法分析器"
   ClientHeight    =   8670
   ClientLeft      =   1050
   ClientTop       =   1230
   ClientWidth     =   4590
   LinkTopic       =   "Form1"
   ScaleHeight     =   8670
   ScaleWidth      =   4590
   Begin VB.ListBox List3 
      BackColor       =   &H80000000&
      Height          =   780
      Left            =   480
      TabIndex        =   5
      Top             =   3720
      Width           =   1335
   End
   Begin VB.ListBox List2 
      BackColor       =   &H80000000&
      Height          =   780
      Left            =   480
      TabIndex        =   4
      Top             =   2160
      Width           =   1335
   End
   Begin VB.ListBox List1 
      Height          =   7440
      Left            =   2280
      TabIndex        =   2
      Top             =   1320
      Width           =   1815
   End
   Begin VB.CommandButton Command1 
      Caption         =   "选择文件"
      Height          =   495
      Left            =   1440
      TabIndex        =   0
      Top             =   480
      Width           =   1455
   End
   Begin MSComDlg.CommonDialog file 
      Left            =   360
      Top             =   360
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Label Label2 
      Caption         =   "回车字符"
      Height          =   375
      Left            =   120
      TabIndex        =   3
      Top             =   3240
      Width           =   1695
   End
   Begin VB.Label Label1 
      Caption         =   "未知字符"
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   1800
      Width           =   1695
   End
End
Attribute VB_Name = "form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Base 1
Dim char As String
Dim location As Integer
Dim pre As String      '分别记录输入前后的状态！
Dim nex As String
Dim whole As String
Dim testwhole As String    '用于回车符情况的！
Dim counter As Integer       '用于计数(command1)

Private Sub Command1_Click()
counter = counter + 1
If counter = 1 Then
  
Else: Close #1
      List1.Clear
      List2.Clear
      List3.Clear
End If
whole = ""
pre = ""
nex = pre
b = 0
location = 1
file.ShowOpen  '用Commondialog只是为了用它的FileName属性！
Open file.FileName For Input As #1
Do                                    'do必须独占一行！；这里先把文件首的空格滤掉！
  Seek #1, location
  char = Input$(1, #1)                    '其实Input$(1, #1)语句后文件实际指针已指向下一个！
  location = location + 1
Loop While char = Space(1) ' VB中‘Space(1)’表空格，而""只是空！
location = location - 1    '再减回来！
Seek #1, location            '这里应该指的是第一要分析的个字符
pre = nex      '为下面作准备！
Do While Not EOF(1)                            '当指向文件最后一个的下一个位置时为true!
   Do
     char = Input$(1, #1)                 'char永远不会是"":超过文件尾后该句会报错！
     location = location + 1
     Seek #1, location
   Loop While char = Space(1) And Not EOF(1)
   If char = Space(1) Then
   ' Text1.Text = "ok"
     Exit Sub
   End If
   location = location - 1
   Seek #1, location
   'char = Input$(1, #1)         '以上是把字符串定位到第一个非空(滤空)!
   If char = "" Then     '对最后一个串是空格的情况！
     Exit Sub
   End If
 
   If pre = nex Or pre = "" Then
    While Not EOF(1) And (pre = nex Or pre = "")     'pre = ""只是为了第二次的情况！
                                         '当‘状态’不一致时退出!
      char = Input$(1, #1)                                                '需要加文件尾判断！
      whole = whole & char
      pre = nex
      nex = ischar(char)       '先整合再判断退后出再剥离！
      location = location + 1
      Seek #1, location                  'seek可以定位到任意位置！;实际上这句是冗余的！
     Wend
    
    testwhole = Left(whole, 1)
    While testwhole = Chr$(13) Or testwhole = Chr$(10)    '待trial!:多剥离了一层！！！！？？？？
      whole = Right(whole, Len(whole) - 1)
      testwhole = whole
      testwhole = Left(whole, 1)
     
     'Text1.Text = "ok" & whole & "ok"
    Wend
    
   
    If EOF(1) Then      '文件指针结束时还有一种特殊情况:最后一次读入另外一个其他字符后到达文件尾!!
       If pre = "" Then '这是只有一个字符（非空格）的情况! 还需trial!!
         List1.AddItem whole & istype(whole) & location
         Exit Sub
      
       ElseIf nex = pre Then
         List1.AddItem whole & istype(whole)
         Exit Sub
       Else
         whole = Left(whole, Len(whole) - 1) '采用上面这种循环得剥离最后‘一层’！;还有len长度为1时有异常！
         location = location - 1
        '  List1.AddItem whole & "相同的东东＠"
         Seek #1, location   'location指的是第一个不同的字符所在位置（如果只有一种类型就是最后一个相同字符所在位置）！
    
       End If
     
    Else
     whole = Left(whole, Len(whole) - 1)
     location = location - 1
     Seek #1, location
    
   'Exit Sub
    End If
    
   End If
   If pre = "C" And nex = "S" Then  '下面是对‘C’后跟‘S’情况的处理！
    ' char = Input$(1, #1)     '先把nex加进来！
    ' location = location + 1    '先使其指向nex!
    ' Seek #1, location
     While Not EOF(1) And (nex = "S")
      char = Input$(1, #1)
      whole = whole & char
      nex = ischar(char)
      'pre = nex
      location = location + 1     '写在最后为了不“溢出”！最后一次location肯定越界！
      Seek #1, location     '结束时，whole未含非‘S’，location定位至非‘S’的下一个，但文件指！
     Wend
    
     ' Exit Sub
     If EOF(1) Then      '文件指针结束时还有一种特殊情况:读入另外一个其他字符!!
       If nex <> "" Then
         List1.AddItem whole & istype(whole)
         Exit Sub
       Else
         whole = Left(whole, Len(whole) - 1)
         location = location - 1
         Seek #1, location
       
       End If
       
   
     Else: whole = Left(whole, Len(whole) - 1) '采用上面这种循环得剥离最后‘一层’！;还有len长度为1时有异常！
           location = location - 1
           Seek #1, location
     End If
     List1.AddItem whole & istype(whole) & location '"ok" & char & "ok"
     whole = ""   '清空！
     nex = ""
     pre = nex
    ' location = location - 1             '  location定位至第一个非‘S’！
    
   '  Seek #1, location
   ElseIf nex = "K" Then    '对字符（任意）后空格的处理！
     While Not EOF(1) And nex = "K"
       char = Input$(1, #1)
       'whole = whole & char
       nex = ischar(char)
      'pre = nex
       location = location + 1
       Seek #1, location
     Wend                                 '小结：无论‘相似性’，‘C’后‘S’，还是‘字符’后空格都会在最后指向第二个不满足字符！！？？？
     If EOF(1) Then     '最后一个字符是‘K’无需再分析了！
       If nex <> Space(1) Then       '这里仅考虑最后是一个空格一个字符的情况！！？？？
         location = location - 1
         Seek #1, location
         List1.AddItem whole & istype(whole) & location  '依然不对？？！！
         whole = ""
         nex = ""
         pre = nex
         GoTo abc    '待究
       Else
         List1.AddItem whole & istype(whole)  '这个也待究！？？
         Exit Sub
       End If
    Else:
     
     '  whole = Left(whole, Len(whole) - 1)  '不需要剥离！
    
       location = location - 1                  '定位至第一个非“空格”！
       Seek #1, location
       ' Text1.Text = location
     End If
     List1.AddItem whole & istype(whole) & location '"ok" & char & "ok"
     whole = ""   '清空！
     nex = ""
     pre = nex
    'location = location - 1 '空格
     'Seek #1, location
     'Exit Sub
   Else                                '这是对其它不一致的情况的处理：分离！
      ' Text1.Text = "ok" & location
      If Left(whole, 1) = Space(1) Then    '由于‘回车’‘换行’与相似性分析重用一个算法造成特殊情况：在‘回车’后的空格按照字符串处理了！
        GoTo add
      End If
      List1.AddItem whole & istype(whole) & location
add:  whole = ""
      nex = ""
      pre = nex
     
      'location = location - 1  '待trial!
     ' Seek #1, location
   End If
 
  
  ' Exit Sub
abc:
   
Loop
 
End Sub
Sub test()   '测试专用！
   x = x + 1
     If x = 2 Then
       Text1.Text = whole & "ok"
      Exit Sub
       End If
End Sub


Private Sub Command3_Click() '测试用！
e = Space(1)
c = " "
If e = c Then
  Text1.Text = "ok"
  
End If
End Sub

Private Sub Command4_Click()
x = Chr$(13) & "ok"
y = "ok"
If x = y Then

 Text1.Text = "ok"
End If
End Sub

Private Sub Form_Load()
counter = 0    '计数器

   '32
GuanJianZi = Array("break", "case", "char", "continue", _
"default", "do", "double", "else", "float", "for", "if", _
"int", "long", "return", "short", "sizeof", "static", _
"struct", "switch", "void", "while", "close", "eof", "getc", "getchar", _
"putc", "putchar", "printf", "scanf", "main", "define", "typedef")
'运算符33个！
 YunSuanFu = Array("(", ")", "{", "}", "<", ">", "<=", ">=", ",", ".", "[", "]", "->", "!", _
"++", "--", "+", "-", "*", "/", "%", "==", "!=", "&", "|", _
"&&", "=", "+=", "-=", "*=", "#", ":", ";")      '应把双的（如++）放在单个（如＋）的前面，待做：！！！！！！！！


End Sub
Public Function ischar(char1 As String) As String  ' 待验：能否像JAVA中一样，公共变量与本函数中的局部变量(char)可重名？
                                                
For i = 1 To 33
  If char1 = YunSuanFu(i) Then                 '这里只用其单个运算符的部分！
    ischar = "Y"
    Exit Function
  End If
 Next i

If char1 >= "0" And char1 <= "9" Then      '"9"似乎这里用作ASCMA数值！
        ischar = "S"  '数字
    Else
        If (char1 >= "a" And char1 <= "z") _
            Or (char1 >= "A" And char1 <= "Z") Or char1 = "_" Then
                ischar = "C" '字符
        Else
            If char1 = Space(1) Then      '拓思：如何在if中嵌套for循环！？
                ischar = "K"   '空格
            ElseIf char1 = Chr$(13) Or char1 = Chr$(10) Then '把回车与换行都当成""：不仅通过相似性分析，而且在结束时最后一个是‘有效’字符的情况，可以借用关于“123a”的分析程序！
                
                List3.AddItem "回车:" & location
                 
            Else
                ischar = "U"
                List2.AddItem "未知" & char1 & ":" & location     'Text不支持显示回车和换行！
              
            End If
        End If
    
End If

End Function


Public Function istype(whole1 As String) As String          '传过来的whole1已是分割好的串！
 Dim char11 As String      '似乎Left(whole1, 1)这句返回的类型与Sting不兼容：必须手动定义其引用变量类型！
 Dim char12 As String
 char11 = Left(whole1, 1)
 If Len(whole1) > 1 Then
   char12 = Right(whole1, 1)
 End If

 If ischar(char11) = "C" And ischar(char12) = "S" Then
   istype = "变量＠"
   Exit Function
 End If
 If ischar(char11) = "S" Then
   istype = "数字"
   Exit Function
 End If
 For i = 1 To 33
  If whole1 = YunSuanFu(i) Then
    istype = "运算符"
    Exit Function
  End If
 Next i
 For i = 1 To 32
  If whole1 = GuanJianZi(i) Then
    istype = "关键字"
    Exit Function
  End If
 Next i
 If ischar(char11) = "Y" Then
   istype = "运算符串"
 ElseIf ischar(char11) = "C" Then
   istype = "变量"
 Else
   istype = "未知串"    '可以再细分！
 End If
End Function