영삼넷IT 강국 = 김영삼 블로그에 오신걸 환영합니다.

<%

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,  "&lt;%")
                    if  firstPos  <=  0  then
                              exit  do
                    end  if
                    lastPos  =  instr(firstPos,  strTemp,  "%&gt;")
                    if  lastPos  <=  0  then
                              lastPos  =  len(strTemp)
                    end  if
                    lastPos  =  lastPos  +  len("%&gt;")  -  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,"&","&amp;"),"<","&lt;"),">","&gt;"),"  ","&nbsp;  "),"          ","&nbsp;  &nbsp;  &nbsp;  &nbsp;  &nbsp;  "),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
%>