Xpounded Component for Shell work

This WSC component is a nice wrapper for several shell calls, and more.
The main purpose of this snippit is to encode script so it can be called at will by any COM aware language (including VBS and JavaScript).

Don't forget to register the component before using it: - Right-click on the wsc file and select register.
This same code can be found on this site in VBS, JavaScript, and as a WSC Comnponent.

(Refresh this page if you can't see the copyright at the bottom. It means the page did not load properly)

Use VBS: Dim shl
Set shl = createObject("rstools1.shellplus")

Use JavaScript: var shl = new ActiveXObject("rstools1.shellplus")

Save this file as rstools1.wsc Use it freely

Select All

<?xml version="1.0"?>
<component>
<registration
	description="rstools1"
	progid="rstools1.shellplus"
	version="1.00"
	classid="{120f0205-1214-140c-0001-13100f0f0e13}"
>
</registration>
<public>
	<method name="desktop" />
	<method name="forAllFolders"> 
		<PARAMETER name="sPath" />
		<PARAMETER name="sFunc" />
	</method>
	<method name="forAllFiles"> 
		<PARAMETER name="sPath" />
		<PARAMETER name="sFunc" />
	</method>
	<method name="readFile"> 
		<PARAMETER name="sPath" />
	</method>
	<method name="saveFile"> 
		<PARAMETER name="sPath" />
		<PARAMETER name="sContent" />
	</method>
	<method name="folderDialog"> 
		<PARAMETER name="sCaption" />
		<PARAMETER name="sInitPath" />
	</method>
	<method name="openDialog"> 
		<PARAMETER name="sPath" />
		<PARAMETER name="sFilter" />
	</method>
	<method name="saveDialog"> 
		<PARAMETER name="sPath" />
		<PARAMETER name="sFilter" />
	</method>
	<method name="replaceText"> 
		<PARAMETER name="sOrigStr" />
		<PARAMETER name="sPatrn" />
		<PARAMETER name="sReplStr" />
	</method>
	<method name="replaceAll"> 
		<PARAMETER name="sOrigStr" />
		<PARAMETER name="sPatrn" />
		<PARAMETER name="sReplStr" />
	</method>
	<method name="include"> 
		<PARAMETER name="sVbsFilePath" />
	</method>
	<method name="getName"> 
		<PARAMETER name="sPath" />
	</method>
	<method name="getFile"> 
		<PARAMETER name="sPath" />
	</method>
	<method name="getPath"> 
		<PARAMETER name="sPath" />
	</method>
	<method name="popup"> 
		<PARAMETER name="sMsg" />
		<PARAMETER name="iTime" />
		<PARAMETER name="sTitle" />
		<PARAMETER name="iMsgType" />
	</method>
	<method name="fileExists"> 
		<PARAMETER name="sFilePath" />
	</method>
	<method name="folderExists"> 
		<PARAMETER name="sFolderPath" />
	</method>
	<method name="validateXML"> 
		<PARAMETER name="sDoc" />
	</method>
	<method name="help" dispid="0"> 
		<PARAMETER name="sString" />
	</method>
	<method name="transformXML"> 
		<PARAMETER name="sString" />
	</method>
	<method name="run"> 
		<PARAMETER name="sApplication" />
	</method>
	<method name="runWithArg"> 
		<PARAMETER name="sApplication" />
		<PARAMETER name="sArgument" />
	</method>
	<method name="countMatches"> 
		<PARAMETER name="sPatrn" />
		<PARAMETER name="sStr" />
	</method>
	<method name="makePath"> 
		<PARAMETER name="sPath" />
	</method>
	<method name="copyFile"> 
		<PARAMETER name="sFilePath" />
		<PARAMETER name="sNewPath" />
	</method>
	<method name="makeFolder"> 
		<PARAMETER name="sPath" />
	</method>
	<method name="deleteFile"> 
		<PARAMETER name="sFilePath" />
	</method>
	<method name="deleteFolder"> 
		<PARAMETER name="sFolderPath" />
	</method>
	<method name="moveFile"> 
		<PARAMETER name="sFilePath" />
		<PARAMETER name="sNewPath" />
	</method>
	<method name="moveFolder"> 
		<PARAMETER name="sFolderPath" />
		<PARAMETER name="sNewPath" />
	</method>
	<method name="signScript"> 
		<PARAMETER name="sFilePath" />
		<PARAMETER name="sSigniture" />
	</method>
	<method name="regRead"> 
		<PARAMETER name="sKey" />
	</method>
	<method name="regWrite"> 
		<PARAMETER name="sKey" />
		<PARAMETER name="sValue" />
	</method>
</public>
<script language="VBScript">
<![CDATA[
	Dim fso
	Set fso = createObject("Scripting.FileSystemObject")
	Function desktop()
		'Enviornment variable returned is path to desktop
		Dim m_desktop, WshShell
		set WshShell = createObject("WScript.Shell")
		m_desktop = WshShell.SpecialFolders("Desktop")
		set WshShell = Nothing
		desktop = m_desktop
	End Function
	Sub forAllFolders(sPath,sFunc)
		'Recurses through all sub-folders apllying func
		Dim s, folder, f, sRet, folder2, folders
		Set folder = fso.GetFolder(sPath)
		For Each f In folder.Files
			s = sFunc & " f"
			execute s
		Next
		Set folders = folder.SubFolders
		For Each folder2 in folders
		Call forAllFolders(folder2,sFunc)
		Next
	End Sub
	Sub forAllFiles(sPath,sFunc)
		'Recurses through all files in folder apllying func
		Dim folder, f, sRet
		Set folder = fso.GetFolder(sPath)
		For Each f In folder.Files
			s = sFunc & " f"
			execute s
		Next
	End Sub
	Function readFile(sPath)
		'returns string content of file
		Dim f
		Set f = fso.OpenTextFile(sPath, 1)
		readFile = f.ReadAll
		f.Close
		Set f = Nothing
	End Function
	Sub saveFile(sPath,sContent)
		'saves file to disk - overwrites existing file
		Dim result
		Set result = fso.createTextFile(sPath,True) 'True=overwrite
		result.Write sContent
		result.Close
		Set result = Nothing
	End Sub
	Function folderDialog(sCaption,sInitPath)
		'opens a folder dialog
		'returns user selection, if any
		dim oShell
		dim oFolder
		dim oFolderItem
		dim return
		set oShell = CreateObject("Shell.Application")
		set oFolder = oShell.BrowseForFolder(0, sCaption, 0 ,sInitPath)
		On Error Resume Next
		set oFolderItem = oFolder.Items.Item
		If Err.Number > 0 Then
			return = ""
		Else
			return = oFolderItem.Path
			set oFolderItem = Nothing
		End If
		set oFolder = Nothing
		set oShell = Nothing
		On Error Goto 0
		folderDialog = return
	End Function
	Function openDialog(sPath,sFilter)
		'opens an open file dialog
		'returns user selection if any
		Dim oCDlg, sFile
		Const OFN_EXPLORER = &H80000
		Const OFN_LONGNAMES = &H200000
		Set oCDlg = CreateObject("MSComDlg.CommonDialog")
		sFile = String(260, Chr(0))
		With oCDlg
			.Flags = OFN_EXPLORER Or OFN_LONGNAMES
			.MaxFileSize = 260
			.InitDir = sPath
			If sFilter <> "" Then
				.Filter = sFilter
			Else
				.Filter = "All Files (*.*)|*.*"
			End If
			.ShowOpen
			sFile = .FileName
			If sFile <>"" Then
				sReturn = sFile
			End If
		End With
		Set oCDlg = nothing
		openDialog = sReturn
	End Function
	Function saveDialog(sPath,sFilter)
		'opens a save file dialog
		'returns user selection if any
		Dim oCDlg
		Dim sFile
		Const OFN_HIDEREADONLY = &H4
		Const OFN_CREATEPROMPT = &H2000
		Const OFN_EXPLORER = &H80000
		Const OFN_LONGNAMES = &H200000
		Set oCDlg = CreateObject("MSComDlg.CommonDialog")
		sFile = String(260, Chr(0))
		With oCDlg
			.Flags = OFN_EXPLORER Or OFN_LONGNAMES Or OFN_CREATEPROMPT Or OFN_HIDEREADONLY
			.MaxFileSize = 260
			.InitDir = sPath
			.DefaultExt = "txt"
			If sFilter <> "" Then
				.Filter = sFilter
			Else
				.Filter = "All Files (*.*)|*.*"
			End If
			.FileName = "defaultfile.txt"
			.ShowSave
			sFile = .FileName
			If sFile <>"" Then
				sReturn = sFile
			End If
		End With
		Set oCDlg = nothing
		saveDialog = sReturn
	End Function
	Function replaceText(sOrigStr, sPatrn, sReplStr)
		'replaces first occurance of sPatrn with sReplStr
		Dim regEx		Set regEx = New RegExp
		regEx.Pattern = sPatrn
		regEx.IgnoreCase = True
		ReplaceText = regEx.Replace(sOrigStr, sReplStr)
	End Function
	Function replaceAll(sOrigStr, sPatrn, sRplStr)
		'replaces all occurances of sPatrn with sReplStr
		lmatches = PatternMatchCount(sPatrn, sOrigStr)
		for i = 0 to lmatches
			sOrigStr = ReplaceText(sOrigStr, sPatrn, sRplStr)
		next
		ReplaceAll = sOrigStr
	End Function
	Function include(sVbsFilePath)
		'includes the script in sVbsFilePath in the current session
		Dim sVbsCode, fle
		Set fle = fso.OpenTextFile(sVbsFilePath)
		sVbsCode = fle.ReadAll()
		fle.Close 
		ExecuteGlobal sVbsCode
	End Function
	Function getName(sPath)
		'return only the name of a file
		Dim g1, g2
		g1 = InStrRev(sPath,"\")
		If g1 > 0 Then
			sPath = Right(sPath,Len(sPath)-g1)
		End IF
		g2 = InStrRev(sPath,".")
		If g2 > 0 Then
			sPath = Left(sPath,g2-1)
		End If
		getName = sPath
	End Function
	Function getFile(sPath)
		'return only the name and extension of a file
		Dim g1
		g1 = InStrRev(sPath,"\")
		If g1 > 0 Then
			sPath = Right(sPath,Len(sPath)-g1)
		End IF
		getFile = sPath
	End Function
	Function getPath(sPath)
		'return only the path of a file
		Dim g1
		g1 = InStrRev(sPath,"\")
		If g1 > 0 Then
			sPath = Left(sPath,g1)
		End If
		getPath = sPath
	End Function
	Function popup(sMsg,iTime,sTitle,iMsgType)
		'create a popup mesaage box
		Dim wShell,Return
		Set wShell = createObject("WScript.Shell")
		If iMsgType="" Then
			iMsgType= vbOkOnly
		End If
		If sTitle = "" Then
			sTitle = "Message"
		End If
		If iTime = "" Then
			iTime = 3
		End If
		If sMsg = "" Then
			sMsg = "Please Wait"
		End If
		Return = wShell.popup(sMsg,iTime,sTitle,iMsgType)
		Set wShell = Nothing
		popup = Return
	End Function
	Function fileExists(sFilePath)
		'return true if the file exists
		Dim bReturn
		bReturn = fso.FileExists(sFilePath)
		fileExists = bReturn
	End Function
	Function folderExists(sFolderPath)
		'return true if the folder exists
		Dim bReturn
		bReturn =  fso.FolderExists(sFolderPath)
		folderExists = bReturn
	End Function
	Function validateXML(sDoc)
		'validates sDoc is well-formed
		'will validate against DTD, Schema if one is declared in sDoc
		'requires MSXML2
		Dim sReturn, x
		Set x = CreateObject("MSXML2.DOMDocument.4.0")
		x.async = 0
		x.resolveExternals = 1
		x.validateOnParse = 1
		If x.load(sDoc) Then
		Else
			If x.parseError.errorCode <> 0 Then
				sReturn = x.parseError.reason & vbcrlf & _
					x.parseError.line & vbcrlf & _
					x.parseError.linepos & vbcrlf & _
					x.parseError.srcText
			End If
		End IF
		Set x = Nothing
		ValidateXML = sReturn
	End Function
	Function transformXML(sXML,sXSL)
		'transform sXML using sXSL
		'requires MSXML2
		Dim xmlDoc, xslDoc
		Set xmlDoc = New MSXML2.DOMDocument40
		Set xslDoc = New MSXML2.DOMDocument40
		xmlDoc.Load sXML
		If xmlDoc.parseError.errorCode = 0 Then
			xslDoc.Load sXSL
			If xslDoc.parseError.reason = "" Then
				return = xmlDoc.transformNode(xslDoc)
			Else
				return = "Error: Stylesheet.xsl did not load. " & _
				xslDoc.parseError.reason
			End If
		Else
			return = "Error: XML did not load. " & _
			xmlDoc.parseError.reason
		End If
		tranlateXML = return
		Set xmlDoc = Nothing
		Set xslDoc = Nothing
	End Function
	Sub run(sApplication)
		'Execute sApplication
		Set runWshShell = CreateObject ("WSCript.shell")
		runWshShell.run sApplication
		Set runWshShell = Nothing
	End Sub
	Sub runWithArg(sApplication, sArgument)
		'Execute sApplication using sArgument
		Dim rws
		Set runWithWshShell = CreateObject ("WSCript.shell")
		rws = sApplication & " " & chr(34) & sArgument & chr(34)
		runWithWshShell.run rws
		Set runWithWshShell = Nothing
	End Sub
	Function countMatches(sPatrn, sStr)
		'return the number of occurences of sPatrn in sStr
		Dim regEx, Match, Matches
		Set regEx = New RegExp
		regEx.Pattern = sPatrn
		regEx.IgnoreCase = True
		regEx.Global = True
		Set Matches = regEx.Execute(sStr)
		RetVal = Matches.count
		CountMatches = RetVal
	End Function
	Function makePath(sPath)
		'return sPath with backslash ending
		If Right(sPath,1) <> "\" Then
			sPath = sPath & "\"
		End If
		makePath = sPath
	End Function
	Sub copyFile(sFilePath,sNewPath)
		'copy file from sFilePath to sNewPath
		Const OverwriteExisting = True
		fso.CopyFile sFile , sNewPath, OverwriteExisting
	End Sub
	Function makeFolder(sPath)
		'create the folder sPath
		Dim objFolder
		Set objFolder = fSO.CreateFolder(sPath)
		makeFolder = objFolder
	End Function
	Sub deleteFile(sFilePath)
		'delete the file sFilePath
		Const DeleteReadOnly = True
		fSO.DeleteFile(sFilePath), DeleteReadOnly
	End Sub
	Sub deleteFolder(sFolderPath)
		'delete the empty folder sFolderPath
		fSO.DeleteFolder(sFolderPath)
	End Sub
	Sub moveFile(sFilePath,sNewPath)
		'move the file from sFilePath to sNewPath
		fSO.MoveFile sFilePath , sNewPath
	End Sub
	Sub moveFolder(sFolderPath,sNewPath)
		'move the folder from sFolderPath to sNewPath
		fSO.MoveFolder sFolderPath, sNewPath
	End Sub
	Sub signScript(sFilePath, sSigniture)
		'sign the script sFilePath with the signature sSigniture
		Dim objSigner
		Set objSigner = WScript.CreateObject("Scripting.Signer")
		objSigner.SignFile sFilePath, sSigniture
		Set objSigner = Nothing
	End Sub
	Function regRead(sKey)
		'return the value of registry key sKey
		'Allows only subkeys of HKEY_CURRENT_USER
		Dim Shll, sReturn
		Set Shll = CreateObject("WScript.Shell")
		sKey =  "HKEY_CURRENT_USER\" & sKey
		On Error Resume Next
		sReturn = Shll.RegRead(sKey) & vbcrlf
		On Error Goto 0
		Set Shll = Nothing
		RegRead = sReturn
	End Function
	Sub regWrite(sKey, sValue)
		'set the registry key sKey with the value sValue
		'Allows only subkeys of HKEY_CURRENT_USER
		Dim Shll, sReturn
		Set Shll = CreateObject("WScript.Shell")
		sKey =  "HKEY_CURRENT_USER\" & sKey
		On Error Resume Next
		Shll.RegWrite sKey, sValue, "REG_SZ"
		On Error Goto 0
		Set Shll = Nothing
	End Sub
	Function help(sString)
		'return a string showing shellpluss members
		Dim helpString
		If sString = "" Or LCase(sString) = "list" Then
			helpString = "Component Member Listing:" & vbcrlf
			helpString = helpString & "Use help(member) for more information" & vbcrlf
			helpString = helpString & "--------------------" & vbcrlf
			helpString = helpString & "copyFile" & vbcrlf
			helpString = helpString & "countMatches" & vbcrlf
			helpString = helpString & "deleteFile" & vbcrlf
			helpString = helpString & "deleteFolder" & vbcrlf
			helpString = helpString & "desktop" & vbcrlf
			helpString = helpString & "fileExists" & vbcrlf
			helpString = helpString & "folderDialog" & vbcrlf
			helpString = helpString & "folderExists" & vbcrlf
			helpString = helpString & "forAllFiles" & vbcrlf
			helpString = helpString & "forAllFolders" & vbcrlf
			helpString = helpString & "getFile" & vbcrlf
			helpString = helpString & "getName" & vbcrlf
			helpString = helpString & "getPath" & vbcrlf
			helpString = helpString & "include" & vbcrlf
			helpString = helpString & "makeFolder" & vbcrlf
			helpString = helpString & "makePath" & vbcrlf
			helpString = helpString & "moveFile" & vbcrlf
			helpString = helpString & "moveFolder" & vbcrlf
			helpString = helpString & "openDialog" & vbcrlf
			helpString = helpString & "popup" & vbcrlf
			helpString = helpString & "readFile" & vbcrlf
			helpString = helpString & "regRead" & vbcrlf
			helpString = helpString & "regWrite" & vbcrlf
			helpString = helpString & "replaceAll" & vbcrlf
			helpString = helpString & "replaceText" & vbcrlf
			helpString = helpString & "run" & vbcrlf
			helpString = helpString & "runWithArg" & vbcrlf
			helpString = helpString & "saveDialog" & vbcrlf
			helpString = helpString & "saveFile" & vbcrlf
			helpString = helpString & "signScript" & vbcrlf
			helpString = helpString & "transformXML" & vbcrlf
			helpString = helpString & "validateXML" & vbcrlf
			helpString = helpString & "help"
		ElseIf LCase(sString) = "desktop" then
			helpString = "Desktop : Path to the client desktop" & vbcrlf
		ElseIf LCase(sString) = "forallfolders" then
			helpString = "forAllFolders(path,func)" & vbcrlf & "Applies the function func to all folders in path" & vbcrlf
		ElseIf LCase(sString) = "forallfiles" then
			helpString = "forAllFiles(path,func)" & vbcrlf & "Applies the function func to all files in path"
		End If
		'You can fill in the rest if desired, rdspoons
		help = helpString
	End Function
]]>
</script>
</component>

No HTML to View

- Copyright 2003 Xpounded -
All JS code developed by Xpounded is developed in RHSCoder.
All VBS code developed by Xpounded is developed in VBS QuickDev IDE, or RHSCoder.
Privacy Statement
Feedback