ASP代码分析器

1、.<%'*'*'*程序名称：ASP代码分析器'*'*很遗憾，这个东西才写了不到一半。'*完成的只是将ASP分析成XML部份，而生成真正流程图部份由于本人的程序'*基础不过关。实在是力不从心，现在公布出来这点东西，希望有志人事将它'*完成，如果对这篇代码有什么问题或是有什么好的想法可以和我联系一下。'*也可以讨论一下如何更好的通过生成的XML生成完美的流程图。'*'*生成XML这段东西也比较生硬，语法分析部份还有很多的缺陷，容错和分析'*能力还比较弱，如果真的要去作的话。Dissect_ASP.

2、Dissect_Line这个'*Private函数还要作进一步的休整。'*'*而生成图形的Class我只作了第一层的显示。'*关键难点是如何在无限制镶嵌的流程语句中生成正确的流程图来。'*'*如果有办法生成流程语句的结构图，那子程序(class/function/sub等)里'*的编码可以直接交给这个函数处理生成合理的全布结构流程图。'*'*本篇代码作者：Coder / coder / '*2003-09-02 15:03'*'*'*'*'*读取ASP原码，然后分析成XML文

3、件。'*'*class Dissect_ASP private blnFile   '文件无ASP代码 private Dissect   '结果文集  Private sub Class_Initialize()  blnFile  =false end sub '* '* '*导入文件内容然后分出代码区并生成第一层代码，需要的参数：分析文件的代码(FileD

4、ata) '* '* public function LoadFile(byval FileData)  dim aryFileData  dim intUbound  dim fIndex  dim strASP  '纯ASP代码  dim intASP  '% >所在位置  dim strHTML  aryFileData=split(FileD

5、ata,"<" & "%")  intUbound=ubound(aryFileData)  if intUbound=0 then   LoadFile="该文件无ASP代码，无法进行分析。"   exit function  end if    if aryFileData(0)<>"" then  

