网站首页  汉语字词  英语词汇  考试资料  写作素材  旧版资料

请输入您要查询的范文：

　

标题 winXP下用VBS写的代码编辑器
范文
    几天不能访问的时候把硬盘上的东东复习了一遍，找出了这个东西出来，由于水平有限，而且对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}!\\.\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>
    <span>代码编辑器</span>
    <span>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" 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> 
随便看

　

在线学习网范文大全提供好词好句、学习总结、工作总结、演讲稿等写作素材及范文模板，是学习及工作的有利工具。

　

Copyright © 2002-2024 cuapp.net All Rights Reserved
更新时间：2025/5/18 6:53:36