Question

编程：javascript库源代码格式化还原 高手请进 怎么做呢？高分悬赏！

要求：用VB实现类似javascript code improver的功能
要求还原后不出错，功能不变：提供用户界面，支持自定义函数名；能够生成函数字典。

Answer 1

1个下午= =.累死了。

已发送。

使用：例如：
tMain.Text = mFmt.JsFmt(tMain.Text)

模块代码：

Option Explicit

Public Enum TType
TK_EOF
TK_OPERATOR
TK_WORD
TK_START_EXPR
TK_END_EXPR
TK_START_BLOCK
TK_END_BLOCK
TK_END_COMMAND
TK_BLOCK_COMMENT
TK_COMMENT
TK_STRING
TK_UNKNOWN
End Enum

Dim Inp As String, Oup() As String, InpLen As Long
Dim Mode() As String, curMode As String, BlockClosed As Boolean
Dim IndentString As String, IndentLevel As Long
Dim tokenText As String, LastType As TType, LastText As String, LastWord As String
Dim WhiteSpace() As String, WordChar() As String, Punct() As String, ParserPos As Long, LineStarters() As String, InCase As Boolean
Dim Prefix As String, tokenType As TType, varLine As Boolean, varLineTainted As Boolean
Dim arr1() As String

Dim tokenChar_ As String, tokenType_ As TType

Private Sub Push(arr() As String, Str As String)
Dim ub As Long
ub = UBound(arr) + 1
ReDim Preserve arr(ub)
arr(ub) = Str
End Sub

Private Function Pop(arr() As String) As String
Dim ub As Long
ub = UBound(arr) - 1
Pop = arr(ub + 1)
ReDim Preserve arr(ub)
End Function

Private Function ArrJoin(arr() As String) As String
ArrJoin = Join(arr, "")
End Function

Private Function CharAt(arr() As String, i As Long) As String
Dim l As Long: l = 1

Do While i > Len(arr(l)) And l <= UBound(arr)
i = i - Len(arr(l))
l = l + 1
Loop

If i > Len(arr(l)) Then Exit Function

CharAt = Mid(arr(l), i, 1)
End Function

Private Sub TrimOutput()
Do While (UBound(Oup) > 0) And (Oup(UBound(Oup)) = " " Or Oup(UBound(Oup)) = IndentString)
Pop Oup
Loop
End Sub

Private Sub PrintSpace()
Dim lstoup As String
If UBound(Oup) > 0 Then lstoup = Oup(UBound(Oup)) Else lstoup = " "
If lstoup <> " " And lstoup <> vbCr And lstoup <> vbCrLf And lstoup <> IndentString Then Push Oup, " "
End Sub

Private Sub PrintNewLine(Optional ignore_repeated As Boolean = False)
Dim i As Long

TrimOutput

If UBound(Oup) = 0 Then Exit Sub

If Oup(UBound(Oup)) <> vbCrLf Or ignore_repeated Then Push Oup, vbCrLf
For i = 0 To IndentLevel - 1
Push Oup, IndentString
Next
End Sub

Private Sub PrintToken()
Push Oup, tokenText
End Sub

Private Sub Indent()
IndentLevel = IndentLevel + 1
End Sub

Private Sub UnIndent()
If IndentLevel > 0 Then IndentLevel = IndentLevel - 1
End Sub

Private Sub RemoveIndent()
If UBound(Oup) > 0 And Oup(UBound(Oup)) = IndentString Then Pop Oup
End Sub

Private Sub SetMode(m As String)
Push Mode, curMode
curMode = m
End Sub

Private Sub RestoreMode()
BlockClosed = curMode = "DO_BLOCK"
curMode = Pop(Mode)
End Sub

Private Function ChkInArr(find As String, arr() As String) As Boolean
Dim i As Long
For i = 0 To UBound(arr)
If arr(i) = find Then
ChkInArr = True
Exit Function
End If
Next
ChkInArr = False
End Function

