Deleting Sub-Folders with VBScript, Coffee and French Fries

Delete all sub-folders beneath a given root folder on multiple (remote) computers.  The old RD/RMDIR command will delete the named root folder along with sub-folders, by default.  This script leaves the root folder alone and only deletes the sub-folders.  Feel free to modify as needed.

'****************************************************************
' Filename..: fso_delete_subfolders.vbs
' Author....: David M. Stein
' Date......: 11/19/2013
' Purpose...: delete all sub-folders beneath a root path, on multiple computers
' NO WARRANTIES - USE AT YOUR OWN RISK - YOU DAREDEVIL YOU
'****************************************************************

Dim strServer, objSubFolder
Dim strFolderRoot, strSubFolder, x

Const strServerList = "SERVER1,SERVER2,SERVER3"
Const strRootPath = "D$\TEMP"

Set objFSO = CreateObject("Scripting.FileSystemObject")

For each strServer in Split(strServerList, ",")
wscript.echo "info: server is " & strServer
On Error Resume Next
strFolderRoot = "\\" & strServer & "\" & strRootPath
Set objFolder = objFSO.GetFolder(strFolderRoot)
If err.Number = 0 Then
For each objSubFolder in objFolder.SubFolders
strSubFolder = objSubFolder.Name
wscript.echo "info: deleting folder --> " & strFolderRoot & "\" & strSubFolder
x = objFSO.DeleteFolder(strFolderRoot & "\" & strSubFolder, True)
wscript.echo "info: result is " & x
Next
Else
wscript.echo "error [" & err.Number & "]: " & err.Description
wscript.echo "info: could be caused by folder-not-found."
End If
Next

File Search using WMI CIM_DataFile with VBScript

I looked around, but didn't find a script example that did exactly what I wanted, but I ran across several good alternatives. One thing I found was that if I don't specify the drive letter, it takes WAAAAAAAYYYYY longer to execute. Just a tip. In any case, I hope this helps someone out there...

'****************************************************************
' Filename..: fileSearch.vbs
' Author....: ScriptZilla / SkatterBrainz / Dave
' Date......: 07/30/2012
' Purpose...: search for files using WMI/CIM_DataFile
'****************************************************************
time1 = Timer

'----------------------------------------------------------------
' comment: search parameters
'----------------------------------------------------------------

strFileExt  = "syn"
strFileName = "*"
strDriveLtr = "c:"
strComputer = "."

'----------------------------------------------------------------
' function: 
'----------------------------------------------------------------

Function StringDate(dv)
 Dim xdy, xdm, xdd, xdh, xdn, tmp
 ' example: 20120729195837.171181-240
 xdy = Mid(dv,1,4) ' year
 xdm = Mid(dv,5,2) ' month
 xdd = Mid(dv,7,2) ' day
 xdh = Mid(dv,9,2) ' hour
 xdn = Mid(dv,11,2) ' minute
 tmp = xdm & "/" & xdd & "/" & xdy & " " & xdh & ":" & xdn
 StringDate = FormatDateTime(tmp, vbShortDate) & " " & _
  FormatDateTime(tmp, vbLongTime)
End Function

'----------------------------------------------------------------
' comment: main script code begins
'----------------------------------------------------------------

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

If strFileName = "*" Then
 query = "Select * from CIM_DataFile Where Drive='" & strDriveLtr & "'" & _
  " AND Extension='" & strFileExt & "'"
Else
 query = "Select * from CIM_DataFile Where Drive='" & strDriveLtr & "'" & _
  " AND FileName = '" & strFileName & "'" & _
  " AND Extension='" & strFileExt & "'"
End If

wscript.echo "info: search criteria = " & strFileName & "." & strFileExt & " on " & strDriveLtr
Set colFiles = objWMIService.ExecQuery(query)

wscript.echo "info: beginning search..."

counter = 0
For Each objFile in colFiles
 counter = counter + 1
    wscript.echo objFile.Drive & objFile.Path & _
     objFile.FileName & "." & objFile.Extension & _
     vbTab & StringDate(objFile.CreationDate) & _
     vbTab & StringDate(objFile.LastModified) & _
     vbTab & objFile.FileSize
Next

wscript.echo "info: " & counter & " matching files found"
wscript.echo "info: " & Timer - time1 & " seconds"

Query AD Computers with Custom HOSTS File Entries

'****************************************************************
' Filename..: enum_ad_host_files.vbs
' Author....: David M. Stein
' Date......: 04/15/2012
' Purpose...: search for hosts files with custom entries
'****************************************************************
dns_netbios = "short_name_of_your_active_directory_domain"

Const ForReading = 1
Const ForWriting = 2

wscript.echo "info: scanning domain = " & dns_netbios

Set objDom = GetObject( "WinNT://" & dns_netbios )
Set objFSO = CreateObject("Scripting.FileSystemObject")

tcount = 0

For each obj in objDom
 If Lcase(obj.Class) = "computer" Then
  computerName = obj.Name
  wscript.echo "info: " & computerName
  tcount = tcount + 1
  CheckHosts computerName
 End If
Next

Sub CheckHosts(cn)
 Dim filename, objFile, strLine, found
 filename = "\\" & cn & "\admin$\system32\drivers\etc\hosts"
 wscript.echo "info: searching for: " & filename
 If objFSO.FileExists(filename) Then
  On Error Resume Next
  Set objFile = objFSO.OpenTextFile(filename, ForReading)
  If err.Number = 0 Then
   Do Until objFile.AtEndOfStream
    strLine = Trim(objFile.Readline)
    If Left(strLine,1) <> "#" And strLine <> "" Then
     found = True
    End If
   Loop
   objFile.Close
   
   If found = True Then 
    wscript.echo "info: custom entry found!"
   Else
    wscript.echo "info: no custom entries found."
   End If
  Else
   wscript.echo "fail: error (" & err.Number & ") = " & err.Description
  End If
   
 Else
  wscript.echo "fail: unable to locate hosts file on " & cn
 End If
End Sub

wscript.echo "info: " & tcount & " account objects found"

Query Installed Apps a Different Way

For whatever reason, in some environments, a WMI query of Win32_Product is God-awful slow.  I've seen this on Windows 7 and Windows 7 SP1 clients, as well as on Windows Server 2008 and 2008 R2.  The symptom can be seen from WIM script, WBEM, and using WMIC from a command console with very similar results:  The query hangs for 20-25 seconds and then begins executing in spurts.  Other Win32 classes work fine, from what I've seen, it's just Win32_Product for some reason.  One workaround is to dump a registry output file, and scrub it to make a "clean" output file.  You can port this to PowerShell or KiXtart if you want (or whatever you prefer, I really don't care as long as you're happy and that makes me happy so we're all happy. yay!)

