首页
所有分类
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 相关文章推荐
JS记录用户登录次数实现代码
Jan 15 Javascript
js如何调用qq互联api实现第三方登录
Mar 28 Javascript
PHP 数组current和next用法分享
Mar 05 Javascript
javascript实现手机震动API代码
Aug 05 Javascript
JavaScript如何调试有哪些建议和技巧附五款有用的调试工具
Oct 28 Javascript
jquery判断checkbox是否选中及改变checkbox状态的实现方法
May 26 Javascript
jquery树形菜单效果的简单实例
Jun 06 Javascript
详解Node.js如何开发命令行工具
Aug 14 Javascript
JS严格模式知识点总结
Feb 27 Javascript
15个顶级开源JavaScript框架和库
Oct 10 Javascript
使用axios发送post请求,将JSON数据改为form类型的示例
Oct 31 Javascript
一篇文章带你搞懂Vue虚拟Dom与diff算法
Aug 25 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
信号同步(1) reduce()(1) 进度条(1) 生命周期(1) 死锁(3) 鲲鹏(1) 裁剪图片(1) PIL(1) Flask(2) Python(3)
You might like
PHP date函数参数详解
2006/11/27 PHP
PHP stream_context_create()作用和用法分析
2011/03/29 PHP
php中随机函数mt_rand()与rand()性能对比分析
2014/12/01 PHP
php判断文件夹是否存在不存在则创建
2015/04/09 PHP
CI框架源码解读之URI.php中_fetch_uri_string()函数用法分析
2016/05/18 PHP
在IIS下安装PHP扩展的方法（超简单）
2017/04/10 PHP
Javascript 判断客户端浏览器类型代码
2010/03/01 Javascript
jQuery1.6 使用方法一
2011/11/23 Javascript
jQuery ui插件的使用方法代码实例
2013/05/08 Javascript
JavaScript var声明变量背后的原理示例解析
2013/10/12 Javascript
同域jQuery(跨)iframe操作DOM(示例代码)
2013/12/13 Javascript
JS清空多文本框、文本域示例代码
2014/02/24 Javascript
分享33个jQuery与CSS3实现的绚丽鼠标悬停效果
2014/12/15 Javascript
js面向对象之常见创建对象的几种方式(工厂模式、构造函数模式、原型模式)
2015/11/09 Javascript
AngularJS模块详解及示例代码
2016/08/17 Javascript
JS如何生成一个不重复的ID的函数
2016/12/25 Javascript
vue2.0父子组件间通信的实现方法
2017/04/19 Javascript
详解Vue 2.0封装axios笔记
2017/06/22 Javascript
JSON创建键值对（key是中文或者数字）方式详解
2017/08/24 Javascript
Vue项目使用localStorage+Vuex保存用户登录信息
2019/05/27 Javascript
Vue3 中的数据侦测的实现
2019/10/09 Javascript
解决vue做详情页跳转的时候使用created方法 数据不会更新问题
2020/07/24 Javascript
Vue中的this.$options.data()和this.$data用法说明
2020/07/26 Javascript
在Python中使用模块的教程
2015/04/27 Python
感知器基础原理及python实现过程详解
2019/09/30 Python
tensorflow 初始化未初始化的变量实例
2020/02/06 Python
django queryset相加和筛选教程
2020/05/18 Python
维多利亚的秘密官方网站：Victoria’s Secret
2018/10/24 全球购物
澳大利亚鞋仓库：Shoe Warehouse
2019/07/25 全球购物
文职个人求职信范文
2013/09/23 职场文书
机械设计毕业生自荐信
2014/02/02 职场文书
喷漆工的岗位职责
2014/03/17 职场文书
十佳文明家庭事迹
2014/05/25 职场文书
防灾减灾活动总结
2014/08/30 职场文书
2014年收银工作总结
2014/11/13 职场文书
mysql幻读详解实例以及解决办法
2022/06/16 MySQL