6、0;Dissect=Dissect & shift_html(aryFileData(0)  end if  for fIndex=1 to intUbound   intASP=instr(aryFileData(fIndex),"%" & ">") '读取本块ASP代码块的结尾位置   strASP=left(aryFileData(fIndex),intASP-1) '截取纯ASP代码

7、0;  if left(strASP,1)="=" then    '如果< %后面第一个字符是=号，则表达该ASP块为单行显示代码    Dissect=Dissect & "<asp_code>response.write "&_         right(strASP,len(strASP)-1) &_

8、0;        "</asp_code>"   else    '处理多行ASP代码    Dissect=Dissect & lcase(Dissect_code(shift_html(strASP) & vbclrf   end if   '截取出% >号后的HTML代码

9、   strHTML=right(aryFileData(fIndex),len(aryFileData(fIndex)-intASP-1)   if strHTML<>"" then    '保存HTML代码    Dissect=Dissect & "<html_code>" & shift_html(strHTML) & "</html_c

10、ode>"   end if  next  LoadFile=Dissect end function '* '* '*处理ASP代码。需要参数：ASP代码块中所有的代码(FileASP) '* '* private function Dissect_code(byval FileASP)  dim arycode  dim cIndex  

11、dim strASP  arycode=split(FileASP,vbcrlf)  for cIndex=0 to ubound(arycode)   if arycode(cIndex)<>"" then    strASP=strASP & Dissect_Line(arycode(cIndex),cIndex) & vbcrlf   end if  next  

12、Dissect_code=strASP end function '* '* '*分析一行代码，需要的参数是：某行ASP代码(FileLine) '*注：exit强行退出指令在这里不提出，请在生成流程图时注意一下。 '* '* private function Dissect_Line(byval FileLine,byval FileIndex)  dim strFirst  dim strIF  dim

13、intIF  dim strDo  dim strEnd  dim strExit  dim intExit  '截取第一个单词  strFirst=MidFirst(FileLine)  select case lcase(strFirst) '对比代码行的第一个单词。   case "do","loop"    str

14、Do="/"    if lcase(strFirst)="do" then strDo=""    if RegEx_Test("(" & strFirst & "b)(.+)",FileLine) then     '如果do/loop后面有代码     if strDo="/&q

15、uot; then      '第一个单词是loop      Dissect_Line=RegEx_Replace("(" & strFirst & "b)(.+)",FileLine,"<asp_docdoer>$2</asp_docdoer></asp_do>")     else  

16、;    '第一个单词是do      Dissect_Line=RegEx_Replace("(" & strFirst & "b)(.+)",FileLine,"<asp_do><asp_docdoer>$2</asp_docdoer>")     end if    else

17、0;    '没有代码     Dissect_Line=RegEx_Replace("(" & strFirst & "b)",FileLine,"<" & strDo & "asp_do>")    end if   case "while"   

18、60;Dissect_Line=RegEx_Replace("(whileb)(.+)",FileLine,"<asp_while><whilecode>$2</whilecode>")   case "wend"    if RegEx_Test("(wendb)(.+)",FileLine) then     'wend后有注解资料 

19、60;   Dissect_Line=RegEx_Replace("(wendb)(.+)",FileLine,"<whileRem>$2</whileRem></asp_while>")    else     Dissect_Line=RegEx_Replace("(wendb)",FileLine,"<whileRem></whileRem>

20、</asp_while>")    end if   case "case"    Dissect_Line=RegEx_Replace("(caseb)(.+)",FileLine,"<asp_case><asp_casecode>$2</asp_casecode></asp_case>")   case "else

21、"    if RegEx_Test("(elseb)(.+)",FileLine) then     'else后有注解资料     Dissect_Line=RegEx_Replace("(elseb)(.+)",FileLine,"<asp_else><asp_elseRem>$2</asp_elseRem></asp_else>&qu

22、ot;)    else     'else后无代码     Dissect_Line=RegEx_Replace("(elseb)",FileLine,"<asp_else/>")    end if   case "elseif"    Dissect_Line=R

23、egEx_Replace("(elseifb)(.+)",FileLine,"<asp_elseif><asp_elseifcode>$2</asp_elseifcode></asp_elseif>")   case "for"    Dissect_Line=RegEx_Replace("(forb)(.+)",FileLine,"<asp_for><asp_forco

24、de>$2</asp_forcode>")   case "next"    if RegEx_Test("(nextb)(.+)",FileLine) then     'next后有注解资料     Dissect_Line=RegEx_Replace("(nextb)(.+)",FileLine,"<forRe

25、m>$2</forRem></asp_for>")    else     Dissect_Line=RegEx_Replace("(nextb)",FileLine,"<forRem></forRem></asp_for>")    end if   case "if"  

26、0; intIF=instr(instr(FileLine,"then"),FileLine,"'")    strIF=FileLine    if intIF>0 then strIF=left(FileLine,intIF)    if RegEx_Test("(ifb)(.+)(then)(W+)(n)",strIF &vbcrlf) then   

27、;  '单行if，即if . then .     Dissect_Line=RegEx_Replace("(ifb)(.+)(then)(.+)(n)",FileLine & vbcrlf,"<asp_if><asp_ifcode>$2</asp_ifcode><ifrem>$4</ifrem>")    else    

28、0;'多行if     Dissect_Line=RegEx_Replace("(ifb)(.+)(then)(.+)(n)",FileLine & vbcrlf,"<asp_if><asp_ifcode>$2</asp_ifcode><asp_code>$4</asp_code></asp_if>")    end if   case "

29、class","function","sub","property","select"    Dissect_Line=RegEx_Replace("(" & strFirst & "b)(s+)(.+)",FileLine,"<asp_" & strFirst & "><asp_" & strFirst & "

30、code>$3</asp_" & strFirst & "code>")   case "public","private"    select case true     '确认公开声明的是什么子程序     case RegEx_Test("(subb)(s+)(w+)",FileLine)&

31、#160;     'sub      Dissect_Line=RegEx_Replace("(public|private)(s)(subb)(s+)(.+)",FileLine,"<asp_sub type=""$1"" asp_name=""$5"">")     case RegEx_Te

32、st("(functionb)(s+)(w+)",FileLine)      'function      Dissect_Line=RegEx_Replace("(public|private)(s)(functionb)(s+)(.+)",FileLine,"<asp_function type=""$1"" asp_name=""$5"

33、">")     case RegEx_Test("(property)(s+)(w+)(s+)(w+)",FileLine)      'property      Dissect_Line=RegEx_Replace("(public|private)(s)(property)(s+)(w+)(s+)(.+)",FileLine,"<

34、asp_Property  type=""$1"" ptyle=""$3"" asp_name=""$7"">")    end select   case "end"    if instr(FileLine,"with")=0 then     &#

35、39;不是end with     strEnd=FileLine & vbcrlf     if RegEx_Test("(endb)(s+)(w+)(.+)(n)",strEnd) then      '代码后有注释      Dissect_Line=RegEx_Replace("(endb)(s+)(w+)(.+)(n)&q

36、uot;,strEnd,"<asp_$3rem>$4</asp_$3rem></asp_$3>")     else      '代码后无注释      Dissect_Line=RegEx_Replace("(endb)(s+)(w+)",FileLine,"</asp_$3>")  

37、60;  end if    else     '改行代码是end with     Dissect_Line="<asp_code>" & FileLine & "</asp_code>"    end if   case "rem"  &

38、#160; Dissect_Line="<rem>" & FileLine & "</rem>"   case else    Dissect_Line="<asp_code>" & FileLine & "</asp_code>"  end select end function '* '*

39、 '*处理要显示的HTML代码 '* '* private function shift_html(byval value)  value=replace(value,"&","&#38;")  value=replace(value,"<","&lt;")  value=replace(value,">","&gt;&

40、quot;)  shift_html=value end function '* '* '*截取一行代码中的第一个指令，需要的参数：代码行(Value)。 '* '* private function MidFirst(byval Value)  dim intLen  dim mIndex  dim strMid  dim intSpace  dim intChr_