Private Function MatchStr(match As String, Str As String) As Boolean
Dim reg As New RegExp
reg.Pattern = match
MatchStr = reg.Test(Str)
End Function

Private Sub SetToken(Str As String, t As TType)
tokenChar_ = Str
tokenType_ = t
End Sub

Private Sub IncParserPos()
ParserPos = ParserPos + 1

If (ParserPos And &HFFFFF000) = ParserPos Then
fMain.Caption = "Please wait. Formating(" & Format(ParserPos / InpLen, "00%") & ")..."
DoEvents
End If
End Sub

Private Function GetNextToken()
Dim NewLines As Long
Dim c As String
Dim i As Long

Do
If ParserPos >= InpLen Then
Call SetToken("", TK_EOF)
Exit Function
End If

c = Mid(Inp, ParserPos, 1)
IncParserPos

If c = vbCr Then NewLines = NewLines + 1
Loop While ChkInArr(c, WhiteSpace)

If NewLines > 1 Then PrintNewLine True: PrintNewLine

Dim WantedNewLine As Boolean
WantedNewLine = NewLines = 1

If ChkInArr(c, WordChar) Then
If ParserPos < InpLen Then
Do While ChkInArr(Mid(Inp, ParserPos, 1), WordChar)
c = c + Mid(Inp, ParserPos, 1)
IncParserPos
If ParserPos = InpLen Then Exit Do
Loop
End If

If ParserPos <> InpLen And MatchStr("^[0-9]+[Ee]$", c) And Mid(Inp, ParserPos, 1) = "-" Then
IncParserPos

Dim t
t = GetNextToken(ParserPos)
c = c + "-" + t(0)

Call SetToken(c, TK_WORD)
Exit Function
End If

If c = "in" Then
Call SetToken(c, TK_OPERATOR)
Exit Function
End If

Call SetToken(c, TK_WORD)
Exit Function
End If

If c = "(" Or c = "[" Then
Call SetToken(c, TK_START_EXPR)
Exit Function
End If

If c = ")" Or c = "]" Then
Call SetToken(c, TK_END_EXPR)
Exit Function
End If

If c = "{" Then
Call SetToken(c, TK_START_BLOCK)
Exit Function
End If

If c = "}" Then
Call SetToken(c, TK_END_BLOCK)
Exit Function
End If

If c = ";" Then
Call SetToken(c, TK_END_COMMAND)
Exit Function
End If

If c = "/" Then
Dim Comment As String

If Mid(Inp, ParserPos, 1) = "*" Then
IncParserPos
If ParserPos < InpLen Then
Do While Not (Mid(Inp, ParserPos, 1) = "*" And Mid(Inp, ParserPos + 1, 1) = "/") And ParserPos < InpLen
Comment = Comment + Mid(Inp, ParserPos, 1)
IncParserPos

If ParserPos >= InpLen Then Exit Do
Loop
End If

ParserPos = ParserPos + 2

Call SetToken("/*" & Comment & "*/", TK_BLOCK_COMMENT)
Exit Function
End If

If Mid(Inp, ParserPos, 1) = "/" Then
Comment = c
Do While Mid(Inp, ParserPos, 1) <> vbCr And Mid(Inp, ParserPos, 1) <> vbLf
Comment = Comment + Mid(Inp, ParserPos, 1)
IncParserPos

If ParserPos >= InpLen Then Exit Do
Loop

IncParserPos
If (WantedNewLine) Then PrintNewLine

Call SetToken(Comment, TK_COMMENT)
Exit Function
End If
End If

