帝国软件
  设为首页 加入收藏 关于我们
 
解密帝国网站管理系统
栏 目:
 
您的位置:首页 > 技术文档 > ASP编程 >
加亮显示ASP文章原代码
作者: 发布时间:2005-03-12 来源:
<%@ LANGUAGE="VBSCRIPT"  %>
<% Option Explicit %>
<%
    'File:        CodeBrws.asp
    'Overview:    This formats and writes the text of the selected page for
    '            the View Script Button  
    'This file is provided as part of the Microsoft Visual Studio 6.0 Samples

    'THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT
    'WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED,
    'INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES
    'OF MERCHANTABILITY AND/OR FITNESS FOR A  PARTICULAR
    'PURPOSE.

    'Copyright (C) 1997, 1998 Microsoft Corporation, All rights reserved
%>
<html>

<head>
<meta NAME="DESCRIPTION" CONTENT="ASP Source code browser">
<meta NAME="GENERATOR" CONTENT="Microsoft FrontPage 3.0">
<meta HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso8859-1">
<title></title>
</head>

<body BGCOLOR="#FFFFFF" TOPMARGIN="0" LEFTMARGIN="0" ALINK="#23238E" VLINK="#808080"
LINK="#FFCC00">
<basefont FACE="VERDANA, ARIAL, HELVETICA" SIZE="2"><!--- DISPLAY THE COLOR LEGEND --->


<table BORDER="1">
  <tr>
    <td WIDTH="25" BGCOLOR="#FF0000">&nbsp;&nbsp; </td>
    <td><font FACE="VERDANA, ARIAL, HELVETICA" SIZE="2">ASP Script</font> </td>
  </tr>
  <tr>
    <td BGCOLOR="#0000FF">&nbsp;&nbsp; </td>
    <td><font FACE="VERDANA, ARIAL, HELVETICA" SIZE="2">Comments</font> </td>
  </tr>
  <tr>
    <td BGCOLOR="#000000">&nbsp;&nbsp; </td>
    <td><font FACE="VERDANA, ARIAL, HELVETICA" SIZE="2">HTML and Text</font> </td>
  </tr>
</table>