'****************************************************************
' Filename..: installedApps.vbs
' Author....: David M. Stein aka Scriptzilla aka dipshit
' Date......: 10/20/2011
' Purpose...: save query of installed applications to local file
'****************************************************************

Const strInputFile  = "c:\regoutput.txt"
Const strOutputFile = "c:\installedApps.txt"

Const ForReading = 1
Const ForWriting = 2
Const adVarChar = 200

cmd = "reg query hklm\software\microsoft\windows\currentversion\uninstall /s >" & strInputFile

On Error Resume Next

Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

wscript.echo "info: executing shell command to create temp file..."

objShell.Run "cmd /c " & cmd, 7, True

wscript.echo "info: getting temp file for input..."

If objFSO.FileExists(strInputFile) Then
 wscript.echo "info: reading temp file..."
 Set objFile = objFSO.OpenTextFile(strInputFile, ForReading)
 Set objFile2 = objFSO.CreateTextFile(strOutputFile, True)

 Set rs = CreateObject("ADODB.RecordSet")

 rs.CursorLocation = adUseClient
 rs.Fields.Append "productname", adVarChar, 255
 rs.Open

 Do Until objFile.AtEndOfStream
     strLine = objFile.Readline
     If Left(strLine, 25) = "    DisplayName    REG_SZ" Then
      strOutput = Trim(Mid(strLine, 30))
   rs.AddNew
   rs.Fields("productname").value = strOutput
   rs.Update
     End If
 Loop
 
 rs.Sort = "productname"
 
 Do Until rs.EOF
     objFile2.WriteLine(rs.Fields("productname").value)
  rs.MoveNext
 Loop
 rs.CLose
 Set rs = Nothing
 
 objFile.Close
 objFile2.Close
 wscript.echo "info: finished scrubbing input to new output file"
