<!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>
Start building with 50+ products and up to 12 months usage for Elastic Compute Service
1 on 1 presale consultation
24/7 Technical Support 6 Free Tickets per Quarter Faster Response
Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.
A comprehensive suite of global cloud computing services to power your business
Payment Methods We Support
