加亮显示ASP文章原代码 - ASP Source code

<%@ 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 @R_8_4045@ION 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">

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

<hr>
<font FACE="VERDANA,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)
    '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,"<" & "/SCRIPT",iPos) = iPos Then
    iTemp = iPos
    fCheckLine = 4
  End If

  iPos = InStr(1,"<" & "!--",iPos) = iPos Then
    iTemp = iPos
    fCheckLine = 5
  End If

  iPos = InStr(1,"-" & "->",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,fCheckLine(strLine))

      Case 3
        iPos = InStr(1,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,"<" & "/SCRIPT>",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,iPos - 1))
        Response.Write("<FONT COLOR=#0000ff>")
        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
%>

加亮显示ASP文章原代码 - ASP Source code

相关推荐