<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<title>VBScript版代码高亮</title>
<link href="style.css" rel="stylesheet" type="text/css" />
</head>

<body>
<div class="menu_head">VBScript版代码高亮</div>
<div class="content">
<script language="vbscript" type="text/vbscript">
'======================================
'代码高亮类
'使用方法:
'Set HL = New Highlight '定义类
'HL.Language = "vb" '指定程序语言,支持 VBS ,JS ,XML, HTML, SQL, C#, Java...等
'还可通过直接设置下列属性还设置相关关键字等
' Public Keywords  '关键字
' Public Objects  '对象
' Public SplitWords '分隔符
' Public LineComment '行注释
' Public CommentOn '多行注释
' Public CommentOff '多行注释结束
' Public Ignore  '是否区分大小写
' Public CodeContent '代码内容
' Public Tags   '标记
' Public StrOn  '字符串标记
' Public Escape  '字符串界定符转义
' Public IsMultiple '允许多行引用
'HL.CodeContent = "要高亮的代码内容"
'Response.Write(Hl.Execute) '该方法返回高亮后的代码
'=====================================

Class Highlight
 Public Keywords  '关键字
 Public Objects  '对象
 Public SplitWords '分隔符
 Public LineComment '行注释
 Public CommentOn '多行注释
 Public CommentOff '多行注释结束
 Public Ignore  '是否区分大小写
 Public CodeContent '代码内容
 Public Tags   '标记
 Public StrOn  '字符串标记
 Public Escape  '字符串界定符转义
 Public IsMultiple '允许多行引用
 Private Content

 Private Sub Class_Initialize
  Keywords = "function,void,this,boolean,while,if,return,new,true,false,try,catch,throw,null,else,int,long,do,var"  '关键字
  Objects = "src,width,border,cellspacing,cellpadding,align,bgcolor,class,style,href,type,name,String,Number,Boolean,RegExp,Error,Math,Date" '对象
  SplitWords = " ,.?!;:\/<>(){}[]""'=+-|*%@#$^&"&VBCRLF&CHR(9) '分隔符
  LineComment = "//" '行注释
  CommentOn = "/*" '多行注释
  CommentOff = "*/" '多行注释结束
  Ignore = 0  '是否区分大小写
  Tags = "a,img,html,head,body,title,style,script,language,input,select,div,span,button,img,iframe,frame,frameset,table,tr,td,caption,form,font,meta,textarea"  '标记
  StrOn = """'"  '字符串标记
  Escape = "\"  '字符串界定符转义
  CodeContent = ""
 End Sub

 Public Function Execute
  Dim S
  Dim T, Key, X, Str
  Dim Flag
  Flag = 1: S = 1
  For i = 1 to Len(CodeContent)
   If Instr(1, SplitWords, Mid(CodeContent, i, 1) , 0)>0 Then
    If Flag = 1 Then
     Key = Mid(Codecontent, S, i - S)
     If Keywords<>"" And Instr(1, ","& Keywords &"," , ","&Key&"," , Ignore)>0 Then
      Content = Content& "<font color=""blue"">"&Key&"</font>"
     ElseIf Objects<>"" And Instr(1,","& Objects &",", ","&Key&"," , Ignore)>0 Then
      Content = Content & "<font color=""red"">"&Key&"</font>"
     ElseIf Tags <>"" And Instr(1, ","& Tags &",", ","&Key&"," , Ignore)>0 Then
      Content = Content & "<font color=""#996600"">"&Key&"</font>"
     Else
      Content = Content & Key
     End If
    End if
    Flag = 0
    X = Mid(CodeContent, i, 1)
    If LineComment<>"" And Mid(CodeContent, i, Len(LineComment)) = LineComment Then
     S = Instr(i ,CodeContent, VBCRLF)
     if S = 0 Then
      S = Len(CodeContent)
     End if
     Content = Content & "<font color=""Green"">"& HtmlEnCode(Mid(CodeContent,i ,S - i ))&"</font>"
     i = S
    ElseIf StrOn<>"" And Instr(StrOn,Mid(CodeContent, i, 1))>0 Then
     Str = Mid(CodeContent, i, 1)
     S = i
     Do
      S = Instr(S + 1 ,CodeContent, Str, 1)
      if S <> 0 Then
       T = S - 1
       Do While Mid(CodeContent, T, 1) = Escape
        T = T-1
       Loop
       If (S -T) Mod 2 = 1 Then
        Exit Do
       End If
      Else
       S = Len(CodeContent)
       Exit Do
      End If
     Loop While 1
     Content = Content & "<font color=""#FF00FF"">"& HtmlEnCode(Mid(CodeContent,i, S - i + 1))&"</font>"
     i = S
    ElseIf CommentOn<>"" And Mid(CodeContent, i, Len(CommentOn)) = CommentOn Then
     S = Instr(i ,CodeContent, CommentOff, 1)
     if S = 0 Then
      S = Len(CodeContent)
     End if
     Content = Content & "<font color=""Green"">"& HtmlEnCode(Mid(CodeContent,i, S - i + Len(CommentOff) ))&"</font>"
     i = S + Len(CommentOff)
    ElseIf X = "" Then
     Content = Content & "&nbsp;"
    ElseIf X = """" Then
     Content = Content & "&quot;"
    ElseIf X = "&" Then
     Content = Content & "&amp;"
    ElseIf X = "<" Then
     Content = Content & "&lt;"
    ElseIf X = ">" Then
     Content = Content & "&gt;"
    ElseIf X = Chr(9) Then
     Content = Content & "&nbsp;&nbsp;"
    ElseIf X = VBLF Then
     Content = Content & "<br />"
    Else
     Content = Content & X
    End If
   Else
    If Flag = 0 Then
     S = i
     Flag = 1
    End if
   End If
  Next
  if Flag = 1 Then
   Execute = Content & Mid(CodeContent, S)
  Else
   Execute = content
  End If
 End Function

 Private Function HtmlEnCode(Str)
  If IsNull(Str) Then
   HtmlEnCode = "": Exit Function
  End if
  Str = Replace(Str ,"&","&amp;")
  Str = Replace(Str ,"<","&lt;")
  Str = Replace(Str ,">","&gt;")
  Str = Replace(Str ,"""","&quot;")
  Str = Replace(Str ,Chr(9),"&nbsp;&nbsp;")
  Str = Replace(Str ," ","&nbsp;")
  Str = Replace(Str ,VBLF,"<br />")
  HtmlEnCode = Str
 End Function

 Public Property Let Language(Str)
  Dim S
  S = UCase(Str)
  Select Case true
   Case S = "VB" Or S = "VBS" OR S = "VBSCRIPT":
    Keywords = "And,ByRef,ByVal,Call,Case,Class,Const,Dim,Do,Each,Else,ElseIf,Empty,End,Eqv,Erase,Error,Exit,Explicit,False,For,Function,Get,If,Imp,In,Is,Let,Loop,Mod,Next,Not,Nothing,Null,On,Option,Or,Private,Property,Public,Randomize,ReDim,Resume,Select,Set,Step,Sub,Then,To,True,Until,Wend,While,Xor,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,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,Year,Function"
    Objects ="String,Number,Boolean,Date,Integert,Long,Double,Single"
    SplitWords = ",.?!;:\/<>(){}[]""'=+-|*%@#$^& "&VBCRLF&Chr(9)
    LineComment = "'"
    CommentOn = ""
    CommentOff = ""
    StrOn = """"
    Escape = ""
    Ignore = 1
    CodeContent = ""
    Tags = ""

   Case s = "C#":
    Keywords = "abstract,as,base,bool,break,byte,case,catch,char,checked,class,const,continue,decimal,default,delegate,do,double,else,enum,event,explicit,extern,false,finally,fixed,float,for,foreach,get,goto,if,implicit,in,int,interface,internal,is,lock,long,namespace,new,null,object,operator,out,override,params,private,protected,public,readonly,ref,return,sbyte,sealed,short,sizeof,stackalloc,static,set,string,struct,switch,this,throw,true,try,typeof,uint,ulong,unchecked,unsafe,ushort,using,value,virtual,void,volatile,while"  '关键字
    Objects = "String,Boolean,DateTime,Int32,Int64,Exception,DataTable,DataReader" '对象
    SplitWords = " ,.?!;:\/<>(){}[]""'=+-|*%@#$^&"&VBCRLF&CHR(9) '分隔符
    LineComment = "//" '行注释
    CommentOn = "/*" '多行注释
    CommentOff = "*/" '多行注释结束
    Ignore = 0  '是否区分大小写
    Tags = ""  '标记
    StrOn = """"  '字符串标记
    Escape = "\"  '字符串界定符转义

   Case S = "JAVA" :
    Keywords = "abstract,boolean,break,byte,case,catch,char,class,const,continue,default,do,double,else,extends,final,finally,float,for,goto,if,implements,import,instanceof,int,interface,long,native,new,package,private,protected,public,return,short,static,strictfp,super,switch,synchronized,this,throw,throws,transient,try,void,volatile,while"  '关键字
    Objects = "String,Boolean,DateTime,Int32,Int64,Exception,DataTable,DataReader" '对象
    SplitWords = " ,.?!;:\/<>(){}[]""'=+-|*%@#$^&"&VBCRLF&CHR(9) '分隔符
    LineComment = "//" '行注释
    CommentOn = "/*" '多行注释
    CommentOff = "*/" '多行注释结束
    Ignore = 0  '是否区分大小写
    Tags = ""  '标记
    StrOn = """"  '字符串标记
    Escape = "\"  '字符串界定符转义

   Case S = "JS" OR S = "JSCRIPT" OR S = "JAVASCRIPT":
    Keywords = "function,void,this,boolean,while,if,return,new,true,false,try,catch,throw,null,else,int,long,do,var"  '关键字
    Objects = "String,Number,Boolean,RegExp,Error,Math,Date" '对象
    SplitWords = " ,.?!;:\/<>(){}[]""'=+-|*%@#$^&"&VBCRLF&CHR(9) '分隔符
    LineComment = "//" '行注释
    CommentOn = "/*" '多行注释
    CommentOff = "*/" '多行注释结束
    Ignore = 0  '是否区分大小写
    Tags = ""  '标记
    StrOn = """"  '字符串标记
    Escape = "\"  '字符串界定符转义

   Case S = "XML":
    Keywords = "!DOCTYPE,?xml,script,version,encoding"  '关键字
    Objects = "String,Number,Boolean,RegExp,Error,Math,Date" '对象
    SplitWords = " ,.?!;:\/<>(){}[]""'=+-|*%@#$^&"&VBCRLF&CHR(9) '分隔符
    LineComment = "//" '行注释
    CommentOn = "<!--" '多行注释
    CommentOff = "-->" '多行注释结束
    Ignore = 0  '是否区分大小写
    Tags = ""  '标记
    StrOn = """"  '字符串标记
    Escape = "\"  '字符串界定符转义

   Case S = "HTML":
   Case S = "SQL":
    Keywords = "COMMIT,DELETE,INSERT,LOCK,ROLLBACK,SELECT,TRANSACTION,READ,ONLY,WRITE,USE,ROLLBACK,SEGMENT,ROLE,EXCEPT,NONE,UPDATE,DUAL,WORK,COMMENT,FORCE,FROM,WHERE,INTO,VALUES,ROW,SHARE,MODE,EXCLUSIVE,UPDATE,ROW,NOWAIT,TO,SAVEPOINT,UNION,UNION,ALL,INTERSECT,MINUS,START,WITH,CONNECT,BY,GROUP,HAVING,ORDER,UPDATE,NOWAIT,IDENTIFIED,SET,DROP,PACKAGE,CREATE,REPLACE,PROCEDURE,FUNCTION,TABLE,RETURN,AS,BEGIN,DECLARE,END,IF,THEN,ELSIF,ELSE,WHILE,CURSOR,EXCEPTION,WHEN,OTHERS,NO_DATA_FOUND,TOO_MANY_ROWS,CURSOR_ALREADY_OPENED,FOR,LOOP,IN,OUT,TYPE,OF,INDEX,BINARY_INTEGER,RAISE,ROWTYPE,VARCHAR2,NUMBER,LONG,DATE,RAW,LONG RAW,CHAR,INTEGER,MLSLABEL,CURRENT,OF,DEFAULT,CURRVAL,NEXTVAL,LEVEL,ROWID,ROWNUM,DISTINCT,ALL,LIKE,IS,NOT,NULL,BETWEEN,ANY,AND,OR,EXISTS,ASC,DESC,ABS,CEIL,COS,COSH,EXP,FLOOR,LN,LOG,MOD,POWER,ROUND,SIGN,SIN,SINH,SQRT,TAN,TANH,TRUNC,CHR,CONCAT,INITCAP,LOWER,LPAD,LTRIM,NLS_INITCAP,NLS_LOWER,NLS_UPPER,REPLACE,RPAD,RTRIM,SOUNDEX,SUBSTR,SUBSTRB,TRANSLATE,UPPER,ASCII,INSTR,INSTRB,LENGTH,LENGTHB,NLSSORT,ADD_MONTHS,LAST_DAY,MONTHS_BETWEEN,NEW_TIME,NEXT_DAY,ROUND,SYSDATE,TRUNC,CHARTOROWID,CONVERT,HEXTORAW,RAWTOHEX,ROWIDTOCHAR,TO_CHAR,TO_DATE,TO_LABEL,TO_MULTI_BYTE,TO_NUMBER,TO_SINGLE_BYTE,DUMP,GREATEST,GREATEST_LB,LEAST,LEAST_UB,NVL,UID,USER,USERENV,VSIZE,AVG,COUNT,GLB,LUB,MAX,MIN,STDDEV,SUM,VARIANCE"  '关键字
    Objects = "" '对象
    SplitWords = " ,.?!;:\\/<>(){}[]""'=+-|*%@#$^&"&VBCRLF&CHR(9) '分隔符
    LineComment = "--" '行注释
    CommentOn = "/*" '多行注释
    CommentOff = "*/" '多行注释结束
    Ignore = 1  '是否区分大小写
    Tags = ""  '标记
    StrOn = "'"  '字符串标记
    Escape = ""  '字符串界定符转义
  End Select
 End Property
End Class
</script>
<script language="vbscript" type="text/vbscript">
Function plaster()
 document.form1.code.focus()
 document.execCommand("Paste")
End Function

Function goit(stx)
 Dim code,HL
 code = Document.all.code.value
 Set HL = New Highlight
 HL.Language = stx
 HL.CodeContent = code
 document.getElementById("highlight").innerHTML = Hl.Execute
End Function
</script>

<form method="post" name="form1">
<div align="center"><textarea rows="18" name="code" style="width:99%" id="code"></textarea></div>
 <input type="button" value="HTML" onclick="goit('html')" />
 <input type="button" value="VB/VBScript" onclick="goit('vb')" />
 <input type="button" value="JavaScript" onclick="goit('js')" />
 <input type="button" value="C#" onclick="goit('c#')" />
 <input type="button" value="SQL" onclick="goit('sql')" />
 <input type="button" value="XML" onclick="goit('xml')" />
 <input type="button" value="Java" onclick="goit('java')" />
 <input type="button" value="粘贴" onclick="plaster()" />
 <input type="reset" value="清空内容" />
</form>

<div id="highlight" align="left" style="width:98%;overflow:auto;word-wrap:word-break;word-break:break-all;"><div>
</body>
</html>

标签:
VBScript版代码高亮

免责声明:本站文章均来自网站采集或用户投稿,网站不提供任何软件下载或自行开发的软件! 如有用户或公司发现本站内容信息存在侵权行为,请邮件告知! 858582#qq.com
桃源资源网 Design By www.nqtax.com

评论“VBScript版代码高亮”

暂无“VBScript版代码高亮”评论...

RTX 5090要首发 性能要翻倍!三星展示GDDR7显存

三星在GTC上展示了专为下一代游戏GPU设计的GDDR7内存。

首次推出的GDDR7内存模块密度为16GB,每个模块容量为2GB。其速度预设为32 Gbps(PAM3),但也可以降至28 Gbps,以提高产量和初始阶段的整体性能和成本效益。

据三星表示,GDDR7内存的能效将提高20%,同时工作电压仅为1.1V,低于标准的1.2V。通过采用更新的封装材料和优化的电路设计,使得在高速运行时的发热量降低,GDDR7的热阻比GDDR6降低了70%。