<hr>
<font FACE="VERDANA, ARIAL, HELVETICA" SIZE="2"><% OutputSource %>
</font>
</body>
</html>
<%
  Sub OutputSource
    Dim strVirtualPath, strFilename
    strVirtualPath = Request("Source")
    strFilename = Server.MapPath(strVirtualPath)
    
    Dim FileObject, oInStream, strOutput
    'Creates a file object to hold the text of the selected page
    Set FileObject = CreateObject("Scripting.FileSystemObject")
    Set oInStream = FileObject.OpenTextFile(strFilename, 1, 0, 0)
    'Loop that writes each line of text in the file according to
    'the PrintLine function below
    While NOT oInStream.AtEndOfStream
      strOutput = oInStream.ReadLine
      Call PrintLine(strOutput, fCheckLine(strOutput))
      Response.Write "<BR>"
    Wend
  End Sub

  ' Returns the minimum number greater than 0
  ' If both are 0, returns -1
  Function fMin(iNum1, iNum2)
    If iNum1 = 0 AND iNum2 = 0 Then
      fMin = -1
    ElseIf iNum2 = 0 Then
      fMin = iNum1
    ElseIf iNum1 = 0 Then
      fMin = iNum2
    ElseIf iNum1 < iNum2 Then
      fMin = iNum1
    Else
      fMin = iNum2
    End If
  End Function

  Function fCheckLine (ByVal strLine)
  Dim iTemp, iPos
  fCheckLine = 0
  iTemp = 0
  
  iPos = InStr(strLine, "<" & "%")
  If fMin(iTemp, iPos) = iPos Then
    iTemp = iPos
    fCheckLine = 1
  End If
  
  iPos = InStr(strLine, "%" & ">")
  If fMin(iTemp, iPos) = iPos Then
    iTemp = iPos
    fCheckLine = 2
  End If
  
  iPos = InStr(1, strLine, "<" & "SCRIPT", 1)
  If fMin(iTemp, iPos) = iPos Then
    iTemp = iPos
    fCheckLine = 3
  End If
  
  iPos = InStr(1, strLine, "<" & "/SCRIPT", 1)
  If fMin(iTemp, iPos) = iPos Then
    iTemp = iPos
    fCheckLine = 4
  End If
  
  iPos = InStr(1, strLine, "<" & "!--", 1)
  If fMin(iTemp, iPos) = iPos Then
    iTemp = iPos
    fCheckLine = 5
  End If
  
  iPos = InStr(1, strLine, "-" & "->", 1)
  If fMin(iTemp, iPos) = iPos Then
    iTemp = iPos
    fCheckLine = 6
  End If
  
  End Function

  Sub PrintHTML (ByVal strLine)
    Dim iPos, iSpaces, i
    iSpaces = Len(strLine) - Len(LTrim(strLine))
    i = 1
    'Correct for tabs
    While Mid(Strline, i, 1) = Chr(9)
      iSpaces = iSpaces + 5
      i = i + 1
    Wend
    'Insert spaces
    If iSpaces > 0 Then
      For i = 1 to iSpaces
        Response.Write("&nbsp;")
      Next
    End If
    iPos = InStr(strLine, "<")
    If iPos Then
      Response.Write(Left(strLine, iPos - 1))
      Response.Write("&lt;")
      strLine = Right(strLine, Len(strLine) - iPos)
      Call PrintHTML(strLine)
    Else
      Response.Write(strLine)
    End If
  End Sub

  Sub PrintLine (ByVal strLine, iFlag)
    Dim iPos
    Select Case iFlag
      Case 0
        Call PrintHTML(strLine)
      
      Case 1
        iPos = InStr(strLine, "<" & "%")
        Call PrintHTML(Left(strLine, iPos - 1))
        Response.Write("<FONT COLOR=#ff0000>")
        Response.Write("&lt;%")
        strLine = Right(strLine, Len(strLine) - (iPos + 1))
        Call PrintLine(strLine, fCheckLine(strLine))
      
      Case 2
        iPos = InStr(strLine, "%" & ">")
        Call PrintHTML(Left(strLine, iPos -1))
        Response.Write("%&gt;")
        Response.Write("</FONT>")
        strLine = Right(strLine, Len(strLine) - (iPos + 1))
        Call PrintLine(strLine, fCheckLine(strLine))
      
      Case 3
        iPos = InStr(1, strLine, "<" & "SCRIPT", 1)
        Call PrintHTML(Left(strLine, iPos - 1))
        Response.Write("<FONT COLOR=#0000ff>")
        Response.Write("&lt;SCRIPT")
        strLine = Right(strLine, Len(strLine) - (iPos + 6))
        Call PrintLine(strLine, fCheckLine(strLine))
      
      Case 4
        iPos = InStr(1, strLine, "<" & "/SCRIPT>", 1)
        Call PrintHTML(Left(strLine, iPos - 1))
        Response.Write("&lt;/SCRIPT&gt;")
        Response.Write("</FONT>")
        strLine = Right(strLine, Len(strLine) - (iPos + 8))
        Call PrintLine(strLine, fCheckLine(strLine))
      
      Case 5
        iPos = InStr(1, strLine, "<" & "!--", 1)
        Call PrintHTML(Left(strLine, iPos - 1))
        Response.Write("<FONT COLOR=#0000ff>")
        Response.Write("&lt;!--")
        strLine = Right(strLine, Len(strLine) - (iPos + 3))
        Call PrintLine(strLine, fCheckLine(strLine))
      
      Case 6
        iPos = InStr(1, strLine, "-" & "->", 1)
        Call PrintHTML(Left(strLine, iPos - 1))
        Response.Write("--&gt;")
        Response.Write("</FONT>")
        strLine = Right(strLine, Len(strLine) - (iPos + 2))
        Call PrintLine(strLine, fCheckLine(strLine))
      
      Case Else
        Response.Write("Function Error -- Please contact the administrator.")
    End Select
  End Sub
%>
  
评论】【加入收藏夹】【 】【打印】【关闭
※ 相关链接
 ·VBS、ASP代码语法加亮显示的类(1  (2005-03-12)
 ·VBS、ASP代码语法加亮显示的类(2  (2005-03-12)

   栏目导行
  PHP编程
  ASP编程
  ASP.NET编程
  JAVA编程
   站点最新
·致合作伙伴的欢迎信
·媒体报道
·帝国软件合作伙伴计划协议
·放眼未来 帝国近期将有重大举措!
·PHPWind6.3.2版通行证发布
·帝国备份王2008版正式发布
·帝国备份王2008版发布
·phpcms2007转帝国CMS5.0程序发布
·dedecms5.1转帝国CMS5.0程序发布
·帝国网站管理系统V5.0商业购买说明
   类别最新
·在ASP中使用数据库
·使用ASP脚本技术
·通过启动脚本来感受ASP的力量
·学习使用ASP对象和组件
·解析asp的脚本语言
·初看ASP-针对初学者
·ASP开发10条经验总结
·ASP之对象总结
·ASP与数据库应用(给初学者)
·关于学习ASP和编程的28个观点
 
关于帝国 | 广告服务 | 联系我们 | 程序开发 | 网站地图 | 留言板 帝国网站管理系统