Else
 wscript.echo "fail: temp file not found"
End If

Set objFSO = Nothing
Set objShell = Nothing
'----------------------------------------------------------------

wscript.echo "info: processing complete!"

Querying Files Using Windows Search with VBScript

'****************************************************************
' Filename..: scanFiles.vbs
' Author....: David M. Stein aka Skatterbrainz aka Scriptzilla aka goofy
' Contact...: ds0934 (at) gmail (dot) com
' Date......: 02/14/2011
' Purpose...: generate file scan report using Windows Search queries
'****************************************************************
' COPYRIGHT (C) 2011 David M. Stein - All Rights Reserved.
' No portion of this software code may be reproduced, shared,
' transmitted, by any means, electronic or otherwise, for any
' purposes whatsoever, without the explicit prior written consent 
' of the author.  
'****************************************************************
' DESCRIPTION
'
' This script invokes the built-in Windows Desktop Search service
' to query the local index for files that contain specific string
' phrases.  The string phrases are defined in an external text
' file which allows for customization of phrases as needed.
' The output is echoed to the display screen unless redirected
' to a log file.  The associated .cmd file does just that. It is
' used to execute this script, and redirect the output to a log
' file which is saved to a central folder (network server share)
'****************************************************************


Option Explicit


Const verbose = False


'----------------------------------------------------------------
' comment: DO NOT CHANGE ANY CODE BELOW THIS POINT !!!
' comment: ...or ye shall perish in the land of stupidity
'----------------------------------------------------------------


echo "info: script initialized " & Now


Const ForReading = 1
Const ForWriting = 2


Dim objConnection, objRecordset, query, scriptPath, inputFile
Dim objFSO, objFile, strLine, searchList, itemCount : itemCount = 0
Dim filePath, phrase


Set objFSO = CreateObject("Scripting.FileSystemObject")


