<%
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
%>
'asp' 카테고리의 다른 글
escape JSON function (0) | 2010.08.24 |
---|---|
formatBytes (0) | 2010.08.24 |
alert function in asp (0) | 2010.08.24 |
get new non repeated file name on a specific folder (0) | 2010.08.24 |
dbhelper class (0) | 2010.08.24 |