If (c = "'" Or c = """" Or (c = "/" And ((LastType = TK_WORD And LastText = "return") Or (LastType = TK_START_EXPR Or LastType = TK_END_BLOCK Or LastType = TK_OPERATOR Or LastType = TK_EOF Or LastType = TK_END_COMMAND)))) Then
Dim sep As String, esc As Boolean
sep = c
c = ""

If ParserPos < InpLen Then
Do While (esc Or Mid(Inp, ParserPos, 1) <> sep)
c = c + Mid(Inp, ParserPos, 1)

If esc = False Then
esc = Mid(Inp, ParserPos, 1) = "\"
Else
esc = False
End If

IncParserPos

If ParserPos > InpLen Then Exit Do
Loop
End If

IncParserPos

If LastType = TK_END_COMMAND Then PrintNewLine

Call SetToken(sep & c & sep, TK_STRING)
Exit Function
End If

If ChkInArr(c, Punct) Then
Do While (ParserPos < InpLen And ChkInArr(c & Mid(Inp, ParserPos, 1), Punct))
c = c + Mid(Inp, ParserPos, 1)
IncParserPos

If ParserPos > InpLen Then Exit Do
Loop

Call SetToken(c, TK_OPERATOR)
Exit Function
End If

Call SetToken(c, TK_UNKNOWN)
End Function

Private Function NewArr(ParamArray s()) As String()
ReDim NewArr(UBound(s))
Dim i As Long
For i = 0 To UBound(s)
NewArr()(i) = s(i)
Next
End Function

Public Function JsFmt(src As String) As String
fMain.Caption = "Please wait. Formating..."
DoEvents

ReDim Oup(0), Mode(0)
Dim IndentChar As String, IndentSize As Long
IndentChar = " "
IndentSize = 4

IndentString = String(IndentSize, IndentChar)

Inp = src
InpLen = Len(Inp) + 1

LastWord = ""
LastType = TK_START_EXPR
LastText = ""

BlockClosed = False
varLine = False
varLineTainted = False

ParserPos = 1

WhiteSpace = Split(vbCr & "," & vbLf & "," & vbTab, ",")
WordChar = Split("a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,0,1,2,3,4,5,6,7,8,9,_,$", ",")
Punct = Split("+ - * / % & ++ -- = += -= *= /= %= == === != !== > < >= <= >> << >>> >>>= >>= <<= && &= | || ! !! , : ? ^ ^= |=", " ")
arr1 = Split("else,catch,finally", ",")

LineStarters = Split("continue,try,throw,return,var,if,switch,case,default,for,while,break,function", ",")
curMode = "BLOCK"

ReDim Mode(1)
Mode(1) = curMode

IndentLevel = 0
InCase = False

Dim t
Do While True
t = GetNextToken
tokenText = tokenChar_
tokenType = tokenType_

If tokenType = TK_EOF Then Exit Do

Select Case tokenType
Case TK_START_EXPR
varLine = False
SetMode "EXPRESSION"
If LastType = TK_END_EXPR Or LastType = TK_START_EXPR Then

ElseIf LastType <> TK_WORD And LastType <> TK_OPERATOR Then
PrintSpace
ElseIf ChkInArr(LastWord, LineStarters) And LastWord <> "function" Then
PrintSpace
End If

PrintToken
Case TK_END_EXPR
PrintToken
RestoreMode
Case TK_START_BLOCK
If LastWord = "do" Then
SetMode "DO_BLOCK"
Else
SetMode "BLOCK"
End If

If LastType <> TK_OPERATOR And LastType <> TK_START_EXPR Then
If LastType = TK_START_BLOCK Then
PrintNewLine
Else
PrintSpace
End If
End If
PrintToken
Indent
Case TK_END_BLOCK
If LastType = TK_START_BLOCK Then
TrimOutput
UnIndent
Else
UnIndent
PrintNewLine
End If

PrintToken
RestoreMode
Case TK_WORD
If BlockClosed Then
PrintSpace
PrintToken
PrintSpace
GoTo TKWORDEND
End If

If tokenText = "case" Or tokenText = "default" Then
If LastText = ":" Then
RemoveIndent
Else
UnIndent
PrintNewLine
Indent
End If

PrintToken
InCase = True
GoTo TKWORDEND
End If

Prefix = "NONE"
If LastType = TK_END_BLOCK Then
If ChkInArr(LCase(tokenText), arr1) Then
Prefix = "NEWLINE"
Else
Prefix = "SPACE"
PrintSpace
End If
ElseIf (LastType = TK_END_COMMAND And (curMode = "BLOCK" Or curMode = "DO_BLOCK")) Then
Prefix = "NEWLINE"
ElseIf (LastType = TK_END_COMMAND And curMode = "EXPRESSION") Then
Prefix = "SPACE"
ElseIf LastType = TK_WORD Then
Prefix = "NEWLINE"
ElseIf LastType = TK_START_BLOCK Then
Prefix = "NEWLINE"
ElseIf LastType = TK_END_EXPR Then
PrintSpace
Prefix = "NEWLINE"
End If

If (LastType <> TK_END_BLOCK And ChkInArr(LCase(tokenText), arr1)) Then
PrintNewLine
ElseIf ChkInArr(tokenText, LineStarters) Or Prefix = "NEWLINE" Then
If LastText = "else" Then
PrintSpace
ElseIf ((LastType = TK_START_EXPR Or LastText = "=") And tokenText = "function") Then

ElseIf (LastType = TK_WORD And (LastText = "return" Or LastText = "throw")) Then
PrintSpace
ElseIf LastType <> TK_END_EXPR Then
If ((LastType <> TK_START_EXPR Or tokenText <> "var") And LastText <> ":") Then
If (tokenText = "if" And LastType = TK_WORD And LastWord = "else") Then
PrintSpace
Else
PrintNewLine
End If
End If
Else
If ChkInArr(tokenText, LineStarters) And LastText <> ")" Then
PrintNewLine
End If
End If
ElseIf Prefix = "SPACE" Then
PrintSpace
End If
PrintToken

LastWord = tokenText
If tokenText = "var" Then
varLine = True
varLineTainted = False
End If
TKWORDEND:
Case TK_END_COMMAND
PrintToken
varLine = False
Case TK_STRING
If LastType = TK_START_BLOCK Or LastType = TK_END_BLOCK Then
PrintNewLine
ElseIf LastType = TK_WORD Then
PrintSpace
End If
PrintToken
Case TK_OPERATOR
Dim StartDelim As Boolean, EndDelim As Boolean
StartDelim = True
EndDelim = True

If varLine And tokenText <> "," Then
varLineTainted = True
If tokenText = ":" Then varLine = False
End If

If tokenText = ":" And InCase Then
PrintToken
PrintNewLine
GoTo TKOPERATOREND
End If

InCase = False
If tokenText = "," Then
If varLine Then
If varLineTainted Then
PrintToken
PrintNewLine
varLineTainted = False
Else
PrintToken
PrintSpace
End If
ElseIf LastType = TK_END_BLOCK Then
PrintToken
PrintNewLine
Else
If curMode = "BLOCK" Then
PrintToken
PrintNewLine
Else
PrintToken
PrintSpace
End If
End If
GoTo TKOPERATOREND
ElseIf tokenText = "--" Or tokenText = "++" Then
If LastText = ";" Then
StartDelim = True
EndDelim = False
Else
StartDelim = False
EndDelim = False
End If
ElseIf tokenText = "!" And LastType = TK_START_EXPR Then
StartDelim = False
EndDelim = False
ElseIf LastType = TK_OPERATOR Then
StartDelim = False
EndDelim = False
ElseIf LastType = TK_END_EXPR Then
StartDelim = True
EndDelim = True
ElseIf tokenText = "." Then
StartDelim = False
EndDelim = False
ElseIf tokenText = ":" Then
StartDelim = MatchStr("^d+$", LastText)
End If

If StartDelim Then PrintSpace
PrintToken
If EndDelim Then PrintSpace
TKOPERATOREND:
Case TK_BLOCK_COMMENT
PrintNewLine
PrintToken
PrintNewLine
Case TK_COMMENT
PrintSpace
PrintToken
PrintNewLine
Case TK_UNKNOWN
PrintToken
End Select

LastType = tokenType
LastText = tokenText
Loop

JsFmt = Join(Oup, "")

fMain.Caption = "vIstaswx Code Formater"
DoEvents
End Function