首页
所有分类
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 相关文章推荐
Javascript中暂停功能的实现代码
Mar 04 Javascript
在JS中最常看到切最容易迷惑的语法(转)
Oct 29 Javascript
JS测试显示屏分辨率以及屏幕尺寸的方法
Nov 22 Javascript
jQuery产品间断向下滚动效果核心代码
May 08 Javascript
node.js中的fs.readlinkSync方法使用说明
Dec 17 Javascript
jquery实现顶部向右伸缩的导航区域代码
Sep 02 Javascript
jquery ezUI 双击行记录弹窗查看明细的实现方法
Jun 01 Javascript
js数组操作方法总结(必看篇)
Nov 22 Javascript
基于jQuery Easyui实现登陆框界面
Jul 10 jQuery
jQuery接受后台传递的List的实例详解
Aug 02 jQuery
Vue render深入开发讲解
Apr 13 Javascript
利用Angular2的Observables实现交互控制的方法
Dec 27 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
mysql(6) name_scope (1) 神经网络(7) 字符集(1) 2022年7月新番(1) OVERLORD(1) data(4) 数据表(1) character(1) variable_scope(1)
You might like
php中{}大括号是什么意思
2013/12/01 PHP
更改localhost为其他名字的方法
2014/02/10 PHP
PHP数组操作――获取数组最后一个值的方法
2015/04/14 PHP
使用JavaScript创建新样式表和新样式规则
2016/06/14 PHP
php实现mysql连接池效果实现代码
2018/01/25 PHP
Laravel 在views中加载公共页面的实现代码
2019/10/22 PHP
基于jquery的jqDnR拖拽溢出的修改
2011/02/12 Javascript
IE6/7/8中Option元素未设value时Select将获取空字符串
2011/04/07 Javascript
js读写(删除)Cookie实例详解
2013/04/17 Javascript
用JQuery 判断某个属性是否存在hasAttr的解决方法
2013/04/26 Javascript
jQuery插件 selectToSelect使用方法
2013/10/02 Javascript
浅谈js中test()函数在正则中的使用
2016/08/19 Javascript
ie下js不执行的几种可能
2017/02/28 Javascript
用JS实现简单的登录验证功能
2017/07/28 Javascript
vue2实现可复用的轮播图carousel组件详解
2017/11/27 Javascript
详解VSCode配置启动Vue项目
2019/05/14 Javascript
浅谈JavaScript中this的指向问题
2020/07/28 Javascript
[01:14]2019完美世界城市挑战赛（秋季赛）全国总决赛精彩花絮
2020/01/08 DOTA
Python2.x利用commands模块执行Linux shell命令
2016/03/11 Python
matplotlib绘制符合论文要求的图片实例(必看篇)
2017/06/02 Python
python微信跳一跳系列之自动计算跳一跳距离
2018/02/26 Python
python2.7实现邮件发送功能
2018/12/12 Python
Python中使用双下划线防止类属性被覆盖问题
2019/06/27 Python
Python模块 _winreg操作注册表
2020/02/05 Python
Python matplotlib图例放在外侧保存时显示不完整问题解决
2020/07/28 Python
Python在字符串中处理html和xml的方法
2020/07/31 Python
GoDaddy英国：全球排名第一的域名注册商
2018/06/08 全球购物
FC-Moto西班牙：摩托车手最大的购物场所之一
2019/04/11 全球购物
印度手工编织服装和家居用品商店：Fabindi
2019/10/07 全球购物
如何用SQL语句进行模糊查找
2015/09/25 面试题
中学教师管理制度
2014/01/14 职场文书
2014乡镇“三八”国际劳动妇女节活动总结
2014/03/01 职场文书
霸气队列口号
2014/06/18 职场文书
财务管理专业自荐书
2014/09/02 职场文书
2014年销售经理工作总结
2014/12/01 职场文书
HTML基础-标签分类(闭合标签，空标签，块级元素，行内元素，行级块元素，可替换元素)
2021/03/31 HTML / CSS