首页
所有分类
TAGS
文字工具 EMOJI BIBLE
编程 Javascript

VBScript版代码高亮

Posted in Javascript onJune 26, 2006

<!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 & " "
    ElseIf X = """" Then
     Content = Content & """
    ElseIf X = "&" Then
     Content = Content & "&"
    ElseIf X = "<" Then
     Content = Content & "<"
    ElseIf X = ">" Then
     Content = Content & ">"
    ElseIf X = Chr(9) Then
     Content = Content & "  "
    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 ,"&","&")
  Str = Replace(Str ,"<","<")
  Str = Replace(Str ,">",">")
  Str = Replace(Str ,"""",""")
  Str = Replace(Str ,Chr(9),"  ")
  Str = Replace(Str ," "," ")
  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版代码高亮

声明：登载此文出于传递更多信息之目的，并不意味着赞同其观点或证实其描述。

Javascript 相关文章推荐
jQuery实现的Email中的收件人效果（按del键删除）
Mar 20 Javascript
javascript 主动派发事件总结
Aug 09 Javascript
jquery操作checked属性以及disabled属性的多种方法
Jun 20 Javascript
基于JavaScript实现移动端TAB触屏切换效果
Oct 20 Javascript
深入浅出ES6新特性之函数默认参数和箭头函数
Aug 01 Javascript
在web中js实现类似excel的表格控件
Sep 01 Javascript
JS获取IE版本号与HTML设置IE文档模式的方法
Oct 09 Javascript
react-router实现跳转传值的方法示例
May 27 Javascript
jquery.picsign图片标注组件实例详解
Feb 02 jQuery
浅谈vue方法内的方法使用this的问题
Sep 15 Javascript
JavaScript常见继承模式实例小结
Jan 11 Javascript
Vue.js路由实现选项卡简单实例
Jul 24 Javascript
JavaScript TO HTML 转换
Jun 26 #Javascript
HTML TO JavaScript 转换
Jun 26 #Javascript
文字幻灯片
Jun 26 #Javascript
制作特殊字的脚本
Jun 26 #Javascript
可拖动窗口，附带鼠标控制渐变透明，开启关闭功能
Jun 26 #Javascript
一端时间轮换的广告
Jun 26 #Javascript
将HTML自动转为JS代码
Jun 26 #Javascript
celery(1) Mysql8(2) OOP(1) 条形码(1) SeaTable(1) tree shaking(1) 黑屏(2) Outlook(1) Three.js(1) MutationObserver(1)
You might like
PHP_Flame(Version:Progress)的原代码
2006/10/09 PHP
php print EOF实现方法
2009/05/21 PHP
php检测文本的编码
2015/07/26 PHP
WordPress后台中实现图片上传功能的实例讲解
2016/01/11 PHP
PHP抓取及分析网页的方法详解
2016/04/26 PHP
ThinkPHP框架实现的MySQL数据库备份功能示例
2018/05/24 PHP
非常不错的功能强大代码简单的管理菜单美化版
2008/07/09 Javascript
Jquery实现的tab效果可以指定默认显示第几页
2013/10/16 Javascript
js与jQuery 获取父窗、子窗的iframe
2013/12/20 Javascript
js实现仿QQ秀换装效果的方法
2015/03/04 Javascript
nodejs实现获取当前url地址及url各种参数值
2015/06/25 NodeJs
vue-自定义组件传值的实例讲解
2018/09/18 Javascript
Javascript中绑定click事件的四种方式介绍
2018/10/26 Javascript
详解小程序云开发数据库
2019/05/20 Javascript
vue 强制组件重新渲染(重置)的两种方案
2019/10/29 Javascript
[03:10]超级美酒第四天 fy拉比克秀 大合集
2018/06/05 DOTA
python多线程扫描端口示例
2014/01/16 Python
python使用Flask框架获取用户IP地址的方法
2015/03/21 Python
python中set()函数简介及实例解析
2018/01/09 Python
tensorflow 获取变量&amp;打印权值的实例讲解
2018/06/14 Python
pytorch: tensor类型的构建与相互转换实例
2018/07/26 Python
WIn10+Anaconda环境下安装PyTorch(避坑指南)
2019/01/30 Python
python 实现读取一个excel多个sheet表并合并的方法
2019/02/12 Python
Python二叉树的镜像转换实现方法示例
2019/03/06 Python
opencv python图像梯度实例详解
2020/02/04 Python
详解python的变量缓存机制
2021/01/24 Python
浅析HTML5：'data-'属性的作用
2018/01/23 HTML / CSS
迪卡侬(Decathlon)加拿大官网：源自法国的运动专业超市
2020/11/22 全球购物
政法学院毕业生求职信
2014/02/28 职场文书
机电一体化专业求职信
2014/07/22 职场文书
2015年国庆节新闻稿
2015/07/18 职场文书
致运动员的广播稿
2015/08/19 职场文书
2016年大学生就业指导课心得体会
2015/10/09 职场文书
HTML5中 rem适配方案与 viewport 适配问题详解
2021/04/27 HTML / CSS
帮你提高开发效率的JavaScript20个技巧
2021/06/18 Javascript
Spring Data JPA框架自定义Repository接口
2022/04/28 Java/Android