Code Editor written with VBS under WinXP _hta

Source: Internet
Author: User
Tags chr save file
These days can not visit the hard disk to review the Dongdong, find out this thing out, because the level is limited, and there is no research on DHTML, so do is very rough, posted up is to stimulate, I hope that there is an expert can help modify or come up with more excellent dongdong out.
The test environment for the Windows XP Professional Edition SP2, temporarily found that code coloring has bugs, although there are solutions, but due to the amount of code (in Notepad to write code is really annoying), temporarily not corrected, but also expected to join in the future automatic completion and other functions.
PS: Using the VBS script +dhtml, the main functionality is done by regular expression +wmic, the code needs to be saved as an HTA type of file, and, of course, it can be changed to a pure VBS script, but that's much less efficient, and the code is more complex.
Copy Code code as follows:

<HTML>
<HEAD>
<title> Code Editor </title>

<script language= "VBSCRIPT" >
'*******************************************************************'
' Script starts
'*******************************************************************'
Set shell=createobject ("Wscript.Shell")
Set fso=createobject ("Scripting.FileSystemObject")

'*******************************************************************'
' Traverse all types of local files
'*******************************************************************'
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> local script file:</label>" & str & "</select>"
foroption.innerhtml = str

End Sub

'*******************************************************************'
' Color conversion
'*******************************************************************'
Sub ChangeColor
If Cxs.value = "vbs" THEN
winmain.innerhtml = Changevbs (Winmain.innertext)
Else ' cmd script
winmain.innerhtml = Changecmd (Winmain.innertext)
End If
End Sub

'*******************************************************************'
' VBS CONVERSION MODULE
'*******************************************************************'
Function Changevbs (stext)

Set re=new REGEXP
Re. IgnoreCase =true
Re. Global=true


' Annotation Conversion
Re. pattern = "(\. *) \ r \ n"
Stext = Re. Replace (stext, "<font color= #339999 >$1</font><p>")

' Convert symbol to [blue]
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 & Chr (a), "</li><li>")

' Convert reserved word to [blue]
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>")
' Convert function and object to [red]
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 conversion module
'*******************************************************************'
Function Changecmd (stext)


Set re=new REGEXP
Re. IgnoreCase =true
Re. Global=true

' Equals conversion
' Stext = Replace (stext, "/", "<font color= #FF0000 >/</font>")
Re. Pattern = "(\%|\=|\/[a-z]*\b|\>|\<|\|)"
Stext = Re. Replace (stext, "<font color= #FF8C00 >$1</font>")

' Annotation Conversion
Re. Pattern = "(rem\b.*\r\n|\brem\b.*)"
Stext = Re. Replace (stext, "<font color= #20B2AA >$1</font>")


' Change the color of the symbol
Re. pattern = "(\ (|\) |\&|\+|\-|\*|\;|\" "&") "
Stext = Re. Replace (stext, "<font size=5 color= #9932CC >$1</font>")

' Change the color of all commands
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 & Chr (a), "</li><li>")
Changecmd = Stext
End Function

'*******************************************************************'
' Help window
'*******************************************************************'
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 = "help feature not complete, cancel help see bottom right corner"
Opopup.show Winmain.offsetleft, _
Winmain.offsettop + winmain.offsetheight-20, _
Winmain.offsetwidth, Document.body.
End If
End Sub

'*******************************************************************'
' Run code
'*******************************************************************'
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

'*******************************************************************'
' Save file
'*******************************************************************'
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

'*******************************************************************'
' Open File
'*******************************************************************'
Sub OpenFile

Set Objdialog = CreateObject ("UserAccounts.CommonDialog")
Objdialog.filter = "BAT file |*.bat;*.cmd|vbs file |*.vbs| all Files |*.*"
' 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

'*******************************************************************'
' Automatically moves to the center of the screen at startup
'*******************************************************************'
Sub Window_onload ()


Self. Resizeto 1,1
Self. MoveTo 300,300

' Show a Window

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 ". Document.title = "Please wait a moment ..."
. Document.body.style.backgroundColor = "ButtonFace"
. Document.body.style.borderStyle = "None"
. Document.body.style.marginTop = 15
End With


' If the system is not Xp,ie version 6.0 then exit
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 ("Os not XP or IE version less than 6.0, exit?", 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
'*******************************************************************'
' Search Local script
'*******************************************************************'
Sub TestSub
Set objfile = fso. OpenTextFile (Objoption.value,1,true)
Winmain.innertext = Objfile.readall
End Sub

'*******************************************************************'
' Wipe your butt.
'*******************************************************************'
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

'*******************************************************************'
' Empty Code
'*******************************************************************'
Sub Clear
Winmain.innertext = ""
' winmain.innerhtml = ' "
End Sub

'*******************************************************************'
' Copy to Clipboard
'*******************************************************************'
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;" > Code Editor </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" >
My mailbox </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= "Open file (x)"
accesskey= "x" onclick= "OpenFile" >

<input style= "Font-family:trebuchet MS; font-size:8pt; Font-weight:
Bold border:1px solid black; " Type= "button" value= "Run code (r)"
Accesskey= "R" onclick= "RunCode" >

<input style= "Font-family:trebuchet MS; font-size:8pt; Font-weight:
Bold border:1px solid black; " Type= "button" value= "Empty Code (c)"
Accesskey= "C" onclick= "clear" >

<input style= "Font-family:trebuchet MS; font-size:8pt; Font-weight:
Bold border:1px solid black; " Type= "button" value= "Save file (s)"
Accesskey= "S" onclick= "SaveFile" >

<input style= "Font-family:trebuchet MS; font-size:8pt; Font-weight:
Bold border:1px solid black; " Type= "button" value= "Copy coloring Code (a)"
Accesskey= "A" onclick= "ClipBoard" >

<input style= "Font-family:trebuchet MS; font-size:8pt; Font-weight:
Bold border:1px solid black; " type= button "value=" shaded display (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" > Use Help (<u>z</u>) </label>
<label> Script Type:<label>
<select name= "Cxs" size= "1" onchange= "Optionadd (cxs.value)" >
<option value= "vbs" >
VBS script </option><option value= "bat" Selected>bat script </OPTION><br>

</body>
</HTML>

Code package download

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.