Run.vbs Tested in Win98/XP. HTA --- HTA / HTM(L) code with options; Edit Source or Print. You can replace an HTM(L) extension with HTA instead, ;-). New.vbs Template. Tested in Win98. COUNT.(BAT, HTA or VBS) Hexadecimal Counting in the Registry. Description.HTA Take notes about file(s). Any extension such as HTM HTML HTA or VBS, A little synopsis of VBScript, JavaScript and DOS Batch... About colors VBScript
Notes/etc. Links:
<html><head><title>testing</title> <HTA:APPLICATION id= "test" applicationName="testing" singleInstance= "yes" border= "thick" caption= "yes" sysMenu= "yes" windowState= "maximize" showInTaskBar= "yes"> </head><body bgColor="#C0C0C0"> <script language="JavaScript"> function mouseClicks(){ alert("Close the current HTML page, (press Alt+F4).");} function printing() { window.print(); } </script> <script language="VBScript"> if uCase(right(location.pathname, 8)) = ".HTA.HTM" then document.bgColor = "#FFFFFF" msgBox "After the printing has started, then close the curr" _ & "ent HTML page, (press Alt+F4).",64,"Ready to print" printing(): document.onclick = mouseClicks else dim wso: set wso= createObject("wScript.shell") dim fso: set fso= createObject("scripting.fileSystemObject") dim editor: editor= wso.expandEnvironmentStrings("%winDir%") _ & "\Command\Pfe32.exe" if (fso.fileExists(editor)) then editor= editor & " /g"& 32 editor= editor & "/" & 43 else editor= "notepad" end if end if </script> <H3>Testing</H3> <FORM method="get"> <select name="menu" onchange="scriptForMenu(value)" style="background-color:#99CCFF; font-weight:bold;"> <option selected value=""> </option> <option value="Source">Source </option> <option value="Print"> Print </option> </select> <script language="VBScript"> sub scriptForMenu(X) dim f, ext f= location.pathname: ext= uCase(mid(f, inStrRev(f,"."), 4)) select case (X & ext) case "Source.HTA" wso.run editor & " """ & f & """",3,-1 case "Source.HTM" wso.run editor & " """ & mid(f, _ inStr(1, f, ":") -1) & """",3,-1 case "Print.HTA" fso.copyFile f,f & ".htm" wso.run """" & f & ".htm""",3,-1 fso.deleteFile f & ".htm" case "Print.HTM" printing() end select document.location.reload() end sub </script> </FORM> </body></html> ' Template for VBScripting, "C:\WINDOWS\ShellNew\New.VBS". ' [HKEY_CLASSES_ROOT\.VBS\ShellNew] ' "FileName"="New.vbs" dim wso, fso, oSystem, tmpPath, tmpFile set wso= createObject("wScript.shell") set fso= createObject("scripting.fileSystemObject") oSystem= wso.expandEnvironmentStrings("%OS%") & "/XPWindows_98/ME" oSystem= mid(oSystem, inStr(1, oSystem, "W"), 13) tmpPath= wso.expandEnvironmentStrings("%TEMP%") & "*" _ & wso.expandEnvironmentStrings("%TMP%") & "*C:\" tmpPath= Search(tmpPath, "\", "*") & ".\" tmpFile= fso.getAbsolutePathName(tmpPath & "fileName.tmp") msgBox "OS: " & vbTab & oSystem & vbCrLf & "Tmp: " & vbTab & tmpPath _ & vbCrLf & "TmpFile: " & vbTab & tmpFile, 64, "Info ;-)" dim f: set f= fso.openTextFile(tmpFile, 2, true) dim i, fileList: fileList= split(GetFileList(tmpPath, false, 0), "*") for i=1 to uBound(fileList) if msgBox(fileList(i), 65,i & ";"& uBound(fileList))=2 then exit for f.writeLine fileList(i) next f.close: set f= nothing wso.run "notepad """ & tmpFile & """",, -1 fso.deleteFile tmpFile, true set wso= nothing set fso= nothing wScript.quit ' Return first element that contains x: function Search(strng, x, delim) search= delim & strng & delim search= mid(left(search,inStr(inStr(2,search,x),search,delim) -1), _ inStrRev(search,delim,inStr(2,search,x) -1) +1) end function function GetFileList(folderSpec, recurse, list1) dim f for each f in fso.getFolder(folderSpec).files list1= list1 & "*" & f.path next if recurse then for each f in fso.getFolder(folderSpec).subfolders GetFileList f.path, recurse, list1 next end if GetFileList= list1 end function function GetFolderList(folderSpec, recurse, list2) dim f for each f in fso.getFolder(folderSpec).subfolders list2= list2 & "*" & f.path next if recurse then for each f in fso.getFolder(folderSpec).subfolders GetFolderList f.path, recurse, list2 next end if GetFolderList= list2 end function ' Additional syntax to remember: ' =inputBox("msg:", ";-)", default) ' wso.popup "msg.", 9, ";-)", 64 Hex Counter in the Registry. Filename: "COUNT.BAT" or "COUNT.HTA" Note: For extension VBS instead, then delete the three first lines along with the last, (line numb 17). <!-- @ for %%c in (echo:off,copy:%0:%0.HTA,cls,"start %0.HTA",exit) do %%c --><SCRIPT language="VBScript"> dim wso, C0, restoreCounter0_value: restoreCounter0_value= 4 set wso= createObject("wScript.shell") on error resume next: C0= wso.regRead("HKCU\myKeys\Counter0") on error goTo 0 C0= right("0000" & hex(cInt("&h" & (0 & C0)) +1), 4) if restoreCounter0_value <= cInt("&h" & C0) then wso.regDelete"HKCU\myKeys\Counter0" else wso.regWrite "HKCU\myKeys\Counter0", C0 end if wso.popup _ "Counter0:" & vbCrLf & vbCrLf & vbTab & cInt("&h" & ("0" & C0)) &_ " (" & C0 & " hex)." & vbCrLf, 02, "HKEY_CURRENT_USER\myKeys\", 64 set wso= nothing: on error resume next: self.close(): wScript.quit </SCRIPT> Description.HTA (do NOT use the extension HTM or HTML). TIPS: Run "Description.HTA" from within a folder with some DOC or ZIP files. NOTE: If you have installed the very BAD virus namely "Norton's Anti Virus", then the Description.HTA won't work very fine. If so, then you should simply get an Anti-Virus-Software which isn't a virus itself; and you'll be allowed to use your computer for simple batch programming BAT, HTA, WSF, VBS, etc... <html><head><title>Take Note(s).</title><style>td{font-family:verdana, system; font-size:12px; color:#000000; font-weight:bold; }</style> <hta:application applicationName="Description" singleInstance="yes"> <script language="VBScript"> dim default: default= "" '***[Or you can use default= "Downloaded "] dim thisFile: thisFile= replace(location.pathname,"%20"," ") dim fso: set fso= createObject("scripting.fileSystemObject") '____ function GetFileList(spec, recurse, list) dim f for each f in fso.getFolder(spec).files list= list & "*" & f.path next if recurse then for each f in fso.getFolder(spec).subfolders GetFileList f.path, recurse, list next end if GetFileList= split(list,"*") end function '____ sub Upd_(list): dim f, contents, LineNumb, id set f= fso.openTextFile(thisFile, 1) contents= split(vbCrlf & f.readAll, vbCrlf) f.close : set f= fso.openTextFile(thisFile, 2, true) do: LineNumb= LineNumb +1 f.writeLine contents(LineNumb) loop until "<hR>" = contents(LineNumb) if contents(LineNumb +2) = contents(uBound(contents)-1) then f.writeLine"<!-- --><p> <table border=""1"" bgColor=""" &_ "#C0C0C0""><tr><td>Go</td><td>Filename</td><td>Notes</td></tr>" for id=1 to uBound(list) f.writeLine"<tr><td><input type='button' value='" _ & " ' onClick='TakeNote " & id & "'></td>" & vbCrLf _ & "<td>" & fso.getFileName(list(id)) & "</td>" if list(id) = thisFile then f.writeLine"<td>http://2dos.homepage.dk</td></tr>" else f.writeLine"<td></td></tr>" end if next else dim ListWrote LineNumb= LineNumb +1: f.writeLine contents(LineNumb) do until contents(LineNumb+1)=contents(uBound(contents)-1) if fso.fileExists(mid(contents(LineNumb+2), 5, _ len(contents(LineNumb+2))-9)) then id= id +1 f.writeLine left(contents(LineNumb +1), 57) & id _ & "'></td>" & vbCrLf & contents(LineNumb +2) _ & vbCrLf & contents(LineNumb +3) ListWrote= "*" & contents(LineNumb +2) & ListWrote end if LineNumb= LineNumb +3 loop: ListWrote= split(ListWrote, "*") if uBound(list) > uBound(ListWrote) then ' msgBox uBound(list)-uBound(ListWrote)&" new name(s) detected" dim i, j, ListNewNames for i = 1 to uBound(List) for j = 1 to uBound(ListWrote) if uCase(fso.getFileName(list(i))) = _ uCase(mid(replace(ListWrote(j),"</td>",""), 5)) then list(i)= "": exit for end if next if not list(i) = "" then ListNewNames= ListNewNames & "*" & list(i) end if next ListNewNames= split(ListNewNames, "*") for i = 1 to uBound(ListNewNames) id = id +1 f.writeLine "<tr><td><input type='button' value=' ' on" _ & "Click='TakeNote " & id & "'></td>" & vbCrLf _ & "<td>" & fso.getFileName(ListNewNames(i)) & "</td>" _ & vbCrLf & "<td></td></tr>" next end if end if f.writeLine contents(uBound(contents)-1) document.location.reload(): f.close: set f= nothing end sub '____ sub TakeNote(id): dim f, contents, LineNumb, takeNoteInLineNumb, put set f= fso.openTextFile(thisFile, 1) contents= split(vbCrlf & f.readAll, vbCrlf) f.close : set f= fso.openTextFile(thisFile, 2, true) for LineNumb = 1 to uBound(contents) -1 if LineNumb = -takeNoteInLineNumb then if contents(LineNumb) = "<td></td></tr>" then default= default & date & ". " else default= mid(contents(LineNumb), 5, _ len(contents(LineNumb))-14) end if put= inputBox("Description:", "", default,, 0) if typeName(put) = "Empty" then f.writeLine contents(LineNumb) else f.writeLine "<td>" & put & "</td></tr>" end if else f.writeLine contents(LineNumb) if "<hR>" = contents(LineNumb) then takeNoteInLineNumb= -3*id -LineNumb -1 end if end if next: document.location.reload(): f.close: set f= nothing end sub </script></head><body bgColor="#000080"> <input type=button value='Update'onClick='Upd_(GetFileList(".",0,0))'> <hR> <!-- --><table bgColor="yellow"><tr><td>Press button Update.</td></tr> <!-- --></table></head></html> Any extension on "Synopsis.HTM" '<!-- Line num 1 is next line, including the prefixed single quote --> ' 'This file can (without modifying anything) be named with an extension ' of one of the following: HTM HTML HTA VBS ' '<SCRIPT type="text/VBS"> '--------------------------------------------------------------------- ' VBScript ' JavaScript // DOS :: '--------------------------------------------------------------------- dim a: a=12345 ' var a=12345 // a=cStr(a) ' a=String(a) // a=mid(a,1,len(a)-1) ' a=a.slice(0,a.length-1) // set a=1234 msgBox a,, ";-)" ' alert(a) // echo.%a% '--------------------------------------------------------------------- '</SCRIPT><SCRIPT language="JScript">status='Done;-)';close()</SCRIPT> ' ' 'Benny Pedersen, http://2dos.homepage.dk/ 'PS. Tested in Win98(4.10.1998), IE6 SP1. About colors (under construction). ' Make216colors.VBS dim fullySpecFile_W: fullySpecFile_W = "D:\Colors.txt" if vbCancel = _ msgBox("This VBScript would make a file named" & vbCrLf _ & """" & fullySpecFile_W & """." & vbCrLf & vbCrLf _ & "Contents: " & "216 colors (if you don't exclude any data,"_ & " (see inner loop of this code)).", 65, "Ready To Execute")_ then msgBox "Nothing to do. All done.",, ";-)": wScript.quit dim FSO,f, include,exclude, R,G,B, Red,Green,Blue, RGB set FSO=createObject("scripting.fileSystemObject") set f = fso.openTextFile(fullySpecFile_W, 2, true) for R = 0 to 255 step 51 for G = 0 to 255 step 51 for B = 0 to 255 step 51 Red = right("0" & hex(R),2) Green=right("0" & hex(G),2) Blue =right("0" & hex(B),2) RGB = Red & Green & Blue include=true for each exclude in array("000000","FFFFFF") if RGB=exclude then include=false: exit for next if include then f.writeLine "#" & RGB next next next f.close: set f=nothing: set FSO=f createObject("wScript.shell").run"Notepad " & fullySpecFile_W, 1, true 'OR: msgBox "All done.", 1, ";-)"
|