Add And Remove Services Entries

This is a quick script I’ve used to add and remove entries to the windows services file. It ignores commented lines (lines starting with a hash (#)), and it also doesn’t validate the format of the host or port/protocol so use with care!

Usage

cscript.exe services.vbs “Add” “localhost” “8080/http”
cscript.exe services.vbs “Remove” “localhost” “8080/http”

Option Explicit

Const ForReading = 1
Const ForWriting = 2
Const ReadOnly = 1

'Usage
'cscript.exe services.vbs "Add" "host" "port/protocol" 
'cscript.exe services.vbs "Remove" "host" "port/protocol"

If (wscript.arguments.count < 3) Then
	'need a verb, host and port
	Wscript.quit
End If

'Add/Remove
dim inputAction : inputAction = wscript.arguments(0)

dim inputhostName : inputhostName = wscript.arguments(1)

dim inputPortProtocol : inputPortProtocol = wscript.arguments(2)

dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")

dim objShell : Set objShell = CreateObject("WScript.Shell")
dim strSystemRoot : strSystemRoot = objShell.ExpandEnvironmentStrings("%systemroot%")
dim pathToHosts : pathToHosts = strSystemRoot & "\system32\drivers\etc\services"

'make changes in memory first - we need to open it in write mode first otherwise we get 'Bad file mode' error
dim hostsFile : Set hostsFile = oFSO.OpenTextFile(pathToHosts, ForReading, true)
'get original read from file.  We'll amend hosts in memory until we commit changes at the end
dim hostsContent
If Not hostsFile.AtEndOfStream Then hostsContent = hostsFile.ReadAll

dim hostEntry

if (inputAction = "Add") Then
	hostsContent = AddServicesEntry(inputhostName,inputPortProtocol)
End If

if (inputAction = "Remove") Then
	hostsContent = RemoveServicesEntry(inputhostName,inputPortProtocol)
End If

hostsFile.Close()

'set attribute to read/write if readonly
dim objFile : Set objFile = oFSO.GetFile(pathToHosts)
If objFile.Attributes AND ReadOnly Then
    objFile.Attributes = objFile.Attributes XOR ReadOnly
End If

'then write changes to actual file
Set hostsFile = oFSO.OpenTextFile(pathToHosts, ForWriting, true)
hostsFile.Write hostsContent
hostsFile.Close()
    
Function RemoveServicesEntry(hostName, portProtocol)
  
	dim objRegEx : Set objRegEx = CreateObject("VBScript.RegExp")
	objRegEx.Pattern = "^(?!#)(" & hostName & ")(\s|\t)+" & portProtocol

	dim strNewContents : strNewContents = ""
	
	dim hostsContentLines : hostsContentLines = Split(hostsContent,vbCrlf)
	For each hostEntry in hostsContentLines
		If NOT objRegEx.Test(hostEntry) Then	
			strNewContents = strNewContents & hostEntry & vbCrLf		
		End If
	Next
	  
	'remove last carriage return	
	If Right(strNewContents, 2) = vbCrLf Then
		strNewContents = Left(strNewContents, Len(strNewContents) - 2)
	End If
	
	Set objRegEx = Nothing
	
	RemoveServicesEntry = strNewContents

End Function

Function AddServicesEntry(hostName, portProtocol)
  
	dim objRegEx : Set objRegEx = CreateObject("VBScript.RegExp")
	objRegEx.Pattern = "^(?!#)(" & hostName & ")(\s|\t)+" & portProtocol

	dim strNewContents : strNewContents = ""
	dim portProtocolExists : portProtocolExists = false	
	
	dim hostsContentLines : hostsContentLines = Split(hostsContent,vbCrlf)
	For each hostEntry in hostsContentLines
		If objRegEx.Test(hostEntry) Then
			portProtocolExists = true	
		End If
		strNewContents = strNewContents & hostEntry & vbCrLf
	Next
			  
	If Not portProtocolExists Then
		strNewContents = strNewContents & hostName & vbTab & portProtocol 
	End If
	
	'remove last carriage return	
	If Right(strNewContents, 2) = vbCrLf Then
		strNewContents = Left(strNewContents, Len(strNewContents) - 2)
	End If
	
	Set objRegEx = Nothing
	
	AddServicesEntry = strNewContents

End Function


Set hostsFile = Nothing
Set objFile = Nothing
Set oFSO = Nothing
Set objShell = Nothing

and here’s an example of how it can be called from another vbscript:

Option Explicit

Dim objFSO : Set objFSO = CreateObject("Scripting.FilesystemObject")
Dim objShell : Set objShell = CreateObject("Wscript.Shell")

dim strFolder : strFolder = objFSO.GetParentFolderName(WScript.ScriptFullName) 
dim strScript : strScript = strFolder & "\services.vbs"

If objFSO.FileExists(strScript) Then

	'example to add an entry
	addEntry "localhost","8080/tcp"
	'addEntry "localhost","8080/udp"

	'example to remove an entry
	'removeEntry "localhost","8080/udp"

End If

Function addEntry(host, portProtocol)

	dim commandLine : commandLine = chr(34) & strScript & chr(34) & " " & chr(34) & "Add" & chr(34) & " " & chr(34) & host & chr(34) & " " & chr(34) & portProtocol & chr(34)
	objShell.Run "cscript.exe " & commandLine

End Function

Function removeEntry(host, portProtocol)

	dim commandLine : commandLine = chr(34) & strScript & chr(34) & " " & chr(34) & "Remove" & chr(34) & " " & chr(34) & host & chr(34) & " " & chr(34) & portProtocol & chr(34)
	objShell.Run "cscript.exe " & commandLine

End Function

Set objFSO = Nothing
Set objShell = Nothing

 

Add and Remove Hosts Entries

This is a quick script I’ve used to add and remove entries to the windows hosts file. It ignores commented lines (lines starting with a hash (#)), and it also doesn’t validate the format of the host or IP address so use with care!

Usage

cscript.exe hosts.vbs “Add” “10.10.10.10” “example”
cscript.exe hosts.vbs “Remove” “10.10.10.10”

Option Explicit

Const ForReading = 1
Const ForWriting = 2
Const ReadOnly = 1

'Usage
'cscript.exe hosts.vbs "Add" "10.10.10.10" "example" 
'cscript.exe hosts.vbs "Remove" "10.10.10.10"

If (wscript.arguments.count < 2) Then
	'need a verb, host as a minimum
	Wscript.quit
End If

'Add/Remove
dim inputAction : inputAction = wscript.arguments(0)
dim inputIPAddress : inputIPAddress = wscript.arguments(1)
'host can be blank if removing
dim inputHost
if (wscript.arguments.count > 2) Then
	inputHost = wscript.arguments(2)
End If

dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")

dim objShell : Set objShell = CreateObject("WScript.Shell")
dim strSystemRoot : strSystemRoot = objShell.ExpandEnvironmentStrings("%systemroot%")
dim pathToHosts : pathToHosts = strSystemRoot & "\system32\drivers\etc\hosts"

'make changes in memory first - we need to open it in write mode first otherwise we get 'Bad file mode' error
dim hostsFile : Set hostsFile = oFSO.OpenTextFile(pathToHosts, ForReading, true)
'get original read from file.  We'll amend hosts in memory until we commit changes at the end
dim hostsContent
If Not hostsFile.AtEndOfStream Then hostsContent = hostsFile.ReadAll

dim hostEntry

if (inputAction = "Add") Then
	hostsContent = AddHostEntry(inputIPAddress,inputHost)
End If

if (inputAction = "Remove") Then
	hostsContent = RemoveHostEntry(inputIPAddress)
End If

hostsFile.Close()

'set attribute to read/write if readonly
dim objFile : Set objFile = oFSO.GetFile(pathToHosts)
If objFile.Attributes AND ReadOnly Then
    objFile.Attributes = objFile.Attributes XOR ReadOnly
End If

'then write changes to actual file
Set hostsFile = oFSO.OpenTextFile(pathToHosts, ForWriting, true)
hostsFile.Write hostsContent
hostsFile.Close()
    
Function RemoveHostEntry(ipAddress)
  
	dim objRegEx : Set objRegEx = CreateObject("VBScript.RegExp")
	objRegEx.Pattern = "^(?!#)(" & ipAddress & ")(\s|\t)+"

	dim strNewContents : strNewContents = ""
	
	dim hostsContentLines : hostsContentLines = Split(hostsContent,vbCrlf)
	For each hostEntry in hostsContentLines
		If NOT objRegEx.Test(hostEntry) Then	
			strNewContents = strNewContents & hostEntry & vbCrLf		
		End If
	Next
	  
	'remove last carriage return	
	If Right(strNewContents, 2) = vbCrLf Then
		strNewContents = Left(strNewContents, Len(strNewContents) - 2)
	End If
	
	Set objRegEx = Nothing
	
	RemoveHostEntry = strNewContents

End Function

Function AddHostEntry(ipAddress, hostName)
  
	dim objRegEx : Set objRegEx = CreateObject("VBScript.RegExp")
	objRegEx.Pattern = "^(?!#)(" & ipAddress & ")(\s|\t)+"

	dim strNewContents : strNewContents = ""
	dim hostnameExists : hostnameExists = false	
	
	dim hostsContentLines : hostsContentLines = Split(hostsContent,vbCrlf)
	For each hostEntry in hostsContentLines
		If objRegEx.Test(hostEntry) Then
			hostnameExists = true	
		End If
		strNewContents = strNewContents & hostEntry & vbCrLf
	Next
			  
	If Not hostnameExists Then
		strNewContents = strNewContents & ipAddress & vbTab & hostName 
	End If
	
	'remove last carriage return	
	If Right(strNewContents, 2) = vbCrLf Then
		strNewContents = Left(strNewContents, Len(strNewContents) - 2)
	End If
	
	Set objRegEx = Nothing
	
	AddHostEntry = strNewContents

End Function


Set hostsFile = Nothing
Set objFile = Nothing
Set oFSO = Nothing
Set objShell = Nothing

 

Search for a File Inside a Merge Module

Description

Sometimes I need to find if a file exists inside a merge module.  Since I don’t know which specific merge module I’m looking for, I wrote this script to iterate through every merge module in a specific folder to find a specific file in the File table.

Usage

CScript.exe {Script} {FileToSearchFor}

Const msiOpenDatabaseModeReadOnly = 0
Const msiOpenDatabaseModeTransact = 1
	 
'create WindowsInstaller.Installer object
dim oInstaller : Set oInstaller = CreateObject("WindowsInstaller.Installer")
dim fileName : fileName = wscript.arguments(0)

Const ForReading = 1
Const ForWriting = 2

sFolder = "C:\Program Files\InstallShield\2013\Objects"
Set oFSO = CreateObject("Scripting.FileSystemObject")

For Each oFile In oFSO.GetFolder(sFolder).Files
 
	'open the MSI (the first argument supplied to the vbscript)
	Dim oDatabase : Set oDatabase = oInstaller.OpenDatabase(oFile.Path,msiOpenDatabaseModeReadOnly) 
	 
	'create a view of the registry we want to see
	Dim sql : sql = "SELECT `FileName` FROM `File`"
	Dim regView : Set regView = oDatabase.OpenView(sql)
	 
	'execute the query
	regView.Execute 
	 
	'fetch the first row of data (if there is one!)
	Dim regRecord : Set regRecord = regView.Fetch
	 
	'whilst we've returned a row and therefore regRecord is not Nothing
	While Not regRecord Is Nothing
	 
		'print out the registry key
		If instr(regRecord.StringData(1),fileName) > 0 Then		
			wscript.echo "File " & fileName & " is in MSM: " & oFile.Path
		End If
	 
		'go and fetch the next row of data	
		Set regRecord = regView.Fetch
	Wend
	 
	regView.Close
	Set regView = Nothing
	Set regRecord = Nothing
	Set oDatabase = Nothing
	

Next

Set oInstaller = Nothing
Set oFSO = Nothing

 

Clean Up the Windows Start Menu

Sometimes after an install or an uninstall we want to clean up the start menu – usually this involves removing shortcuts to uninstall the application, shortcuts that link to help files and/or shortcuts that attempt to install additional components.  This tidy script (tested on Windows 7) can be used to populate file(s) and folder(s) names that require deleting.

Option Explicit

dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject") 
dim objShell : Set objShell = CreateObject("WScript.Shell") 

dim strProgramsPath : strProgramsPath = objShell.ExpandEnvironmentStrings("%AllUsersProfile%") & "\Microsoft\Windows\Start Menu\Programs"

'delete an array of files (shortcuts) from the start menu
dim arrFilesToDelete : arrFilesToDelete = Array( _
	strProgramsPath & "\Folder1\Link1.lnk", _
	strProgramsPath & "\Folder1\Link2.lnk", _
	strProgramsPath & "\Folder2\Link3.lnk", _
	strProgramsPath & "\Folder2\Link4.lnk" _
	)

dim strFile
For Each strFile In arrFilesToDelete
	If objFSO.FileExists(strFile) Then objFSO.DeleteFile strFile, True
Next

'delete an array of folders from the Start Menu
dim arrFoldersToDelete : arrFoldersToDelete = Array( _
	strProgramsPath & "\Folder1", _
	strProgramsPath & "\Folder2" _
	)

dim strFolder
For Each strFolder In arrFoldersToDelete
	If objFSO.FolderExists(strFolder) Then objFSO.DeleteFolder strFolder, True
Next

Set objFSO = Nothing
Set objShell = Nothing

 

Create Lnk Shortcut using VBScript

Dim objShell : Set objShell = CreateObject("WScript.Shell")
Dim userProfileFolder : userProfileFolder = objShell.ExpandEnvironmentStrings("%USERPROFILE%")
Dim desktopFolder : desktopFolder = userProfileFolder & "\Desktop"
Dim programFilesFolder : programFilesFolder = objShell.ExpandEnvironmentStrings("%ProgramFiles%")

Dim shortcutName : shortcutName = "Alkane Test"
Dim shortcutDescription : shortcutDescription = "Alkane Solutions Description"
Dim shortcutArguments : shortcutArguments = ""
Dim workingDir : workingDir = programFilesFolder & "\AlkaneSolutions\"
Dim shortcutTarget : shortcutTarget = workingDir & "test.exe"
Dim shortcutIcon : shortcutIcon = workingDir & "test.exe, 2"

'Create the shortcut
Dim lnk : Set lnk = objShell.CreateShortcut(desktopFolder & "\" & shortcutName & ".lnk")
lnk.TargetPath = shortcutTarget
lnk.Arguments = shortcutArguments
lnk.Description = shortcutDescription
lnk.HotKey = "ALT+CTRL+F"
lnk.IconLocation = shortcutIcon
lnk.WindowStyle = "1"
lnk.WorkingDirectory = workingDir
lnk.Save
   
'Clean up 
Set lnk = Nothing
Set objShell = Nothing

 

Wait for a Process to Complete

Description:

Useful when we want to wait for a process to complete until we continue execution of a script.

Source:

NA

Script:

This script waits until notepad.exe and iexplore.exe are no longer running:

dim svc : set svc=getobject("winmgmts:root\cimv2")
dim sQuery : sQuery="select * from win32_process where name='notepad.exe' OR name='iexplore.exe'"

Do
dim cproc : set cproc=svc.execquery(sQuery)
If cproc.count = 0 Then
	Exit Do
End If
WScript.Sleep 1000
Loop

 

Cascading Dropdown List using VBScript, XPATH and an XML back-end

I’ve been working on more toolsets recently, and we needed a way to populate multiple dropdown lists in a HTA file, and make them cascade. Cascading is basically where the results in the second dropdown list are dictated by the selection in the first dropdown list. For example:

Let’s say our first dropdown list contained car manufacturers, and the second dropdown list contained models. If I selected ‘Ford’ from the manufacturers dropdown list, I would want the model dropdown list to show me a list of all cars made by Ford (Fiesta, Mondeo, Escort etc etc) and so on.

Anyway, in our example we’ll use a good ol’ list of football clubs.  In dropdown list 1, we want a list of football clubs.  And in dropdown list 2, we want to see a list of players.  We also want to keep track of the stadium that each clubs plays in.  Here’s our sample XML chunk – we’ll call it ‘footballclubs.xml’:

<?xml version="1.0"?>
<PREMIERLEAGUEFOOTBALLCLUBS>
	<FOOTBALLCLUBS>
		<FOOTBALLCLUB>
			<FOOTBALLCLUBNAME>Manchester United FC</FOOTBALLCLUBNAME>
			<FOOTBALLCLUBSTADIUM>Old Trafford</FOOTBALLCLUBSTADIUM>
			<PLAYERS>				
				<PLAYER>
					<PLAYERNAME>Rio Ferdinand</PLAYERNAME>
				</PLAYER>		
				<PLAYER>
					<PLAYERNAME>Nemanja Vidic</PLAYERNAME>
				</PLAYER>				
			</PLAYERS>
		</FOOTBALLCLUB>
		<FOOTBALLCLUB>
			<FOOTBALLCLUBNAME>Chelsea FC</FOOTBALLCLUBNAME>
			<FOOTBALLCLUBSTADIUM>Stamford Bridge</FOOTBALLCLUBSTADIUM>
			<PLAYERS>				
				<PLAYER>
					<PLAYERNAME>Frank Lampard</PLAYERNAME>
				</PLAYER>				
			</PLAYERS>
		</FOOTBALLCLUB>
		<FOOTBALLCLUB>
			<FOOTBALLCLUBNAME>Arsenal FC</FOOTBALLCLUBNAME>
			<FOOTBALLCLUBSTADIUM>Emirates Stadium</FOOTBALLCLUBSTADIUM>
			<PLAYERS>				
				<PLAYER>
					<PLAYERNAME>Keiron Gibbs</PLAYERNAME>
				</PLAYER>		
				<PLAYER>
					<PLAYERNAME>Jack Wilshere</PLAYERNAME>
				</PLAYER>
				<PLAYER>
					<PLAYERNAME>Aaron Ramsey</PLAYERNAME>
				</PLAYER>				
			</PLAYERS>
		</FOOTBALLCLUB>		
	</FOOTBALLCLUBS>
</PREMIERLEAGUEFOOTBALLCLUBS>

You can see that the football clubs are: Manchester Utd, Chelsea and Arsenal. You should also be able to see the players for each club, and the stadium they play in.

Now we’ll write a HTA file, and save it in the same location as ”footballclubs.xml’:

<html>
<head>
<hta:application
 id="oHTA"
 applicationname="XML Cascading Drop Down"
 singleinstance="yes"
 windowstate="normal"
 border="no"
 maximize="no"
 caption="XML Cascading Drop Down"
 icon="alkane.ico"
 showintaskbar="yes"
 sysmenu="yes"> 
<title>XML Cascading Drop Down 1.0.0</title>
</head>

<script language="vbscript">

' *************
'
' Version 1.0.0
'
'**************

Option Explicit

Dim strXMLFile

Sub InitialWindow

	Dim intHorizontal, intVertical, intLeft, intTop, objItem	

	Dim menu_width : menu_width = "450"
	Dim menu_height : menu_height = "420"	

	' This moves the window to the middle of the screen
	Dim objWMIService : Set objWMIService = GetObject("winmgmts:\\.\root\cimv2") 
	Dim colItems : Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor WHERE DeviceID='DesktopMonitor1'") 

	For Each objItem in ColItems 
		intHorizontal = objItem.ScreenWidth 
		intVertical = objItem.ScreenHeight 
	Next 

	intLeft = (intHorizontal - menu_width)/2 
	intTop = (intVertical - menu_height)/2 
	window.resizeTo menu_width,menu_height 
	window.moveTo intLeft, intTop

	strXMLFile = FindCurrentDir & "footballclubs.xml"		

	Call PopulateDropdownLists

End Sub

Function FindCurrentDir

	Dim objShell : Set objShell = CreateObject("WScript.Shell")
	FindCurrentDir = Left(document.location.pathname,InStrRev(document.location.pathname,"\"))

End Function

Sub PopulateDropdownLists

	Dim objOption
	Dim strQuery, colItem, objItem

	Const intForReading = 1

	Dim xmlDoc : Set xmlDoc = CreateObject( "Microsoft.XMLDOM" )
	xmlDoc.Async = False

	If xmlDoc.Load(strXMLFile) Then

		'populate club names

		Set objOption = Document.createElement("OPTION")
		objOption.Text = "Select Club"
		objOption.value = "Select Club"
		ClubSelector.add(objOption)

		strQuery = "/PREMIERLEAGUEFOOTBALLCLUBS/FOOTBALLCLUBS/FOOTBALLCLUB/FOOTBALLCLUBNAME"	
		Set colItem = xmlDoc.selectNodes(strQuery)

		For Each objItem in colItem	
			Set objOption = Document.createElement("OPTION")
			objOption.Text = objItem.text
			objOption.value = objItem.text
			ClubSelector.add(objOption)		
		Next

		Set objOption = Document.createElement("OPTION")
		objOption.Text = "Select Player"
		objOption.value = "Select Player"
		PlayerSelector.add(objOption)	

	End If

	Set xmlDoc = Nothing

End Sub

Sub populateClubs()

	Dim footballclubname : footballclubname = ClubSelector.options(ClubSelector.SelectedIndex).value
	Dim objOption

	For Each objOption in PlayerSelector.Options
		objOption.RemoveNode
	Next 	

	Dim xmlDoc : Set xmlDoc = CreateObject("Microsoft.XMLDOM")
	xmlDoc.Async = False

	Set objOption = Document.createElement("OPTION")
	objOption.Text = "Select Player"
	objOption.value = "Select Player"
	PlayerSelector.add(objOption)

	If xmlDoc.Load(strXMLFile) Then

		dim strQuery : strQuery = "/PREMIERLEAGUEFOOTBALLCLUBS/FOOTBALLCLUBS/FOOTBALLCLUB [ FOOTBALLCLUBNAME = '" & footballclubname & "' ] /PLAYERS/PLAYER/PLAYERNAME"
		dim colItem : Set colItem = xmlDoc.selectNodes(strQuery)
		dim objItem

		For Each objItem in colItem
			Set objOption = Document.createElement("OPTION")
			objOption.Text = objItem.text
			objOption.value = objItem.text
			PlayerSelector.add(objOption)	
		Next
	End If

	Set xmlDoc = Nothing		

End Sub

Function getXMLValues(footballclubname,tag)

	Dim xmlDoc : Set xmlDoc = CreateObject( "Microsoft.XMLDOM" )
	xmlDoc.Async = False

	If xmlDoc.Load(strXMLFile) Then
		dim strQuery : strQuery = "/PREMIERLEAGUEFOOTBALLCLUBS/FOOTBALLCLUBS/FOOTBALLCLUB [ FOOTBALLCLUBNAME = '" & footballclubname & "' ] /" & tag & ""
		dim colItem : Set colItem = xmlDoc.selectNodes(strQuery)
		dim objItem

		For Each objItem in colItem
			getXMLValues = objItem.text
		Next
	End If

	Set xmlDoc = Nothing	

End Function

Sub displayStadium

	Dim footballclubname : footballclubname = ClubSelector.options(ClubSelector.SelectedIndex).value	
	Dim stadiumname : stadiumname = getXMLValues(footballclubname,"FOOTBALLCLUBSTADIUM")	
	MsgBox stadiumname

End Sub

</script>

<body scroll="no" onload="InitialWindow" style="text-align:center;font-family:Arial;font-size:12px;">

	<br /><br />
	<select size="1" id="ClubSelector" onChange="populateClubs()"></select><br /><br />
	<select size="1" id="PlayerSelector"></select><br /><br />

	<input type="button" value="Display Stadium" name="printSelection"  onClick="displayStadium()" />

</div>

</body>
</html>

 

Using VBScript, CAML queries and SOAP to Read from a Sharepoint List

We use a Sharepoint list to track various information. The toolsets that we create should ideally read from these lists, so that every team member shares the same information and can see real-time data. To do this, we used VBScript (we made a HTA actually…).

It uses a SOAP request to ‘ask’ for information from Sharepoint. Part of this request uses a CAML query to specify exactly what we’re after.

Option Explicit

Dim url, list, viewFields, request, xmlDoc, elements, colItem, objItem, queryNode, clientname, resultsArray, xmlArray(), strItem, spclientname

Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")
xmlDoc.async = False

url = "http://xxxx/_vti_bin/Lists.asmx"

'search in client list for 'Multi Client', where LinkTitle equals 'Multi Client', and bring me back the target platform
resultsArray = getResults("331609D1-793D-4075-BC88-570956C6D729","LinkTitle","Multi Client","ows_Target_x0020_Platform")

'do what we want with the clients here
For Each strItem in resultsArray
    Wscript.Echo strItem
Next

Function getResults(splist, spwhere, spvalue, spreturnattribute)	

	request = "<?xml version='1.0' encoding='utf-8'?>" & _
	"<soap:Envelope xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' xmlns:xsd='http://www.w3.org/2001/XMLSchema' xmlns:soap='http://schemas.xmlsoap.org/soap/envelope/'>" & _
	"  <soap:Body>" & _
	"    <GetListItems xmlns='http://schemas.microsoft.com/sharepoint/soap/'>" & _
	"      <listName>" & splist & "</listName>" + _
	"      <query><Query xmlns=''>" & _
	"      <Where>" & _
	"      <Eq>" & _
	"      <FieldRef Name='" & spwhere & "'/>" & _
	"      <Value Type='Text'>" & spvalue & "</Value>" & _
	"      </Eq>" & _
	"      </Where>" & _
	"      </Query>" & _
	"      </query>" & _
	"    </GetListItems>" & _
	"  </soap:Body>" & _
	"</soap:Envelope>"

	'post it up and look at the response
	with CreateObject("Microsoft.XMLHTTP")
		.open "Get", url, False, null, null
		.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
		.setRequestHeader "SOAPAction","http://schemas.microsoft.com/sharepoint/soap/GetListItems"
		.send request

		xmlDoc.setProperty "SelectionLanguage", "XPath"
		xmlDoc.async = false
		xmlDoc.validateOnParse = false
		xmlDoc.resolveExternals = false
		xmlDoc.setProperty "SelectionNamespaces", "xmlns:s='uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882' xmlns:soap='http://schemas.xmlsoap.org/soap/envelope/' xmlns:namespace='http://schemas.microsoft.com/sharepoint/soap/' xmlns:rs='urn:schemas-microsoft-com:rowset' xmlns:z='#RowsetSchema'"

		xmlDoc.loadXML(.responseText)

		'dim strQuery : strQuery = "//soap:Envelope/soap:Body/namespace:GetListItemsResponse/namespace:GetListItemsResult/namespace:listitems/rs:data/z:row"
		dim strQuery : strQuery = ".//z:row"

		Set colItem = xmlDoc.selectNodes(strQuery)

		Dim objItemCount : objItemCount = 0
		'clear array
		ReDim xmlArray(objItemCount)

		'wscript.echo "No of Items: " & colItem.Length
		For Each objItem in colItem		
			ReDim Preserve xmlArray(objItemCount)
			xmlArray(objItemCount) = objItem.getAttribute(spreturnattribute)			
			objItemCount = objItemCount + 1
		Next
		Set colItem = Nothing

		'we could use this if we didnt filter it during the request	
		'Set queryNode = xmlDoc.selectSingleNode(".//z:row[@ows_LinkTitle = '" & clientname & "']")
		'wscript.echo queryNode.getAttribute("ows_Target_x0020_Platform")
		'Set queryNode = Nothing

		Set xmlDoc = Nothing

		getResults = xmlArray	

	end with

End Function

**UPDATE**

The example above pulls back ALL fields from the list.  We may want to refine this to only pull back specific fields by adding the following to our SOAP request:

    " 	   <viewFields><ViewFields><FieldRef Name='COMPANYNAME_x0020_Property' /><FieldRef Name='USERNAME_x0020_Property' /></ViewFields></viewFields>" + _
    "    <queryOptions>" + _
    " 	       <QueryOptions>" + _
    " 	           <IncludeMandatoryColumns>FALSE</IncludeMandatoryColumns>" + _
    " 	           <ViewFieldsOnly>TRUE</ViewFieldsOnly>" + _
    " 	       </QueryOptions>" + _
    " 	   </queryOptions>" + _

The first viewFields tag above should be at the same level as the <query> tag in the example above.  In other words, you can paste this code directly above the <query> line in the SOAP request.