41、9  dim intValue  dim intMono  intLen=len(Value)  if intLen=0 then exit function  for mIndex=1 to intLen   '从第一个字符开始循环   strMid=mid(Value,mIndex,1)   '找到第一个非空格或chr(9)的字符，确认为第一个单词的开始位置。  &#

42、160;if strMid<>" " and strMid<>chr(9) then exit for  next  if mIndex<intLen and strMid<>"'" then   '截取第一个单词   intChr_9 =instr(mIndex,Value,chr(9)   intSpace =instr(mIndex,Value

43、," ")   intMono  =instr(mIndex,Value,"'")   intValue=intSpace   '空格位置大于chr(9)及intChr_9不为0，则表示第一个单词的结束可能是chr(9)   if (intValue>intChr_9 and intChr_9<>0) or intValue=0 then intValue=intChr_9 

44、;  ''位置大于chr(9)及intMono_9不为0，则表示第一个单词的结束可能是'   if (intValue>intMono and intMono<>0) or intValue=0 then intValue=intMono   if intValue=>mIndex then    '该行代码只有多个指令单词，截取第一个。    MidFirst=mid(Value

45、,mIndex,intValue-mIndex)   else    '该行代码只有一个指令单词    MidFirst=right(Value,intLen-mIndex+1)   end if  else   'strMid='可确认应为全行是注解，返回注解标识。   MidFirst="rem"  end i

46、f end function '* '* '*正则表达式函数，返回查询结果 '* '* private function RegEx_Test(byval patrn,byval strng)   Dim regEx      ' 建立变量。   Set regEx = New RegExp  ' 建立正则表达式。   regEx.

47、Pattern = patrn   ' 设置模式。   regEx.IgnoreCase = True  ' 设置是否区分字符大小写。   regEx.Global = True   ' 设置全局可用性。   RegEx_Test = regEx.test(strng) ' 执行搜索。 end function '* '* '*正则替换，生成XML字段

48、 '* '* private function RegEx_Replace(byval patrn,byval strng,byval Value)   Dim regEx      ' 建立变量。   Set regEx = New RegExp  ' 建立正则表达式。   regEx.Pattern = patrn   ' 设置模式。 

49、0; regEx.IgnoreCase = True  ' 设置是否区分字符大小写。   regEx.Global = True   ' 设置全局可用性。   RegEx_Replace=regEx.Replace(strng,value) ' 执行搜索。 end functionend class'*'*'*根据Dissect_ASP分析成的XML代码生成图片'*'*class Dissect_Img priv