' comment: determine self-referential path location
scriptPath = Replace(wscript.ScriptFullName, "\" & wscript.ScriptName, "")
inputFile = "searchlist.txt"
' comment: determine input search list file location
filePath = scriptPath & "\" & inputFile


On Error Resume Next
echo "info: searching for searchlist.txt input file..."
If objFSO.FileExists(filePath) Then
    echo "info: reading search values..."
    Set objFile = objFSO.OpenTextFile(filePath, ForReading)
    Do Until objFile.AtEndOfStream
        strLine = objFile.Readline
        If Left(strLine,1) <> ";" Then
            If searchList <> "" Then
                searchList = searchList & vbTab & strLine
            Else
                searchList = strLine
            End If
            itemCount = itemCount + 1
        End If
    Loop
    objFile.Close
End If


echo "info: " & itemCount & " phrases were queued"


'----------------------------------------------------------------
 
echo "info: initializing window search interface..."

Set objConnection = CreateObject("ADODB.Connection")


echo "info: opening windows search data connection..."
objConnection.Open "Provider=Search.CollatorDSO;Extended Properties='Application=Windows';"
If err.Number <> 0 Then
    echo "fail: connection-open failure [" & _
        err.Number & ":" & err.Description & "]"
    wscript.quit(2)
End If


echo "info: beginning windows search scan process..."
For each phrase in Split(searchList, vbTab)
    wscript.echo "PHRASE: " & phrase

    ' comment: define search query expression to identify matching files

    query = "SELECT System.FileName, System.ItemPathDisplay, " & _
        "System.DateCreated, System.DateModified " & _
        "FROM SYSTEMINDEX WHERE Contains(System.FileName, '" & _
        Chr(34) & phrase & Chr(34) & "')" & _
        " OR Contains('" & Chr(34) & phrase & Chr(34) & "')"

    ' comment: open connection to service and submit query request

    Set objRecordSet  = CreateObject("ADODB.Recordset")
    objRecordSet.Open query, objConnection

    If err.Number <> 0 Then
        echo "fail: recordset-open failure [" & _
            err.Number & ":" & err.Description & "]"
        objConnection.Close
        Set objConnection = Nothing
        wscript.quit(3)
    End If

    ' comment: if results are not empty, iterate the dataset rows

    If Not (objRecordset.BOF and objRecordset.EOF) Then
        objRecordSet.MoveFirst


        echo "info: iterating recordset results..."
        Do Until objRecordset.EOF
            wscript.echo "MATCH: " & _
            objRecordset.Fields.Item("System.ItemPathDisplay").value & _
            vbTab & objRecordset.Fields.Item("System.DateCreated").value & _
            vbTab & objRecordset.Fields.Item("System.DateModified").value
            objRecordset.MoveNext
        Loop
        wscript.echo
    Else
        echo "info: no matching records were found"
    End If
    objRecordset.Close
    Set objRecordset = Nothing
Next


' comment: close connection to service


objConnection.Close
Set objConnection = Nothing


echo "info: processing completed " & Now


'----------------------------------------------------------------
' function: verbose printing
'----------------------------------------------------------------


Sub Echo(s)
    If verbose = True Then
        wscript.echo s
    End If
End Sub

EXAMPLE of searchlist.txt

; disable lines by inserting a semi-colon in front of them

This is a phrase to search for

this is another phrase

phrases are case insensitive

Recursively Delete Files by Extension Name

Const strExtensionsToDelete = "wav,avi,mp3,aac,tmp,bak"
Const testMode = True

Sub RecursiveDeleteByExtension(ByVal strDirectory, strExtensionsToDelete)
  Dim objFolder, objSubFolder, objFile
  Dim strExt
  Set objFolder = objFSO.GetFolder(strDirectory)
  For Each objFile in objFolder.Files
    For Each strExt in Split(Ucase(strExtensionsToDelete),",")
      If Right(Ucase(objFile.Path), Len(strExt)+1) = "." & strExt Then
        wscript.echo "Deleting:" & objFile.Path
        If Not testMode = True Then
          objFile.Delete
        End If
        'Exit For
      End If
    Next
  Next 
  For Each objSubFolder in objFolder.SubFolders
    RecursiveDeleteByExtension objSubFolder.Path, strExtensionsToDelete
  Next
End Sub

Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
RecursiveDeleteByExtension "d:\downloads", strExtensionsToDelete
wscript.echo "finished!"

Recursively Delete Old Files and Empty Folders

With a slight twist: The recursion to delete empty folders ignores folders with a name that begins with a tilde "~". You can modify the character or pattern to suit your demented whims.

Const maxAge = 30
Const testMode = True

Sub RecursiveDeleteByAge(ByVal strDirectory, maxAge)
 Dim objFolder, objSubFolder, objFile
 Set objFolder = objFSO.GetFolder(strDirectory)
 For Each objFile in objFolder.Files
  dlm = objFile.DateLastModified
  If DateDiff("d", dlm, Now) > maxAge Then
   wscript.echo "Deleting:" & objFile.Path
   If Not testMode = True Then
    objFile.Delete
   End If
   Exit For
  End If
 Next 
 For Each objSubFolder in objFolder.SubFolders
  RecursiveDeleteByAge objSubFolder.Path, maxAge
 Next
End Sub


Sub RecursiveDeleteEmptyFolders(ByVal strDirectory)
 Dim objFolder, objSubFolder
 Set objFolder = objFSO.GetFolder(strDirectory)
 
 If objFolder.Files.Count = 0 Then
  If objFolder.SubFolders.Count = 0 Then
   ' no sub-folders beneath this folder...
   If Left(objFolder.Name,1) <> "~" Then
    wscript.echo "deleting " & objFolder.Path
    If Not testMode = True Then
     objFolder.Delete
    End If
   End If
  Else
   For Each objSubFolder in objFolder.SubFolders
    RecursiveDeleteEmptyFolders objSubFolder.Path
   Next
  End If
 Else
  wscript.echo "folder is not empty"
  For Each objSubFolder in objFolder.SubFolders
   RecursiveDeleteEmptyFolders objSubFolder.Path
  Next
 End If
 
End Sub

Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")

RecursiveDeleteByAge "d:\downloads", maxAge
RecursiveDeleteEmptyFolders "d:\downloads"

wscript.echo "finished!"

Making Folder Trees

I was asked to provide a script to help someone else with creating a folder tree during a software installation.  I explained that it’s “one line of code” when using a .BAT/.CMD script with “mkdir x:\folder\folder\folder”, but I got the hand in the face, followed by “we need it to be VBscript, not DOS”.  I said “whatever” and cranked out the following hamburger pile. I hope it’s of use to someone else…

rootPath = "c:\program files"
folderPath = "vendorname\appname\folder123"
fpath = rootPath & "\" & folderPath
 
Set fso = CreateObject("Scripting.FileSystemObject")
 
If fso.FolderExists(rootPath) Then
    tmp = rootPath
    For each s in Split(folderPath, "\")
        tmp = tmp & "\" & s
        If fso.FolderExists(tmp) Then
            wscript.echo "exists: " & tmp
        Else
            wscript.echo "creating: " & tmp
            fso.CreateFolder(tmp)
        End If
    Next
Else
    wscript.echo "fail: root path not found = " & rootPath
End If

Script Tip: Determine the Script File Path

With BAT/CMD scripts you can simply prefix any path references with %~dps0 to get to things in the same location (folder/UNC) where the script itself resides.  So if you run..

start /wait %~dps0setup.exe /silent /norestart

It runs setup.exe from the same folder location. (that is not a typo, there should be NO space between the zero and the rest of the file path)

It's just as easy with KiXtart using the @scriptdir macro, but with VBscript it's not that simple.  But it's not difficult either…

scriptPath = Replace(Wscript.ScriptFullName, "\" & Wscript.ScriptName, "")

An example of running setup.exe in the same folder with VBscript might be…

filePath = scriptPath & "\setup.exe"
result = objShell.Run(filePath & " /silent /norestart", 7, True)

However, be careful to wrap paths in double-quotes if they contain spaces…

filePath = Chr(34) & scriptPath & "\setup.exe" & Chr(34)
result = objShell.Run(filePath & " /silent /norestart", 7, True)

Script to Auto-Update Your Sysinternals Tools

Jason Faulkner posted a very cool Batch script to freshen your library of Sysinternals tools over at SysAdminGeek.com.  It queries the live.sysinternals.com\tools repository and downloads matching tools in your library.  If you haven't already checked it out, you should (click here).

Here's a version I've done in VBScript.  You can tweak it for your needs and even schedule it to run periodically to keep your tools up to date.

Const livetools = "\\live.sysinternals.com\tools"
Const localtools = "c:\sysinternals"

Set objFSO = CreateObject("Scripting.FileSystemObject")

On Error Resume Next
wscript.echo "info: connecting to live.sysinternal.com..."
Set objLiveFolder = objFSO.GetFolder(livetools)
If err.Number <> 0 Then
	wscript.echo "fail: unable to connect"
	wscript.quit(1)
End If

If objFSO.FolderExists(localTools) = False Then
	wscript.echo "fail: local folder not found"
	wscript.quit(2)
End If

For each objFile in objLiveFolder.Files
	fileName = objFile.Name
	If objFSO.FileExists(localtools & "\" & fileName) Then
		wscript.echo "info: updating file " & fileName & "..."
		sourceFile = liveTools & "\" & fileName
		targetFile = localTools & "\" & fileName
		objFSO.CopyFile sourceFile, targetFile, True
	End If
Next

Set objFolder = Nothing
Set objFSO = Nothing

If I had more time I'd do this in KiXtart and Powershell, but I'll leave that to someone else.  Enjoy!

Automate DCDiag on your Domain Controllers

I’ve been doing this for (literally) years.  About 7 years to be exact.  You can do this with NETDIAG, REPADMIN and several other “diagnostic” utilities that work from the command line.

The idea is to wrap the diagnostic operation inside a script so that you can capture the output in a text file, then turn around and open the text file to parse it for what you want.  Then you can do almost anything with that information:

• Generate a summary report file
• Send the results into a database table
• Send the results as an e-mail report
• and on and on and on…

There are several ways to set this up as well.  For this example I’m using a VBScript file, a domain user (aka “service” or “proxy”) account, and the Windows Task Scheduler on a Windows Server 2008 domain controller.  This works just fine on Windows Server 2003 and Windows Server 2008 R2 as well.

The Script:

Const logFileName = "x:\logs\dcdiag.log"
Const ForReading = 1
Const ForWriting = 2

Dim objShell, objFSO, computer, domain, cmdstr
Dim objFile, testLabel, passed, failed

Set objShell = CreateObject("Wscript.Shell")
Set objFSO   = CreateObject("Scripting.FileSystemObject")

computer = Ucase(objShell.ExpandEnvironmentStrings("%computername%"))
domain   = Ucase(objShell.ExpandEnvironmentStrings("%userdnsdomain%"))

cmdstr = "cmd /c dcdiag /v >" & logFileName

objShell.Run cmdstr, 1, True

If objFSO.FileExists(logFileName) Then
    passed = 0
    failed = 0
	
    Set objFile = objFSO.OpenTextFile(logFileName, ForReading)

    Do Until objFile.AtEndOfStream
        strLine = objFile.Readline
    
        testLabel = Mid(strLine, 36)

        If InStr(1, testLabel, computer & " passed test") > 0 Then
            wscript.echo testLabel
            passed = passed + 1
        ElseIf InStr(1, testLabel, computer & " failed test") > 0 Then
            wscript.echo testLabel
            failed = failed + 1
        ElseIf InStr(1, testLabel, domain & " passed test") > 0 Then
            wscript.echo testLabel
            passed = passed + 1
        ElseIf InStr(1, testLabel, domain & " failed test") > 0 Then
            wscript.echo testLabel
            failed = failed + 1
        Else
            '
        End If
    Loop
    objFile.Close
    Set objFSO = Nothing

    wscript.echo "Passed " & passed & " tests"
    wscript.echo "Failed " & failed & " tests"	
Else
    wscript.echo "fail: log file not found"
End If

Set objFSO = Nothing
Set objShell = Nothing

The Explanation:

The top section defines the path and filename for the output file we’re going to capture and analyze.  Next we define some variables.  Then we instantiate the Shell and FileSystemObject object interfaces. 

We use the Shell object to fetch the name of the computer and the domain name. We need those to help sift through the output file and find the matching lines we want to look at.  The Shell object is also used to run the DCDIAG command via the “Run” method.

After running the shell command, we then check if the output file exists.  If it does, we open it and read through it line-by-line looking for matching strings.  Within each matching string we look for “passed” or “failed” and count them up as well as echo them to the command prompt.

At the end we mop up and then display the tally for passed and failed tests.

Important Note: This is only ONE form of doing this.  There is no limit to what you CAN do.  For example, instead of echoing the testLabel contents, we could concatenate them into a report text block and send it via CDOsys (e-mail) or stuff it into a database via ADO or XML or generate an XML or HTML report, or even stuff it directly into a Microsoft Word or Excel document.  The possibilities are endless.

If anyone is interested in variations on this just post a comment and I’ll see what I can do.  I hope this helps someone out there?

VBScript ADO with XML and CSV Data Files

I was poking around to find a way to read CSV, TXT (various delimiters) through VBScript for use in scripted data migrations, as well as to render the data in ASP, and found some interesting things.  I have to give credit to [http://www.mombu.com/microsoft/scripting-wsh/t-query-xml-file-with-ado-in-wsh-131431.html] for the XML example.  I only modified it slightly to fit in with how I tend to code ADO processes.  I also would like to applaud the efforts of Connection Strings.com for their fantastic reference site for connection information for almost anything that can possibly store information.

Reading XML Data

Const dsn = "Provider=MSDAOSP;Data Source=MSXML2.DSOControl;"
Const adChapter = 136

Dim conn, rs
Dim iLevel : iLevel = 0

Set conn = CreateObject( "ADODB.Connection" )
Set rs = CreateObject( "ADODB.Recordset" )

conn.Open dsn

rs.Open CreateObject( "WScript.Shell" ).CurrentDirectory + _
    "\test.xml", conn

WalkHier iLevel, rs

rs.Close
conn.Close

Sub WalkHier(ByVal iLevel, ByVal rs)
    iLevel = iLevel + 1
    Dim PriorLevel : PriorLevel = iLevel
    Dim i, adoChildRS
    While Not rs.EOF
        For i = 0 To rs.Fields.Count - 1
            If rs.Fields(i).Name <> "$Text" Then
                If rs.Fields(i).Type = adChapter Then
                    Set adoChildRS = rs.Fields(i).Value
                    WalkHier iLevel, adoChildRS
                Else
                    wscript.echo iLevel & ": rs.Fields(" & i & ") = " & _
                        rs.Fields(i).Name & " = " & rs.Fields(i).Value
                End If
            End If
        Next
        rs.MoveNext
    Wend
    iLevel = PriorLevel
End Sub

Reading CSV Data

dsn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='s:\scripts\';Extended Properties=""text;HDR=Yes;FMT=Delimited(,);"""

query = "SELECT * FROM test.csv"

Set conn = CreateObject("ADODB.Connection")
Set cmd  = CreateObject("ADODB.Command")
Set rs   = CreateObject("ADODB.Recordset")

conn.Open dsn

rs.CursorLocation = adUseClient
rs.CursorType = adOpenStatic
rs.LockType = adLockReadOnly

Set cmd.ActiveConnection = conn

cmd.CommandType = adCmdText
cmd.CommandText = query
rs.Open cmd

If Not(rs.BOF And rs.EOF) Then
    Do Until rs.EOF
        For i = 0 to rs.Fields.Count - 1
            wscript.echo rs(i).name & " = " & rs(i).value
        Next
        rs.MoveNext
    Loop
Else
    wscript.echo "error: no records found"
End If
rs.Close
conn.Close
Set rs = Nothing
Set cmd = Nothing
Set conn = Nothing

Convert INI to XML with KiXtart

Sometimes you may want/need to read a standard INI data file and output it to an XML format.  There are several ways to do this, but here is just one.  You’ll need KiXtart 4.61 in order to use the Replace() function. Enjoy (and Merry Christmas!)

KiXtart Code

Break ON
; requires KiXtart 4.61 or later!!!
If @kix <= "4.60"
    ? "this script requires 4.61 or later!"
    Exit
EndIf

$strFileName = "s:\scripts\test.ini"

$quote = Chr(34)
$tab = Chr(9)

Dim $linecount, $fHandle, $strLine, $outer, $keyset, $subkeyformat
Dim $name, $value

$subkeyFormat = 1
$fHandle = FreeFileHandle()
$outer = ""

If Open($fHandle, $strFileName) = 0
    $strLine = ReadLine($fHandle)
    While @error = 0
        Select
            Case Left($strLine,1) = "["
                $outer = Replace(Replace($strLine, "]", ""), "[", "")
                ? "<$outer>"
            Case InStr($strLine, "=") <> 0
                $keyset = Split($strLine, "=")
                $name  = $keyset[0]
                $value = $keyset[1]
                If $subkeyFormat == 1
                    ? "$tab"
                Else
                    ? "$tab<$name>$value</$NAME>"
                EndIf
            Case 1
                If $outer <> ""
                    ? "</$OUTER>"
                    $outer = ""
                EndIf
        EndSelect
        $strLine = ReadLine($fHandle)
    Loop
    $=Close($fHandle)
EndIf

KiXtart: Using FSO File.ReadAll()

Another example of making use of one scripting language or API from another.  In this case, I’m calling on the FileSystemObject API to invoke the ReadAll() function on a file from a KiXtart script.  Just to show that there are all sorts of things you can do like this…

function ReadFile($filepath)
    $fso = CreateObject("Scripting.FileSystemObject")
    if exist($filepath)
        $file = $fso.OpenTextFile($filepath)
        $text = $file.ReadAll()
        $file.Close()
        $file = 0
    else
        ? "error: file not found"
    endif
    $readfile = $text
endfunction

; example...

? readfile("c:\myfile.txt")