정해준 경로의 소스를 출력하는 함수를 간단하게 만들어보았습니다.
당연한 말이겠지만 같은 사이트 내의 소스만 출력이 됩니다.
function show_source(url)
Set oFSO = Server.CreateObject("Scripting.FileSystemObject")
strFilepath = Server.Mappath(url)
Set oFile = oFSO.OpenTextFile(strFilepath, 1)
strText = oFile.ReadAll
Set oFile = nothing
Set oFSO = nothing
strText = Replace(strText, "&", "&")
strText = Replace(strText, "<", "<")
strText = Replace(strText, " ", " ")
strText = Replace(strText, vbTab, " ")
strText = Replace(strText, vbCrLf, "<br>")
show_source = strText
end function
%>
<code>
<%=show_source("show_source.asp")%>
</code>
Replace 부분에서 매번 strText 변수에 재할당하지 않고 한줄로 한번에 변환하는 것이 실행 효율이 조금 더 낫지만, 저렇게 Replace 항목이 많은 경우에는 여러줄로 나누어 보기 좋게 해주는 것이 수정을 편하게 하여 유지보수 생산성이 높아집니다.
<code> 태그는 코드를 화면에 출력할때 사용하는 <xmp> 태그와 유사한 동작을 합니다.
함수내에서 화면 출력에 필요한 작업을 이미 대부분 해놓은 상태이므로 코드 출력용 태그는 사실상 불필요합니다. 위의 경우는 단순히 보기 좋으라고 <code> 태그를 붙여놓은 것이므로 제거하셔도 무방합니다.
참고로 <code> 태그 위치에 <xmp> 태그를 대신 사용하면 사소한 문제가 하나 생기니 주의하시길 바랍니다.
============================================================================================================================
늦어지만 저도 답변달아 봅니다.
아래와 같이 보여지게 만들어 줍니다.
<%
Sub viewCode(codefile)
response.write "<p style=""background-color=#eeeeee;"">"
set fso = server.createobject("scripting.filesystemobject")
set f = fso.opentextfile(server.mappath(codefile),1)
allViewCode = viewHTML(f.readall)
set f = nothing
response.write codingcolor(allviewcode,"brown")
response.write "</p>"
End Sub
'Coding부분을 찾아서 Coloring함수로...
function CodingColor(strTemp,strFontColor)
Dim firstPos
Dim lastPos
Dim leftString
Dim midString
Dim rightString
Dim xmidString
firstPos =1
lastPos = 1
do until lastPos >= len(strTemp)
firstPos = instr(lastPos, strTemp, "<%")
if firstPos <= 0 then
exit do
end if
lastPos = instr(firstPos, strTemp, "%>")
if lastPos <= 0 then
lastPos = len(strTemp)
end if
lastPos = lastPos + len("%>") - 1
leftString = left(strTemp,firstPos-1)
midString = mid(strTemp,firstPos,lastPos-firstPos+1)
rightString = mid(strTemp,lastPos+1,len(strTemp)-lastPos)
xmidString = coloring(midString)
' strTemp = leftString & xmidString & rightString
' lastPos = firstPos + len(xmidString)-1
strTemp = leftString & "<span style=color:" & strFontColor & ";>" & xmidString & "</span>" & rightString
lastPos = firstPos + len("<span style=color:" & strFontColor & ";>" & xmidString & "</span>")-1
loop
CodingColor = strTemp
end function
function coloring(strViewCode)
Dim Reservedwords
Dim aryReservedword
Dim i
Dim strFunction
Dim aryFunction
Reservedwords="And|Call|Case|Const|Dim|Do|Each|Else|ElseIf|Empty|End|Eqv|Erase|Error|Exit|Explicit|False|For|Function|If|Imp|In|Is|Loop|Mod|Next|Not|Nothing|Null|On|Option|Or|Private|Public|Randomize|ReDim|Resume|Select|Set|Step|Sub|Then|To|True|Until|Wend|While|Xor"
aryReservedword=split(Reservedwords,"|")
for i = 0 to ubound(aryReservedword)
strViewCode = wordReplace(strViewCode,aryReservedword(i),"blue")
next
strFunction="Anchor|Array|Asc|Atn|CBool|CByte|CCur|CDate|CDbl|Chr|CInt|CLng|Cos|CreateObject|CSng|CStr|Date|DateAdd|DateDiff|DatePart|DateSerial|DateValue|Day|Dictionary|Document|Element|Err|Exp|FileSystemObject|Filter|Fix|Int|Form|FormatCurrency|FormatDateTime|FormatNumber|FormatPercent|GetObject|Hex|History|Hour|InputBox|InStr|InstrRev|IsArray|IsDate|IsEmpty|IsNull|IsNumeric|IsObject|Join|LBound|LCase|Left|Len|Link|LoadPicture|Location|Log|LTrim|RTrim|Trim|Mid|Minute|Month|MonthName|MsgBox|Navigator|Now|Oct|Replace|Right|Rnd|Round|ScriptEngine|ScriptEngineBuildVersion|ScriptEngineMajorVersion|ScriptEngineMinorVersion|Second|Sgn|Sin|Space|Split|Sqr|StrComp|String|StrReverse|Tan|Time|TextStream|TimeSerial|TimeValue|TypeName|UBound|UCase|VarType|Weekday|WeekDayName|Window|Year"
aryFunction=split(strFunction,"|")
for i = 0 to ubound(aryFunction)
strViewCode = wordReplace(strViewCode,aryFunction(i),"red")
next
strviewcode = blockcomment(strviewcode,"""", "magenta")
strviewcode = linecomment(strviewcode,"'", "green")
coloring = linecomment(strviewcode,"Rem", "green")
end function
'HTML 보기에서 단어에 색상입히기
Function wordReplace(strSearchWithin,strSearchFor,fontcolor)
Dim lngStartingPosition
Dim lngFoundPosition
Dim strReplaced
Dim ascBlank
lngStartingPosition=1
lngFoundPosition=InStr(lngStartingPosition,strSearchWithin,strSearchFor,1)
do while lngFoundPosition > 0
ascBlank=asc(Mid(strSearchWithin,lngFoundPosition-1,1))
if (ascBlank>=48 and ascBlank<=57) or (ascBlank>=65 and ascBlank<=90) or (ascBlank>=97 and ascBlank<=122) then
strReplaced=strReplaced & Mid(strSearchWithin,lngStartingPosition,lngFoundPosition-lngStartingPosition) & mid(strSearchWithin,lngFoundPosition,len(strSearchFor))
else
ascBlank=asc(Mid(strSearchWithin,lngFoundPosition+len(strSearchFor),1))
if (ascBlank>=48 and ascBlank<=57) or (ascBlank>=65 and ascBlank<=90) or (ascBlank>=97 and ascBlank<=122) then
strReplaced=strReplaced & Mid(strSearchWithin,lngStartingPosition,lngFoundPosition-lngStartingPosition) & mid(strSearchWithin,lngFoundPosition,len(strSearchFor))
else
'found
strReplaced=strReplaced & Mid(strSearchWithin,lngStartingPosition,lngFoundPosition-lngStartingPosition) & "<font color=" & fontcolor & ">" & mid(strSearchWithin,lngFoundPosition,len(strSearchFor)) & "</font>"
end if
end if
lngStartingPosition=lngFoundPosition+len(strSearchFor)
lngFoundPosition=InStr(lngStartingPosition,strSearchWithin,strSearchFor,1)
Loop
wordReplace=strReplaced & Mid(strSearchWithin,lngStartingPosition) 'catch the last one
End Function
'HTML 보기
function viewHTML(strHTML)
viewHTML = replace(replace(replace(replace(replace(replace(strHTML,"&","&"),"<","<"),">",">")," "," ")," "," "),vbcrlf,"<br>" & vbcrlf)
end function
'줄단위 주석문 처리
function linecomment(strTemp, strCommentChar, strFontColor)
Dim firstPos
Dim lastPos
Dim leftString
Dim midString
Dim rightString
Dim xmidString
firstPos =1
lastPos = 1
do until lastPos >= len(strTemp)
firstPos = instr(lastPos, strTemp, strCommentChar)
if firstPos <= 0 then
exit do
end if
lastPos = instr(firstPos, strTemp, "<br>" & vbcrlf) + 5
if lastPos <= 0 then
lastPos = len(strTemp)
end if
'Single Quotation & "Rem" String Exception ("'", "Rem")
If not(mid(strTemp, firstPos-1, 1)="""" And mid(strTemp,firstPos + Len(strCommentChar),1)="""") Then
leftString = left(strTemp,firstPos-1)
midString = mid(strTemp,firstPos,lastPos-firstPos+1)
rightString = mid(strTemp,lastPos+1,len(strTemp)-lastPos)
xmidString = extractColor(midString)
strTemp = leftString & "<font color=" & strFontColor & ">" & xmidString & "</font>" & rightString
lastPos = instr(firstPos, strTemp, "<br>" & vbcrlf) + 6
Else
lastPos = lastPos + 1
End If
loop
linecomment = strTemp
end function
'블럭단위 주석문 처리
function blockcomment(strTemp, strCommentChar, strFontColor)
Dim firstPos
Dim lastPos
Dim leftString
Dim midString
Dim rightString
Dim xmidString
firstPos =1
lastPos = 1
do until lastPos >= len(strTemp)
firstPos = instr(lastPos, strTemp, strCommentChar)
if firstPos <= 0 then
exit do
end if
lastPos = instr(firstPos+len(strCommentChar), strTemp, strCommentChar)
if lastPos <= 0 then
lastPos = len(strTemp)
end if
lastPos = lastPos + len(strCommentChar)-1
leftString = left(strTemp,firstPos-1)
midString = mid(strTemp,firstPos,lastPos-firstPos+1)
rightString = mid(strTemp,lastPos+1,len(strTemp)-lastPos)
xmidString = extractColor(midString)
strTemp = leftString & "<font color=" & strFontColor & ">" & xmidString & "</font>" & rightString
lastPos = firstPos + len("<font color=" & strFontColor & ">" & xmidString & "</font>")
loop
blockcomment = strTemp
end function
function extractColor(strColor)
dim exfirstPos
dim exlastPos
Dim xleftString
Dim xmidString
Dim xrightString
extractColor = strColor
' exit function
exfirstPos =1
exlastPos = 1
do until exlastPos >= len(strColor)
exfirstPos = instr(exlastPos, strColor, "<font color=")
if exfirstPos <= 0 then
exit do
end if
exlastPos = instr(exfirstPos + 11, strColor, ">")
if exlastPos <= 0 then
exit do
end if
xleftString = left(strColor,exfirstPos-1)
xmidString = mid(strColor,exfirstPos,exlastPos-exfirstPos+1)
xrightString = mid(strColor,exlastPos+1,len(strColor)-exlastPos)
strColor = xleftString & xrightString
exlastPos = exfirstPos-1
exfirstPos = exlastPos
loop
extractColor = replace(strColor,"</font>","")
end function
%>