麻豆小视频在线观看_中文黄色一级片_久久久成人精品_成片免费观看视频大全_午夜精品久久久久久久99热浪潮_成人一区二区三区四区

首頁 > 編程 > HTA > 正文

winXP下用VBS寫的代碼編輯器

2020-01-31 15:42:20
字體:
來源:轉載
供稿:網友
這幾天不能訪問的時候把硬盤上的東東復習了一遍,找出了這個東西出來,由于水平有限,而且對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 style="font-family: Trebuchet MS; font-weight:bold;">
<span style="font-size: 18pt;">代碼編輯器</span>
<span style="font-size: 8pt;">Ver 1.0 by
<a >
3742668</a>   <a href="mailto:[email protected]">
我的信箱</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> 
 

代碼打包下載
發表評論 共有條評論
用戶名: 密碼:
驗證碼: 匿名發表
主站蜘蛛池模板: 成人在线视频播放 | 欧美成人三级视频 | 精品国产一区二区三区在线观看 | 一边吃奶一边摸下娇喘 | 性生活视频一级 | www久久国产 | 成人福利在线播放 | 国产精品18久久久久久久久 | 91精品国产免费久久 | 亚洲精品久久久久www | 日韩美女电影 | 免费观看一级黄色片 | 中文在线国产 | 91午夜理伦私人影院 | 久久蜜臀一区二区三区av | 精品亚洲综合 | 性少妇freeseⅹbbwhd | 亚洲第一成网站 | 毛片中文字幕 | 久久亚洲线观看视频 | 综合国产在线 | 日本黄色免费观看视频 | 激情小说激情电影 | 91看片在线播放 | 香蕉视频1024 | 91久久国产 | 91久久综合 | 国产精品9191| 91精品欧美一区二区三区 | 久久精品一区视频 | 欧美成人理论片乱 | 久久精品a一级国产免视看成人 | 欧美成人精品一区 | 全黄裸片武则天艳史 | 最新91在线视频 | 日本特级a一片免费观看 | 中文字幕欧美一区二区三区 | 爱逼av| 国产一级免费在线视频 | 九色在线78m| 国产一国产精品一级毛片 |