XP下用VBS写的代码编辑器 - 中国DOS联盟论坛

终于能访问论坛，这几天不能访问的时候把硬盘上的东东复习了一遍，找出了这个东西出来，由于水平有限，而且对DHTML没有什么研究，所以做得很是粗糙，贴上来是为了抛砖引玉，希望有高人能帮忙修改或拿出更优秀的东东出来。
测试环境为windows XP 专业版 SP2，暂时发现代码着色方面有Bug，虽然已有解决方法，不过由于代码量的原因(用记事本写代码真的很恼火)，暂时未纠正，另外预计将来加入自动完成等功能。
ps:利用VBS脚本+DHTML，主要功能由正则表达式+wmic来完成，代码需保存为HTA类型的文件，当然也可以更改为纯粹的VBS脚本，不过那样效率低多了，而且代码更复杂。


<HTML>
<HEAD>
<title>代码编辑器--------中国DOS联盟脚本版专用</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*)" 
    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 = "(\%|\=|\/*\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 = 1 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>&nbsp;&nbsp;&nbsp;<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>&nbsp;&nbsp;
     &nbsp;&nbsp;&nbsp;<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>

[ Last edited by 3742668 on 2006-5-23 at 13:04 ]

第1楼　3742668	发表于 2006-05-22 18:33
荣誉版主　发帖 718　积分 2,013
[原创]XP下用VBS写的代码编辑器终于能访问论坛，这几天不能访问的时候把硬盘上的东东复习了一遍，找出了这个东西出来，由于水平有限，而且对DHTML没有什么研究，所以做得很是粗糙，贴上来是为了抛砖引玉，希望有高人能帮忙修改或拿出更优秀的东东出来。测试环境为windows XP 专业版 SP2，暂时发现代码着色方面有Bug，虽然已有解决方法，不过由于代码量的原因(用记事本写代码真的很恼火)，暂时未纠正，另外预计将来加入自动完成等功能。 ps:利用VBS脚本+DHTML，主要功能由正则表达式+wmic来完成，代码需保存为HTA类型的文件，当然也可以更改为纯粹的VBS脚本，不过那样效率低多了，而且代码更复杂。 <HTML> <HEAD> <title>代码编辑器--------中国DOS联盟脚本版专用</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)" 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 = "(\%\|\=\|\/\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 = 1 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> [ Last edited by 3742668 on 2006-5-23 at 13:04 ] 附件代码编辑器.rar (5.1 KiB)

第2楼　3742668	发表于 2006-05-22 18:37
荣誉版主　发帖 718　积分 2,013
本来有个修正版的，由于试验怎么把自己的XP搞挂掉，结果真的挂了，保存在桌面的修正版也没了。还是ps一句: 写代码还是不要用记事本，尽量还是去用editplus或uedit，自己加个语法着色就行了。

第3楼　doscc	发表于 2006-05-22 18:49
中级用户　发帖 93　积分 256　来自广东
太深了.好多看不懂

第4楼　electronixtar	发表于 2006-05-22 19:54
铂金会员　发帖 2,672　积分 7,493
楼主真牛人也

第5楼　weilong888	发表于 2006-05-22 21:34
银牌会员　发帖 548　积分 1,270
是牛得利害啊，大脑发达啊。

第6楼　willsort	发表于 2006-05-23 02:04
元老会员　发帖 1,512　积分 4,432
Re 3742668: 加16分，建议标题中加入的标记。至于编写批处理脚本，我主要使用EditPlus，在DOS下则主要还是edit。以下是我自定义的EditPlus语法着色文件。因为是来自Win98的版本，所以只是加入一些DOS和98下常用的关键字。 #TITLE=Batch ; Batch syntax file written by Will Sort. ; This file is required for EditPlus to run correctly. #DELIMITER=,(){}-+%/="'~!&\|<>?:;. #QUOTATION1=' #QUOTATION2=" #CONTINUE_QUOTE=n #LINECOMMENT=:: #LINECOMMENT2=rem #PREFIX4=: #SPECIAL_STX=bat #KEYWORD=Special commands do echo exist for goto if in pause rem #KEYWORD=Internal commands cd cls copy ctty del dir md rd #KEYWORD=External commands choice comp deltree fc format mode more move sort xcopy # [ Last edited by willsort on 2006-5-23 at 02:07* ]

第7楼　3742668	发表于 2006-05-23 13:01
荣誉版主　发帖 718　积分 2,013
更正: 在 "保存文件" 的模块中，有一句 if cxs.value = 1 then 在这里应该是if cxs.value = "vbs" then 另外下面的 objFile.WriteLine WinMain.innerText这句改为调用objFile.Wite方法更形象。真对不起大家，贴了个中间产品上来，主要功能也少了两部分，什么时候有空我会把最终版搞出来，关于代码着色方面还请美感比较好的朋友提供一下配色方案，在这个方面本人实在是TCL。 willsort: 谢谢提醒，当然更谢的是加分。如果你和无奈何能一起加进来完成的话我相信能把这个东东做好，对于你们在批處理室管理日志中表现出来的规范严谨，小弟是非常敬佩的。

第8楼　electronixtar	发表于 2006-05-23 15:12
铂金会员　发帖 2,672　积分 7,493
晕～～～18行1语法错误～～～ P.S.：编辑脚本我一般用PrimalScript，支持vbs js bat cmd asp asp.net…………可以把vbs编译成exe……还有好多好多功能

第9楼　3742668	发表于 2006-05-25 23:24
荣誉版主　发帖 718　积分 2,013
回楼上的: 谢谢指出毛病。关于出现这种错误，初步判断为WMI方面出了问题，似乎脚本退出的时候WINDOWS并未释放部分内存。而且根据我的经验，第一次使用WMI的查询后，它就会把数据集/索引一直驻留在内存中，使得再次查询的时候速度会很快。(以上均为个人意见，并不保证完全正确。)不过在我的电脑上还没有出现过错误，猜想是否因为数据集未断开的缘故。由于是中间产品，且是随兴写上一两个功能，所以错误再所难免，因此还是希望大家不吝赐教。 [ Last edited by 3742668 on 2006-5-25 at 23:35 ]

第10楼　wwerttt	发表于 2006-05-28 20:48
新手上路　发帖 1　积分 2
牛人

第11楼　3742668	发表于 2006-05-31 21:31
荣誉版主　发帖 718　积分 2,013
最近发现用vbsedit写vbs脚本还过得去，今天就贴一个上来。可惜下不到microsoft的那个编辑器，等俺有机会用正版了俺就去下一个。嗯，顺便顶一下自己。。。附件 vbsedt33.rar (316.83 KiB)

第12楼　hncscb	发表于 2006-06-07 12:52
新手上路　发帖 2　积分 4
真是牛人，学习

第13楼　heixingstudio	发表于 2006-06-17 18:01
新手上路　发帖 4　积分 7
好东西

第14楼　pangu	发表于 2006-06-18 07:48
新手上路　发帖 1　积分 2　来自 beijing
真是牛人，学习谢了!

第15楼　zzqw	发表于 2006-07-01 14:31
新手上路　发帖 3　积分 6
好好好好好好好好好好好好好好好好好好好好好好好好好好好好好好好好好好　好好好好好好好好好好　好好好　　好好好好好好好好好好好　　　　好好好好好好好　好好好好　好好好好好好好好好好　　　好好好好好好好好好　好好好好　　好好好好好好好好　　好好好好好好好好好好好好　好　　　好好　好好好好　　好　好好好好好好好好好好　　好好好　好好　　　好好好好好好　好好好好好好好好好　　　好好好　　　好好好好好好好好　　　好好好好好好好好好好　好　　好　好好好好好好好好好好好好　好好好好好好好好好　　好　　好　　　好好好好　　　好　　好好好好好好好好好　好好好好　　好好好好好　好好　　　好好好好好好好好　　　好　　　好　好好好好好好好好好　　好好好好好好好好　好　　好好　好　好好好好好好好好　　　　好好好好好好　好好　好好好好好　好好好好好好好　　好好　　　好好好好　好　　好好　好好　好好好好好　　　好好好好　　　　好好好好好　好好好　　　好好好好好好好好好好好好好好好好好好好好好好好好好好好好好好好好