50、ate imgCode_Width private imgCode_Height private imgCode_Top    '起始高度 private imgCode_Left   '中心宽度 private imgCode_GapHeight  '间隔高度 private imgALLIndex    '图框索引 private imgStack  

51、  '图框堆栈，用来作为控制流程语句的开始记录，结束时删除， Private sub Class_Initialize()  imgCode_Width  =800  imgCode_Height  =250  imgCode_GapHeight =250 end sub public sub LoadFile(byval XmlData)  response.write "<v:group

52、ID=""group1"" style=""position:relative;WIDTH:100pt;HEIGHT:200pt;"" coordsize = ""1000,2000"">"  call Dissect_XML(XmlData)  response.write "<v:line style=""position:relative"" from=&qu

53、ot;"" & (imgCode_Width/2) & ",0"" to=""" & (imgCode_Width/2) & ","&(imgCode_GapHeight + imgCode_Height) * (imgALLIndex-1)&"""/>"&_      "</group>" e

54、nd sub '* '* '*分析XML代码，导出流程图 '* '* private sub Dissect_XML(byval XmlData)  dim objXML  dim xmlIndex  dim strNodeName '节点名称  dim strOldName '上一节点的名称  dim strCodeALL  dim img

55、Index  Set objXML = Server.CreateObject("Microsoft.XMLDOM")  if not objXML.loadXML(XmlData) then   response.write "XML文件加载失败。"   response.end  end if  for xmlIndex=0 to objXML.documentElement.ChildNodes.Length-

56、1   '历遍顶层结点   strNodeName=objXML.documentElement.ChildNodes.item(xmlIndex).nodeName   if strOldName<>strNodeName and strOldName<>"" then    '代码块结束处理    if replace(strCodeALL,vbcrlf,&quo

57、t;")<>"" then     '代码块不为空     response.write "<span id='ImgY" & imgIndex & "X" & 0 & "Z" & 0 & "_Code' style='Z-INDEX: 10; POSITION: absolute;display:n

58、one'>" & shift_html(strCodeALL) & "</span>"     response.write Coder_Img(strOldName,0,0,imgIndex)    end if    strCodeALL=""   end if   if strNodeName="as

59、p_code" or strNodeName="html_code" or strNodeName="rem" then    '非流程控制代码或子程序标识    strCodeALL=strCodeALL & objXML.documentElement.ChildNodes.item(xmlIndex).Text & vbcrlf   else    '流程控制

60、代码或子程序处理'    strCodeALL=strCodeALL & replace(strNodeName,"asp_","") & " " & objXML.selectNodes("/root/" & strNodeName & "/" & strNodeName & "code").item(0).Text    strC

61、odeALL=strCodeALL & objXML.documentElement.ChildNodes.item(xmlIndex).nodeName   end if      strOldName=strNodeName  next  imgALLIndex=imgIndex  set objXML=nothing end sub '* '* '*显示代码区域框，需要

62、参数： '*框内的文字(value)/高度叠加图框索引(intWidth)/图框所在层索引(intLevel)/当前层图框索引(imgIndex) '* '* private function Coder_Img(byval Value,byval intWidth,byval intLevel,byref imgIndex)  dim intH  intH=0  if intWidth>0 then intH=1  Coder_Img=&quo

63、t;<v:RoundRect id=""ImgY" & imgIndex & "X" & intWidth & "Z" & intLevel & """"&_     " style=""position:relative;top:" & (imgCode_GapHeight + imgCode_Height) * (imgIn

64、dex-intH) & "left:" & (intWidth * imgCode_Width)*1.5) & "width:" &_     imgCode_Width & "width:" & imgCode_Width & "height:" & imgCode_Height &_     "cursor: hand;z-inde

65、x:3"" onclick=""show(this,ImgY" & imgIndex & "X" & intWidth & "Z" & intLevel & "_Code)"">"&_     " <v:TextBox inset=""10pt,8pt,5pt,5pt"" style=&qu

66、ot;"font-size:9pt;"">" & ucase(Value) & "</v:TextBox>"&_     "</v:RoundRect>"  if intWidth=0 then imgIndex=imgIndex+1 end function '* '* '*处理要显示的HTML代码 '* '* private function shift_html(byval value)  value=replace(value,"&","&#38;") &#