Xpounded VBS Class for Shell

This class is a nice wrapper for several shell calls, and more.
This same code can be found on this site in VBS, JavaScript, and as a WSC.

Use: Dim shl
Set shl = new shellplus

Save this file as shellplus.vbs Use it freely

Select All

Class shellplus
	Private m_fso
	Private m_desktop

Private Property Set fso(sfso)
		Set m_fso = sfso
	End Property

Private Property Get fso()
		fso = m_fso
	End Property

Private Property Let desktop(sdesktop)
		m_desktop = sdesktop
	End Property

Public Property Get desktop()
		desktop = m_desktop
	End Property
	Public Sub forAllFolders(path,func)
		Dim s, folder, f, sRet, folder2, folders
		Set folder = fso.GetFolder(path)
		For Each f In folder.Files
			s = func & " f"
			execute s
		Next
		Set folders = folder.SubFolders
		For Each folder2 in folders
		Call forAllFolders(folder2,func)
		Next
	End Sub
	Public Sub ForAllFiles(path,func)
		Dim folder, f, sRet
		Set folder = fso.GetFolder(path)
		For Each f In folder.Files
			s = func & " f"
			execute s
		Next
	End Sub
	Public Function readFile(path)
		Dim f
		Set f = fso.OpenTextFile(path, 1)
		readFile = f.ReadAll
		f.Close
		Set f = Nothing
	End Function
	Public Sub saveFile(path,sContent)
		Dim result
		Set result = fso.createTextFile(path,True)
		result.Write sContent
		result.Close
		Set result = Nothing
	End Sub
	Public Function folderDialog(sCaption,sInitPath)
		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
	Public Function openDialog(sPath,sFilter)
		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
	Public Function saveDialog(sPath,sFilter)
		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
	Public Function ReplaceText(str,patrn, replStr)
		Dim regEx
		Set regEx = New RegExp
		regEx.Pattern = patrn
		regEx.IgnoreCase = True
		ReplaceText = regEx.Replace(str, replStr)
	End Function
	Public Function ReplaceAll(str,patrn,rplStr)
		lmatches = PatternMatchCount(patrn,str)
		for i = 0 to lmatches
			str = ReplaceText(str,patrn,rplStr)
		next
		ReplaceAll = str
	End Function
	Public Function include(VbsFile)
		Dim sVbsCode, fle
		Set fle = fso.OpenTextFile(VbsFile)
		sVbsCode = fle.ReadAll()
		fle.Close 
		ExecuteGlobal sVbsCode
	End Function
	Public Function getName(sPath)
		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
	Public Function getFile(sPath)
		Dim g1
		g1 = InStrRev(sPath,"\")
		If g1 > 0 Then
			sPath = Right(sPath,Len(sPath)-g1)
		End IF
		getFile = sPath
	End Function
	Public Function getPath(sPath)
		Dim g1
		g1 = InStrRev(sPath,"\")
		If g1 > 0 Then
			sPath = Left(sPath,g1)
		End If
		getPath = sPath
	End Function
	Public Function popup(msg,iTime,sTitle,msgType)
		Dim wShell,Return
		Set wShell = createObject("WScript.Shell")
		If msgType="" Then
			msgType= vbOkOnly
		End If
		If sTitle = "" Then
			sTitle = "Message"
		End If
		If iTime = "" Then
			iTime = 3
		End If
		If msg = "" Then
			msg = "Please Wait"
		End If
		Return = wShell.popup(msg,iTime,sTitle,msgType)
		Set wShell = Nothing
		popup = Return
	End Function
	Public Function fileExists(sFilePath)
		Dim bReturn
		bReturn = fso.FileExists(sFilePath)
		fileExists = bReturn
	End Function
	Public Function folderExists(sFolderPath)
		Dim bReturn
		bReturn =  fso.FolderExists(sFolderPath)
		folderExists = bReturn
	End Function
	Public Function validateXML(s_Doc)
		Dim sReturn, x
		Set x = CreateObject("MSXML2.DOMDocument.4.0")
		x.async = 0
		x.resolveExternals = 1
		x.validateOnParse = 1
		If x.load(s_doc) 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
	Public Function transformXML(sXML,sXSL)
		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
	Public Function Help(sString)
		Dim helpString
		If sString = "" Or LCase(sString) = "list" Then
			helpString = "SYSTEM Member Listing: Use Help(member) for more information" & vbcrlf
			helpString = helpString & "Desktop" & vbcrlf
			helpString = helpString & "forAllFolders" & vbcrlf
			helpString = helpString & "forAllFiles"
		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
		Help = helpString
	End Function
	private Sub Class_Initialize
		Dim WshShell
		'set WshShell = WScript.CreateObject("WScript.Shell")
		set WshShell = createObject("WScript.Shell")
		desktop = WshShell.SpecialFolders("Desktop")
		set WshShell = Nothing
		Set fso = createObject("Scripting.FileSystemObject")
	End sub
	Private Sub Class_Terminate
		Set fso = Nothing
	End Sub
End Class

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