winXP下用VBS写的代码编辑器
2008年11月30日
这几天不能访问的时候把硬盘上的东东复习了一遍，找出了这个东西出来，由于水平有限，而且对DHTML没有什么研究，所以做得很是粗糙，贴上来是为了抛砖引玉，希望有高人能帮忙修改或拿出更优秀的东东出来。 测试环境为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}!.rootcimv2")
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 = "('.*)rn"
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="(bAndb|bByRefb|bByValb|bCallb" & _
"|bCaseb|bClassb|bConstb|bDimb|bDob" & _
"|bEachb|bElseb|bElseIfb|bEmptyb|bEndb" & _
"|bEqvb|bEraseb|bErrorb|bExitb|bExplicitb" & _
"|bFalseb|bForb|bFunctionb|bGetb|bIfb|bImpb" & _
"|bInb|bIsb|bLetb|bLoopb|bModb|bNextb|bNotb" & _
"|bNothingb|bNullb|bOnb|bOptionb|bOrb|bPrivateb" & _
"|bPropertyb|bPublicb|bRandomizeb|bReDimb|bRemb" & _
"|bResumeb|bSelectb|bSetb|bStepb|bSubb|bThenb" & _
"|bTob|bTrueb|bUntilb|bWendb|bWhileb|bXorb|Vb[a-z]*)"
sText=re.Replace(sText,"<font color=blue>$1</font>")
'转换函数和对象为[红色]
re.Pattern="(bAnchorb|bArrayb|bAscb|bAtnb" & _
"|bCBoolb|bCByteb|bCCurb|bCDateb|bCDblb" & _
"|bChrb|bCIntb|bCLngb|bCosb|bCreateObjectb" & _
"|bCSngb|bCStrb|bDateb|bDateAddb|bDateDiffb" & _
"|bDatePartb|bDateSerialb|bDateValueb|bDayb" & _
"|bDictionaryb|bDocumentb|bElementb|bErrb|bExpb" & _
"|bFileSystemObject b|bFilterb|bFixb|bIntb|bFormb" & _
"|bFormatCurrencyb|bFormatDateTimeb|bFormatNumberb" & _
"|bFormatPercentb|bGetObjectb|bHexb|bHistoryb|bHourb" & _
"|bInputBoxb|bInStrb|bInstrRevb|bIsArrayb|bIsDateb" & _
"|bIsEmptyb|bIsNullb|bIsNumericb|bIsObjectb|bJoinb" & _
"|bLBoundb|bLCaseb|bLeftb|bLenb|bLinkb|bLoadPictureb" & _
"|bLocationb|bLogb|bLTrimb|bRTrimb|bTrimb|bMidb" & _
"|bMinuteb|bMonthb|bMonthNameb|bMsgBoxb|bNavigatorb" & _
"|bNowb|bOctb|bReplaceb|bRightb|bRndb|bRoundb" & _
"|bScriptEngineb|bScriptEngineBuildVersionb" & _
"|bScriptEngineMajorVersionb|bScriptEngineMinorVersionb" & _
"|bSecondb|bSgnb|bSinb|bSpaceb|bSplitb|bSqrb" & _
"|bStrCompb|bStringb|bStrReverseb|bTanb|bTimeb" & _
"|bTextStreamb|bTimeSerialb|bTimeValueb|bTypeNameb" & _
"|bUBoundb|bUCaseb|bVarTypeb|bWeekdayb|bWeekDayNameb" & _
"|bWindowb|bYearb|bWscriptb)"
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 = "(Remb.*rn|bRemb.*)"
sText = re.Replace(sText,"<font color=#20B2AA>$1</font>")
'改变符号的颜色
re.Pattern = "((|)|&|+|-|*|;|""" & ")"
sText = re.Replace(sText,"<font size=5 color=#9932CC>$1</font>")
'改变所有命令的颜色
re.Pattern = "(bShareb|bSetverb|bNlsfuncb|bMemb|bLhb" & _
"|bLoadhighb|bloadfixb|bGraphicsb|bForcedosb" & _
"|bFastopenb|bExe2binb|bEdlinb|bEdlinb|bEditb" & _
"|bDebugb|bDebugb|bAppendb|bSwitchesb|bStacksb" & _
"|bShellb|bNtcmdpromptb|bLastdriveb|bInstallb" & _
"|bFilesb|bFcbsb|bEchoconfigb|bDriveparmb|bDosonlyb" & _
"|bDosb|bDevicehighb|bDeviceb|bCountryb|bBuffersb" & _
"|bXcopyb|bWMICb|bWinnt32b|bWinntb|bW32tmb" & _
"|bVssadminb|bVolb|bVerifyb|bVerb|bUnlodctrb" & _
"|bTypeperfb|bTypeb|bTreeb|bTracertb|bTracerptb" & _
"|bTitleb|bTimeb|bTftpb|bTelnetb|bTcmsetupb" & _
"|bTasklistb|bTaskkillb|bSfcb|bSysteminfob|bSubstb" & _
"|bStartb|bSortb|bShutdownb|bShiftb|bSetlocalb|bSetb" & _
"|bSeceditb|bSchtasksb|bScb|bRunasb|bRsmb|bRshb" & _
"|bRouteb|bRmdirb|bRexecb|bResetb|bReplaceb|bRenameb" & _
"|bRelogb|bRegsvr32b|bRegb|bRecoverb|bRcpb|bRasdialb" & _
"|bQueryb|bPushdb|bPromptb|bPrnqctlb|bPrnportb" & _
"|bPrnmngrb|bPrnjobsb|bPrndrvrb|bPrncnfgb|bPrintb" & _
"|bPopdb|bPingb|bPerfmonb|bPentntb|bPbadminb|bPauseb" & _
"|bPathpingb|bPathb|bPagefileconfigb|bOpenfilesb|bNtsdb" & _
"|bNtcmdpromptb|bNtbackupb|bNslookupb|bNetstatb|bNetshb" & _
"|bNetb|bNbtstatb|bMsinfo32b|bMsiexecb|bMoveb" & _
"|bMountvolb|bMoreb|bModeb|bMmcb|bMdb|bMkdirb" & _
"|bMacfileb|bLprb|bLpqb|bLogmanb|bLodctrb|bLabelb" & _
"|bIrftpb|bIpxrouteb|bIpseccmdb|bIpconfigb|bIfb" & _
"|bHostnameb|bHelpctrb|bHelpb|bGraftablb|bGpupdateb" & _
"|bGpresultb|bGotob|bGetmacb|bFtypeb|bFtpb|bFsutilb" & _
"|bFormatb|bForb|bFlattempb|bFingerb|bFindstrb|bFindb" & _
"|bFcb|bExpandb|bExitb|bEvntcmdb|bEventtriggersb" & _
"|bEventqueryb|bEventcreateb|bEndlocalb|bEchob" & _
"|bDriverqueryb|bDoskeyb|bDiskPartb|bDiskcopyb" & _
"|bDiskcompb|bDirb|bDelb|bDefragb|bDateb|bCScriptb" & _
"|bCprofileb|bCopyb|bConvertb|bCompactb|bCompb" & _
"|bCmstpb|bCmdb|bClsb|bCipherb|bChkntfsb|bChkdskb" & _
"|bChdirb|bChcpb|bChangeb|bCallb|bCaclsb|bBreakb" & _
"|bBootcfgb|bAttribb|bAtmadmb|bAtb|bAssocb|bArpb)"
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 _
("HKLMSOFTWAREMicrosoftWindows NTCurrentVersionProductName")
strIeVer = shell.RegRead _
("HKLMSOFTWAREMicrosoftInternet ExplorerVersion")
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>
代码打包下载
