测试环境为windows XP 专业版 SP2，暂时发现代码着色方面有Bug，虽然已有解决方法，不过由于代码量的原因(用记事本写代码真的很恼火)，暂时未纠正，另外预计将来加入自动完成等功能。
ps:利用VBS脚本+DHTML，主要功能由正则表达式+wmic来完成，代码需保存为HTA类型的文件，当然也可以更改为纯粹的VBS脚本，不过那样效率低多了，而且代码更复杂。
复制代码代码如下:
<HTML>
<HEAD>
<title>代码编辑器</title>
<HTA:APPLICATION selection="no" SCROLL="no" contextMenu="no" />
<SCRIPT LANGUAGE="VBSCRIPT">
'*******************************************************************'
'脚本开始
'*******************************************************************'
Set shell=CreateObject("WScript.Shell")
Set fso=CreateObject("Scripting.FileSystemObject")
'*******************************************************************'
'遍历本地所有类型文件
'*******************************************************************'
Sub OptionAdd(fExt)
str = "<select size=""1"" name=""objOption"" onChange=""TestSub"">"
Set objDataFiles = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!//./root/cimv2")
Set colFiles = objDataFiles. _
ExecQuery("Select * from CIM_DataFile where extension = '" & fExt & "'")
For Each objFile in colFiles
str = str & "<option value=""" & objFile.name & """>" & _
objFile.name & "</option>"
next
str = "<label>本地脚本文件:</label>" & str & "</select>"
forOption.innerHTML = str
end Sub
'*******************************************************************'
'颜色转换
'*******************************************************************'
Sub ChangeColor
if cxs.value = "vbs" then
WinMain.innerHTML = ChangeVBS(WinMain.innerText)
else 'CMD脚本
WinMain.innerHTML = ChangeCMD(WinMain.innerText)
end if
end Sub
'*******************************************************************'
'VBS转换模块
'*******************************************************************'
Function ChangeVBS(sText)
Set re=new RegExp
re.IgnoreCase =true
re.Global=true
'注释转换
re.Pattern = "(/'.*)/r/n"
sText = re.Replace(sText,"<font color=#339999>$1</font><p>")
'转换符号为[蓝色]
re.Pattern = "(/(|/)|/&|/+|/-|/*|/%|/:|/;|/.|/""" & ")"
sText = re.Replace(sText,"<font color=#993333>$1</font>")
sText = "<table ><tr><td width='1024' " & _
"style='word-break:break-all'><ol type=1>" & _
"<br /><li>" & sText & "</table>"
sText = Replace(sText,chr(13) & chr (10) ," </li><li> ")
'转换保留字为[蓝色]
re.Pattern="(/bAnd/b|/bByRef/b|/bByVal/b|/bCall/b" & _
"|/bCase/b|/bClass/b|/bConst/b|/bDim/b|/bDo/b" & _
"|/bEach/b|/bElse/b|/bElseIf/b|/bEmpty/b|/bEnd/b" & _
"|/bEqv/b|/bErase/b|/bError/b|/bExit/b|/bExplicit/b" & _
"|/bFalse/b|/bFor/b|/bFunction/b|/bGet/b|/bIf/b|/bImp/b" & _
"|/bIn/b|/bIs/b|/bLet/b|/bLoop/b|/bMod/b|/bNext/b|/bNot/b" & _
"|/bNothing/b|/bNull/b|/bOn/b|/bOption/b|/bOr/b|/bPrivate/b" & _
"|/bProperty/b|/bPublic/b|/bRandomize/b|/bReDim/b|/bRem/b" & _
"|/bResume/b|/bSelect/b|/bSet/b|/bStep/b|/bSub/b|/bThen/b" & _
"|/bTo/b|/bTrue/b|/bUntil/b|/bWend/b|/bWhile/b|/bXor/b|Vb[a-z]*)"
sText=re.Replace(sText,"<font color=blue>$1</font>")
'转换函数和对象为[红色]
re.Pattern="(/bAnchor/b|/bArray/b|/bAsc/b|/bAtn/b" & _
"|/bCBool/b|/bCByte/b|/bCCur/b|/bCDate/b|/bCDbl/b" & _
"|/bChr/b|/bCInt/b|/bCLng/b|/bCos/b|/bCreateObject/b" & _
"|/bCSng/b|/bCStr/b|/bDate/b|/bDateAdd/b|/bDateDiff/b" & _
"|/bDatePart/b|/bDateSerial/b|/bDateValue/b|/bDay/b" & _
"|/bDictionary/b|/bDocument/b|/bElement/b|/bErr/b|/bExp/b" & _
"|/bFileSystemObject /b|/bFilter/b|/bFix/b|/bInt/b|/bForm/b" & _
"|/bFormatCurrency/b|/bFormatDateTime/b|/bFormatNumber/b" & _
"|/bFormatPercent/b|/bGetObject/b|/bHex/b|/bHistory/b|/bHour/b" & _
"|/bInputBox/b|/bInStr/b|/bInstrRev/b|/bIsArray/b|/bIsDate/b" & _
"|/bIsEmpty/b|/bIsNull/b|/bIsNumeric/b|/bIsObject/b|/bJoin/b" & _
"|/bLBound/b|/bLCase/b|/bLeft/b|/bLen/b|/bLink/b|/bLoadPicture/b" & _
"|/bLocation/b|/bLog/b|/bLTrim/b|/bRTrim/b|/bTrim/b|/bMid/b" & _
"|/bMinute/b|/bMonth/b|/bMonthName/b|/bMsgBox/b|/bNavigator/b" & _
"|/bNow/b|/bOct/b|/bReplace/b|/bRight/b|/bRnd/b|/bRound/b" & _
"|/bScriptEngine/b|/bScriptEngineBuildVersion/b" & _
"|/bScriptEngineMajorVersion/b|/bScriptEngineMinorVersion/b" & _
"|/bSecond/b|/bSgn/b|/bSin/b|/bSpace/b|/bSplit/b|/bSqr/b" & _
"|/bStrComp/b|/bString/b|/bStrReverse/b|/bTan/b|/bTime/b" & _
"|/bTextStream/b|/bTimeSerial/b|/bTimeValue/b|/bTypeName/b" & _
"|/bUBound/b|/bUCase/b|/bVarType/b|/bWeekday/b|/bWeekDayName/b" & _
"|/bWindow/b|/bYear/b|/bWscript/b)"
sText=re.Replace(sText,"<font color=red>$1</font>")
ChangeVBS = sText
end Function
'*******************************************************************'
'CMD转换模块
'*******************************************************************'
Function ChangeCMD(sText)
Set re=new RegExp
re.IgnoreCase =true
re.Global=true
'等号转换
'sText = Replace(sText,"/","<font color=#FF0000>/</font>")
re.Pattern = "(/%|/=|//[a-z]*/b|/>|/<|/|)"
sText = re.Replace(sText,"<font color=#FF8C00>$1</font>")
'注释转换
re.Pattern = "(Rem/b.*/r/n|/bRem/b.*)"
sText = re.Replace(sText,"<font color=#20B2AA>$1</font>")
'改变符号的颜色
re.Pattern = "(/(|/)|/&|/+|/-|/*|/;|/""" & ")"
sText = re.Replace(sText,"<font size=5 color=#9932CC>$1</font>")
'改变所有命令的颜色
re.Pattern = "(/bShare/b|/bSetver/b|/bNlsfunc/b|/bMem/b|/bLh/b" & _
"|/bLoadhigh/b|/bloadfix/b|/bGraphics/b|/bForcedos/b" & _
"|/bFastopen/b|/bExe2bin/b|/bEdlin/b|/bEdlin/b|/bEdit/b" & _
"|/bDebug/b|/bDebug/b|/bAppend/b|/bSwitches/b|/bStacks/b" & _
"|/bShell/b|/bNtcmdprompt/b|/bLastdrive/b|/bInstall/b" & _
"|/bFiles/b|/bFcbs/b|/bEchoconfig/b|/bDriveparm/b|/bDosonly/b" & _
"|/bDos/b|/bDevicehigh/b|/bDevice/b|/bCountry/b|/bBuffers/b" & _
"|/bXcopy/b|/bWMIC/b|/bWinnt32/b|/bWinnt/b|/bW32tm/b" & _
"|/bVssadmin/b|/bVol/b|/bVerify/b|/bVer/b|/bUnlodctr/b" & _
"|/bTypeperf/b|/bType/b|/bTree/b|/bTracert/b|/bTracerpt/b" & _
"|/bTitle/b|/bTime/b|/bTftp/b|/bTelnet/b|/bTcmsetup/b" & _
"|/bTasklist/b|/bTaskkill/b|/bSfc/b|/bSysteminfo/b|/bSubst/b" & _
"|/bStart/b|/bSort/b|/bShutdown/b|/bShift/b|/bSetlocal/b|/bSet/b" & _
"|/bSecedit/b|/bSchtasks/b|/bSc/b|/bRunas/b|/bRsm/b|/bRsh/b" & _
"|/bRoute/b|/bRmdir/b|/bRexec/b|/bReset/b|/bReplace/b|/bRename/b" & _
"|/bRelog/b|/bRegsvr32/b|/bReg/b|/bRecover/b|/bRcp/b|/bRasdial/b" & _
"|/bQuery/b|/bPushd/b|/bPrompt/b|/bPrnqctl/b|/bPrnport/b" & _
"|/bPrnmngr/b|/bPrnjobs/b|/bPrndrvr/b|/bPrncnfg/b|/bPrint/b" & _
"|/bPopd/b|/bPing/b|/bPerfmon/b|/bPentnt/b|/bPbadmin/b|/bPause/b" & _
"|/bPathping/b|/bPath/b|/bPagefileconfig/b|/bOpenfiles/b|/bNtsd/b" & _
"|/bNtcmdprompt/b|/bNtbackup/b|/bNslookup/b|/bNetstat/b|/bNetsh/b" & _
"|/bNet/b|/bNbtstat/b|/bMsinfo32/b|/bMsiexec/b|/bMove/b" & _
"|/bMountvol/b|/bMore/b|/bMode/b|/bMmc/b|/bMd/b|/bMkdir/b" & _
"|/bMacfile/b|/bLpr/b|/bLpq/b|/bLogman/b|/bLodctr/b|/bLabel/b" & _
"|/bIrftp/b|/bIpxroute/b|/bIpseccmd/b|/bIpconfig/b|/bIf/b" & _
"|/bHostname/b|/bHelpctr/b|/bHelp/b|/bGraftabl/b|/bGpupdate/b" & _
"|/bGpresult/b|/bGoto/b|/bGetmac/b|/bFtype/b|/bFtp/b|/bFsutil/b" & _
"|/bFormat/b|/bFor/b|/bFlattemp/b|/bFinger/b|/bFindstr/b|/bFind/b" & _
"|/bFc/b|/bExpand/b|/bExit/b|/bEvntcmd/b|/bEventtriggers/b" & _
"|/bEventquery/b|/bEventcreate/b|/bEndlocal/b|/bEcho/b" & _
"|/bDriverquery/b|/bDoskey/b|/bDiskPart/b|/bDiskcopy/b" & _
"|/bDiskcomp/b|/bDir/b|/bDel/b|/bDefrag/b|/bDate/b|/bCScript/b" & _
"|/bCprofile/b|/bCopy/b|/bConvert/b|/bCompact/b|/bComp/b" & _
"|/bCmstp/b|/bCmd/b|/bCls/b|/bCipher/b|/bChkntfs/b|/bChkdsk/b" & _
"|/bChdir/b|/bChcp/b|/bChange/b|/bCall/b|/bCacls/b|/bBreak/b" & _
"|/bBootcfg/b|/bAttrib/b|/bAtmadm/b|/bAt/b|/bAssoc/b|/bArp/b)"
sText=re.Replace(sText,"<font color=blue>$1</font>")
sText = "<table><td width=""1024"" " & _
"style=""word-break:break-all""><ol type=1>" & _
"<br /><li>" & sText & "<tr></table>"
sText = Replace(sText,chr(13) & chr (10) ," </li><li> ")
ChangeCMD = sText
end Function
'*******************************************************************'
'帮助窗口
'*******************************************************************'
set oPopup = window.createPopup
sub HelpWindow
if usehelp.checked then
set oPopBody = oPopup.document.body
oPopBody.style.backgroundColor = "lightyellow"
oPopBody.style.border = "solid black 1px"
oPopBody.innerHTML = "帮助功能未完成,取消帮助见右下角"
oPopup.show WinMain.offsetleft, _
WinMain.offsettop + WinMain.offsetheight - 20, _
WinMain.offsetWidth, 20, document.body
end if
end sub
'*******************************************************************'
'运行代码
'*******************************************************************'
Sub RunCode
if cxs.value = "vbs" then
tmpfile = "temp_script.vbs"
str = tmpfile
else
tmpfile = "temp_script.bat"
str = "cmd /k " & tmpfile
end if
Set file = fso.OpenTextFile(tmpdir & tmpfile,2,True)
file.Write WinMain.innerText
file.Close
shell.Run str
End Sub
'*******************************************************************'
'保存文件
'*******************************************************************'
Sub SaveFile
Set objDialog = CreateObject("SAFRCFileDlg.FileSave")
objDialog.FileName = Cstr(date)
if cxs.value = "vbs" then
objDialog.FileType = ".vbs"
else
objDialog.FileType = ".bat"
end if
intReturn = objDialog.OpenFileSaveDlg
If intReturn Then
Set objFile = fso.CreateTextFile( _
objDialog.FileName & objDialog.FileType)
objFile.WriteLine WinMain.innerText
objFile.Close
end if
end Sub
'*******************************************************************'
'打开文件
'*******************************************************************'
Sub OpenFile
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "bat文件|*.bat;*.cmd|vbs 文件|*.vbs|所有文件|*.*"
'objDialog.MaxFileSize = 10000
'objDialog.FilterIndex = 1
'objDialog.InitialDir = ""
objDialog.ShowOpen
'strLoadFile = objDialog.FileName
If len(trim(objDialog.FileName)) = 0 Then Exit Sub
Set objFile = fso.OpenTextFile(objDialog.FileName,1,True)
WinMain.innerText = objFile.ReadAll
end Sub
'*******************************************************************'
'启动时自动移动到屏幕中心
'*******************************************************************'
Sub Window_OnLoad()
self.ResizeTo 1,1
self.MoveTo 300,300
'显示一个窗口
Set objWindow = window.Open("about:blank","ProgressWindow","height=15,width=250,left=300,top=300,status=no,titlebar=no,toolbar=no,menubar=no,location=no,scrollbars=no")
With objWindow
.Focus()
.ResizeTo 250,15
.document.body.style.fontFamily = "Helvetica"
.document.body.style.fontSize = "11pt"
.document.writeln "<html><body>正在搜索本地文件....</body></html>"
.document.title = "请稍侯..."
.document.body.style.backgroundColor = "buttonface"
.document.body.style.borderStyle = "none"
.document.body.style.marginTop = 15
end With
'如果系统并非XP，IE不为6.0版本则退出
strWindowsVer = shell.RegRead _
("HKLM/SOFTWARE/Microsoft/Windows NT/CurrentVersion/ProductName")
strIeVer = shell.RegRead _
("HKLM/SOFTWARE/Microsoft/Internet Explorer/Version")
if strWindowsVer <> "Microsoft Windows XP" or _
left(strIeVer,3) <> "6.0" then
intFlag = msgbox("操作系统不是XP或者IE版本低于6.0，是否退出?",1)
if intFlag = 1 then
self.close
else
Began
end if
else
Began
end if
objWindow.Close
End Sub
Sub Began
OptionAdd "bat"
intLeft = (document.parentwindow.screen.availwidth - 800) / 2
intTop = (document.parentwindow.screen.availheight - 600) / 2
window.resizeTo 800,650
window.moveTo intLeft, intTop
end Sub
'*******************************************************************'
'搜索本地脚本
'*******************************************************************'
Sub TestSub
Set objFile = fso.OpenTextFile(objOption.value,1,True)
WinMain.innerText = objFile.ReadAll
end Sub
'*******************************************************************'
'擦屁股
'*******************************************************************'
Sub Window_OnBeforeUnload()
On Error Resume Next
fso.DeleteFile "temp_script.vbs",True
fso.DeleteFile "temp_script.bat",True
Set shell = Nothing
Set fso = Nothing
set oPopup= Nothing
End Sub
'*******************************************************************'
'清空代码
'*******************************************************************'
Sub Clear
WinMain.innerText = ""
'WinMain.innerHTML = ""
end Sub
'*******************************************************************'
'复制到剪贴板
'*******************************************************************'
Sub ClipBoard
window.clipboardData.SetData "text", WinMain.innerHTML
end Sub
</SCRIPT>
</HEAD>
<body>
<style type="text/css">
* { padding:0; border:0; overflow:hidden; font:16px Arial;}
html,body { height:100%; margin:0;}
#box_2 { height:100%; background:#ccc;}
</style>
<center>
<div style="font-family: Trebuchet MS; font-weight:bold;">
<span style="font-size: 18pt;">代码编辑器</span>
<span style="font-size: 8pt;">Ver 1.0 by
<a href="http://www.cn-dos.net/forum/forumdisplay.php?fid=23">
3742668</a> <a href="mailto:3742668@gmail.com">
我的信箱</a></span><br></div></center><br> <div contentEditable
STYLE="padding:2; overflow:auto;background-color:lightyellow;
width:100%; height:70%;" ID="WinMain" onkeyup="HelpWindow">
</div> <BR> <center>
<INPUT STYLE="font-family: Trebuchet MS; font-size: 8pt; font-weight:
bold; border: 1px solid black;" TYPE="BUTTON" VALUE="打开文件(x)"
accesskey="x" ONCLICK="OpenFile">
<INPUT STYLE="font-family: Trebuchet MS; font-size: 8pt; font-weight:
bold; border: 1px solid black;" TYPE="BUTTON" VALUE="运行代码(r)"
accesskey="r" ONCLICK="RunCode">
<INPUT STYLE="font-family: Trebuchet MS; font-size: 8pt; font-weight:
bold; border: 1px solid black;" TYPE="BUTTON" VALUE="清空代码(c)"
accesskey="c" ONCLICK="Clear">
<INPUT STYLE="font-family: Trebuchet MS; font-size: 8pt; font-weight:
bold; border: 1px solid black;" TYPE="BUTTON" VALUE="保存文件(s)"
accesskey="s" ONCLICK="SaveFile">
<INPUT STYLE="font-family: Trebuchet MS; font-size: 8pt; font-weight:
bold; border: 1px solid black;" TYPE="BUTTON" VALUE="复制着色代码(a)"
accesskey="a" ONCLICK="ClipBoard">
<INPUT STYLE="font-family: Trebuchet MS; font-size: 8pt; font-weight:
bold; border: 1px solid black;" TYPE="BUTTON" VALUE="着色显示(d)"
accesskey="d" ONCLICK="ChangeColor"></center>
<br><div id="forOption"></div><p>
<INPUT TYPE="CHECKBOX" ID="usehelp" onfocus="WinMain.focus"
accesskey="z" class="noBorder" position: checked>
<label for="usehelp">使用帮助(<u>z</u>)</label>
<label>脚本类型:<label>
<SELECT NAME="cxs" SIZE="1" onchange="OptionAdd(cxs.value)">
<OPTION VALUE="vbs">
VBS脚本</OPTION><OPTION VALUE="bat" SELECTED>BAT脚本</OPTION><br>
</body>
</HTML>
