开发者网络 动网主机 支持论坛 邮局 帮助
当前位置:网络学院ASP技术客户端相关 → 加亮显示ASP文章原代码
加亮显示ASP文章原代码
日期:2000年7月1日 作者: 人气:     [ ]
<%@ 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">   </td>
    <td><font FACE="VERDANA, ARIAL, HELVETICA" SIZE="2">ASP Script</font> </td>
  </tr>
  <tr>
    <td BGCOLOR="#0000FF">   </td>
    <td><font FACE="VERDANA, ARIAL, HELVETICA" SIZE="2">Comments</font> </td>
  </tr>
  <tr>
    <td BGCOLOR="#000000">   </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(" ")
      Next
    End If
    iPos = InStr(strLine, "<")
    If iPos Then
      Response.Write(Left(strLine, iPos - 1))
      Response.Write("<")
      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("<%")
        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("%>")
        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("<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("</SCRIPT>")
        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("<!--")
        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("-->")
        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
%>

(出处:)

相关文章:
 
·SQL Server 2000 SP4发布
·Sql Server 2005最新CTP简介及截图
·微软发布数据库新测试版 最终版明夏登场
·网络社区论坛即将成为互联网下一热点
·SET NOCOUNT的用法和注意事项
·全正则的检测IP是否合法的函数
·判断一个access数据库中某个表是否存在的方法
·用Asp生成条形码
·数字小写到英文大写的转换
·在不支持FSO的服务器上使用XMLDOM创建HTML文件
相关软件:
 
·拓域会员核心系统 v1.02
·深博贴吧(仿百度)双数据库版 v1.5
·通用草稿自动保存系统SipoAutoSaver v2.0
·BJXSHOP网上开店专家 v6.0 SP1 Build 20060118
·企业网站智能管理系统(TZIMS) v1.5
·bzmtv v1.0 正式版
·宜兴二级域名申请系统SQL版
·Mslove交友系统 v3.0
·亿人通讯录 v3.0
·深博贴吧(仿百度)双数据库版 v1.0
说明:本站部分内容收集于网络,如有侵犯您的权益请来信告知,我们会第一时间进行处理,谢谢
 → 特别推荐
 → 热点TOP10

关于本站 | 诚聘英才 | 业务合作 | 联系我们 | 广告合作 | 收藏本站

海口动网先锋网络科技有限公司版权所有
Copyright ? 2000 - 2003 AspSky.Net
中华人民共和国电信与信息服务业务经营许可证编号 琼 ICP 020077