加亮显示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 provi...
<%@ 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
%>
<% 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
%>
- 转载请注明来源:IT学习网 网址:http://www.t086.com/ 向您的朋友推荐此文章
- 特别声明: 本站除部分特别声明禁止转载的专稿外的其他文章可以自由转载,但请务必注明出处和原始作者。文章版权归文章原始作者所有。对于被本站转载文章的个人和网站,我们表示深深的谢意。如果本站转载的文章有版权问题请联系我们,我们会尽快予以更正。