I have a file called settings.ini that I need to modify in one way or another. Within the file, there will either be a specific section present, or not...

----------
[MODULE 1.3]
FolderName=Root,PrintResults, FileTransfer, VolumeControl , RestrictedOperators
----------

Either way, there are several things I need to do to clean up the data.

If the section exists (both lines above), then I need to check to see if a specific entry exists (FolderName). If the entry exists, then I need to check to see if a specific value exists on that line. If the value exists, then I'm done.

If the section doesn't exist, insert it. If the entry doesn't exist, insert it (with all appropriate values). If the value doesn't exist, append it. Here's what I have so far...

----------
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objfileini = FSO.GetFile("settings.ini")
If FSO.FileExists ("settings.bak") then
Set objFileBak = FSO.GetFile ("settings.bak")
FSO.DeleteFile "settings.bak"
end if
If FSO.FileExists ("settings.new") then
Set objFileNew = FSO.GetFile ("settings.new")
FSO.DeleteFile "settings.new"
end if
FSO.CopyFile objfileini, "settings.bak"
Set objStream = objfileini.OpenAsTextStream(1, 0)
Set objOutput = FSO.OpenTextFile("settings.new", 2, True, 0)
Do While Not objStream.AtEndOfStream
arrLine = objStream.ReadLine
if instr(1, arrLine, "[MODULE 1.3]", 1) then
x = 1
end if
if instr(1, arrLine, "FolderName", 1) then
y = 1
end if
if instr(1, arrLine, "ScannedImages", 1) then
z=1
end if
Loop
if x <> 1 and y <> 1 and z <> 1 then
objOutput.WriteLine "[MODULE 1.3]"
objOutput.WriteLine "FolderName=Root,PrintResults, FileTransfer, VolumeControl , RestrictedOperators, ScannedImages"
end if
Set objOutput = Nothing
Set objStream = Nothing
Set objfileini = Nothing
Set FSO = Nothing
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objFileCopy = FSO.GetFile("settings.ini")
FSO.DeleteFile "settings.ini"
Set objFileCopy = FSO.GetFile("settings.new")
FSO.CopyFile "settings.new", "settings.ini"
FSO.DeleteFile "settings.bak"
FSO.DeleteFile "settings.new"
----------

So, to the best of my understanding, this code should check for and insert the section (if it doesn't already exist). However, I'm stuck on what code I need to add in order to append the new value (if it doesn't already exist). Any help would be appreciated. Thank you.
0 Comments   [ + ] Show Comments

Comments

Please log in to comment

Rating comments in this legacy AppDeploy message board thread won't reorder them,
so that the conversation will remain readable.

Answers

0
Here's a sample script I have had for ages which includes an INI class and a short example showing how to add a section It's pretty straightforward to use and is much cleaner than looping line-by-line. Plus, being a class, it's portable between scripts.Option Explicit

Dim blnReturn
Dim strSource
Dim strTarget
Dim strFileName
Dim strFilePath
Dim strFile

Dim objWSHShell
Dim objFSO
Dim strMsg
Dim objMSIRecord
Dim blnIsError
Dim blnIsDeferred

Const intLogEventSuccess = 0
Const intLogEventError = 1
Const intLogEventWarning = 2
Const intLogEventInformation = 4
Const intLogEventAuditSuccess = 8
Const intLogEventAuditFailure = 16

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

strTarget = objWSHShell.ExpandEnvironmentStrings("%USERPROFILE%")

strFileName = "DB2CLI.INI"

Call Main

Sub Main
Dim objINIFile
Dim intReturn

Const strSection = "[GBLVDB2P]"
Const strKey = "DBALIAS"
Const strValue = "GBLVDB2P"

With objFSO
If Not .FolderExists(strTarget) Then
blnIsError = True
strMsg = "The target folder '" & strSource & "' does not exist. Cannot proceed."
Call Say(strMsg, blnIsError)
Exit Sub
End If

strFile = strTarget & "\" & strFileName
If Not .FileExists(strFile) Then
blnIsError = True
strMsg = "The target file '" & strFile & "' does not exist. Cannot proceed."
Call Say(strMsg, blnIsError)
Exit Sub
End If
End With

Set objINIFile = New clsINI
blnReturn = objINIFile.OpenINIFile(strFile)
If Not blnReturn Then
blnIsError = True
strMsg = "Unable to open '" & strFile & "' for processing. Cannot proceed."
Call Say(strMsg, blnIsError)
Exit Sub
End If

intReturn = objINIFile.WriteINISection(strSection)
Select Case intReturn
Case 0 '// Success, do nothing
Case 1 '// No such key (irrelevant here, since we're creating it...)
Case 2 '// No such section (again, irrelevant here)
Case 3 '// No INI open
blnIsError = True
strMsg = "'" & strFile & "' is not open for processing. Cannot proceed."
Call Say(strMsg, blnIsError)
Exit Sub

Case 4 '// Unexpected error
blnIsError = True
strMsg = "An unexpected error occured while processing '" & strFile & "'. Cannot proceed."
Call Say(strMsg, blnIsError)
Exit Sub
End Select

intReturn = objINIFile.WriteINIValue(strSection, strKey, strValue)
Select Case intReturn
Case 0 '// Success, do nothing
Case 1 '// No such key (irrelevant here, since we're creating it...)
Case 2 '// No such section (again, irrelevant here)
Case 3 '// No INI open
blnIsError = True
strMsg = "'" & strFile & "' is not open for processing. Cannot proceed."
Call Say(strMsg, blnIsError)
Exit Sub

Case 4 '// Unexpected error
blnIsError = True
strMsg = "An unexpected error occured while processing '" & strFile & "'. Cannot proceed."
Call Say(strMsg, blnIsError)
Exit Sub
End Select

Call objINIFile.CloseINIFile()
End Sub

Sub Say(ByVal strMsgText, ByVal blnError)
Dim intEventLogMsgType

If blnError Then
intEventLogMsgType = intLogEventError
Else
intEventLogMsgType = intLogEventSuccess
End If

'// Make an entry in Event Log
objWSHShell.LogEvent intEventLogMsgType, strMsg

WScript.Echo strMsgText
End Sub

Sub Sleep(ByVal intSleepPeriod)
'// Timer returns the number of seconds that have elapsed since midnight.

Dim intStartTime
Dim intEndTime
Dim intCurrentTime

On Error Resume Next

intStartTime = Timer
intEndTime = intStartTime + intSleepPeriod

Do While Timer <= intEndTime
Loop

On Error Goto 0

End Sub

'// To work with an INI file, first 'open' it.
'// The OpenINIFile Function reads the INI file into a dictionary object.
'// The class is then ready for operations. The file itself is not open but as long as
'// OpenINIFile has been successfully called the class will hold the file in memory as a
'// dictionary object and any number of operations can be performed.
'//
'// blnResult = OpenINIFile(FilePath) Returns Boolean True if file opened successfully
'//
'// Call CloseINIFile() Sub to close INI file after use.
'// This sets the dictionary to Nothing.
'// The INI file itself isn't actually open
'// so CloseINIFile isn't strictly required.
'// If another file is opened the dictionary will be set to Nothing
'// before proceeding. If the Class is Set to Nothing the dictionary
'// will also be cleared.
'//
'// NOTE ABOUT ERROR CODES
'// The error codes are designed to relate to the same thing regardless of the function.
'// 0 Success
'// 1 The key does not exist, regardless of whether you're trying to read from or delete the key.
'// 2 Relates to the section.
'// For functions that require a section, it means the section does not exist.
'// When trying to write a new section it means the section already exists.
'// 3 No file has been 'opened'
'// 4 Any other error condition, indicating that there was an unexpected problem.
'//
'//
'// ____________________ START INI Class HERE ________________________________________

Class clsINI

Private objFSO_INI
Private objINFile
Private objINIDictionary
Private strINIFile
Private strSeparator

Private Sub Class_Initialize()
Set objFSO_INI = CreateObject("Scripting.FileSystemObject")
strSeparator = Chr(149)
End Sub

Private Sub Class_Terminate()
Set objFSO_INI = Nothing
Set objINIDictionary = Nothing
End Sub

'// Function to Read INI file into objINIDictionary
Public Function OpenINIFile(ByVal strINI)
Dim objLine
Dim strSection
Dim strList

strINIFile = strINI

If objFSO_INI.FileExists(strINIFile) = False Then
OpenINIFile = False
Exit Function
End If

'// Reset objINIDictionary in case an earlier file wasn't closed with CloseINIFile
Set objINIDictionary = Nothing


'// Read INI file into dictionary object. Each section will be a key.
'// Section key/value pairs will be added as objINIDictionary.Key item
'// After the file is read there will be one objINIDictionary.Key for each section header.
'// Each key item will be a string of key/value pairs separated by strSeparator characters.

Set objINIDictionary = CreateObject("Scripting.Dictionary")
objINIDictionary.Add "Glo_bal", strSeparator

On Error Resume Next
Set objINFile = objFSO_INI.OpenTextFile(strINIFile, 1)

Do While objINFile.AtEndOfStream = False
objLine = objINFile.ReadLine
objLine = Trim(objLine)
If Len(objLine) > 0 Then
If Left(objLine, 1) = "[" Then
strSection = objLine
objINIDictionary.Add strSection, strSeparator
ElseIf objINIDictionary.Exists(strSection) Then
strList = objINIDictionary.Item(strSection)
strList = strList & objLine & strSeparator
objINIDictionary.Item(strSection) = strList
Else '// global comment at top. If no objINIDictionary.Key strSection exists Then no sections have been read yet.
strList = objINIDictionary.Item("Glo_bal")
strList = strList & objLine & strSeparator
objINIDictionary.Item("Glo_bal") = strList
End If
End If
Loop

objINFile.Close
Set objINFile = Nothing
OpenINIFile = True
End Function

'// Close an open INI file. The file is not actually open but it's closed
'// for the purposes of this class by setting objINIDictionary = Nothing.

Public Sub CloseINIFile()
Set objINIDictionary = Nothing
End Sub

'// =========================================================================================================
'// Name: GetSectionNames
'// Purpose: Retrieves section names
'// Example: blnResult = Cls.GetSectionNames()
'// Input: None
'// Output: UBound of array is 0 and array(0) is "" no file open, or no sections in file
'// Array populated file section names returned in the array
'// Returns: True/False
'// =========================================================================================================
Public Function GetSectionNames()
Dim arrSection
Dim intIndex
Dim strTemp
Dim strSection

If IsObject(objINIDictionary) = False Then
arrSection = Array("")
GetSectionNames = arrSection '// No file open
Exit Function
End If

If objINIDictionary.Count = 0 Then
arrSection = Array("")
GetSectionNames = arrSection '// No keys
Exit Function
End If

On Error Resume Next
arrSection = objINIDictionary.Keys
For intIndex = 0 to UBound(arrSection)
strTemp = arrSection(intIndex)
If (strTemp <> "Glo_bal") Then
strTemp = Mid(strTemp, 2, (len(strTemp) - 2))
strSection = strSection & (strTemp & strSeparator)
End If
Next

GetSectionNames = Split(strSection, strSeparator)
End Function

'// =========================================================================================================
'// Name: GetINIValue(Section, Key, Value)
'// Purpose: Retrieves value from a key
'// Input: Section The section name containing the key
'// Key The key name
'//
'// Output: Value A ByRef variable to store the value
'// Returns: 0 Data returned
'// 1 No such key
'// 2 No such section
'// 3 Unexpected error in text of file
'// =========================================================================================================
Public Function GetINIValue(ByVal strSection, ByVal strKey, ByRef strValue)
Dim strSectionLine
Dim intPos1
Dim intPos2
Dim strItem
Dim intLenStrItem

Select Case CheckBasics(strSection)
Case 3
GetINIValue = 3 '// No file open
Exit Function
Case 2
GetINIValue = 2 '// No such section
Exit Function
End Select

strValue = ""
strSectionLine = objINIDictionary.Item(strSection)
strItem = strSeparator & strKey & "="
intLenStrItem = Len(strItem)

intPos1 = InStr(1, strSectionLine, strItem, 1)
If intPos1 = 0 Then
strValue = ""
GetINIValue = 1 '// No such key
Exit Function
End If

intPos2 = InStr((intPos1 + intLenStrItem), strSectionLine, strSeparator, 1)
If intPos2 = 0 Then
GetINIValue = 4 '// Unexpected error
ElseIf intPos2 = (intPos1 + 1) Then '// Key exists but value is ""
GetINIValue = 0
Else
strValue = Mid(strSectionLine, (intPos1 + intLenStrItem), (intPos2 - (intPos1 + intLenStrItem)))
GetINIValue = 0
End If
End Function

'// =========================================================================================================
'// Name: GetSectionValues(strSection, arrArray)
'// Purpose: Retrieves key/value pairs from a section
'// Input: strSection The section name
'// Output: arrArray A ByRef array of key/value pairs
'// Returns: 0 Data returned
'// 1 No such key
'// 2 No such section
'// 3 No file open
'// 4 Unexpected error in text of file
'// =========================================================================================================
Public Function GetSectionValues(Byval strSection, ByRef arrValues)
Dim arrItem
Dim arrNewItem()
Dim intIndex
Dim intNewIndex

Select Case CheckBasics(strSection)
Case 3
GetSectionValues = 3 '// No file open
Exit Function
Case 2
GetSectionValues = 2 '// No such section
Exit Function
End Select

arrItem = Split(objINIDictionary.Item(strSection), strSeparator)

'// Go through arrItem, weeding out comments.
'// Any non-comment can be added to arrNewItem
intNewIndex = 0

For intIndex = 0 to UBound(arrItem)
If Left(arrItem(intIndex), 1) <> ";" Then
ReDim Preserve arrNewItem(intNewIndex)
arrNewItem(intNewIndex) = arrItem(intIndex)
intNewIndex = (intNewIndex + 1)
End If
Next

arrValues = arrNewItem

GetSectionValues = 0
End Function

'// =========================================================================================================
'// Name: WriteINIValue(Section, Key, Value)
'// Purpose: Writes a value to a key.
'// 'Section' and 'Key' will be written if necessary
'// Input: Section The section name
'// Key The key name
'// Value The data to write into the key
'// Output: None
'// Returns: 0 Success
'// 1 No such key
'// 2 No such section
'// 3 No file open
'// 4 Unexpected error in text of file
'// =========================================================================================================
Public Function WriteINIValue(ByVal strSection, ByVal strKey, ByVal strValue)
Dim strSectionLine
Dim intPos1
Dim intPos2
Dim strItem
Dim intLenStrItem

Select Case CheckBasics(strSection)
Case 3
WriteINIValue = 3 '// No file open
Exit Function
Case 2
'// If section does not exist, write section and key=value, then quit:
strSectionLine = strSeparator & strKey & "=" & strValue & strSeparator
objINIDictionary.Add strSection, strSectionLine
Call WriteNewINI
WriteINIValue = 0
Exit Function
End Select

'// Section exists, get section values
strSectionLine = objINIDictionary.Item(strSection)
strItem = strSeparator & strKey & "="
intLenStrItem = Len(strItem)
intPos1 = InStr(1, strSectionLine, strItem, 1)

'// If strKey doesn't already exist, write it and quit
If intPos1 = 0 Then
strSectionLine = strSectionLine & strKey & "=" & strValue & strSeparator
objINIDictionary.Item(strSection) = strSectionLine
Call WriteNewINI
WriteINIValue = 0
Else
'// strKey exists. Snip out existing value from strSectionLine
'// and rebuild string, adding new value
intPos2 = InStr((intPos1 + intLenStrItem), strSectionLine, strSeparator)
If intPos2 <> 0 Then
If (intPos2 + 1) < Len(strSectionLine) Then '// If Not last value in section, Get left up to "=" & value & right from bullet:
strSectionLine = (Left(strSectionLine, ((intPos1 + intLenStrItem) - 1))) & strValue & (Right(strSectionLine, (Len(strSectionLine) - (intPos2 - 1))))
Else '// Last value in section
strSectionLine = (Left(strSectionLine, ((intPos1 + intLenStrItem) - 1))) & strValue & strSeparator
End If

objINIDictionary.Item(strSection) = strSectionLine
Call WriteNewINI
WriteINIValue = 0
Else
WriteINIValue = 4 '// Unexpected error
Exit Function
End If
End If
End Function

'// =========================================================================================================
'// Name: DeleteINIValue(Section, Key)
'// Purpose: Deletes a value from a key.
'// Input: Section The section name
'// Key The key name
'// Value The data to write into the key
'// Output: None
'// Returns: 0 Success
'// 1 No such key
'// 2 No such section
'// 3 No file open
'// 4 Unexpected error in text of file
'// For this Function success would be if the return value < 3
'// =========================================================================================================
Public Function DeleteINIValue(ByVal strSection, ByVal strKey)
Dim strSectionLine
Dim intPos1
Dim intPos2
Dim strItem

Select Case CheckBasics(strSection)
Case 3
DeleteINIValue = 3 '// No file open
Exit Function
Case 2
DeleteINIValue = 2 '// No such section
Exit Function
End Select

strSectionLine = objINIDictionary.Item(strSection)
strItem = strSeparator & strKey & "="
intPos1 = InStr(1, strSectionLine, strItem, 1)
If intPos1 = 0 Then
DeleteINIValue = 1 '// No such key
Exit Function
End If

intPos2 = InStr((intPos1 + 1), strSectionLine, strSeparator, 1)
If intPos2 = 0 Then
DeleteINIValue = 4 '// Unexpected error
Exit Function
Else
strSectionLine = (Left(strSectionLine, (intPos1))) & (Right(strSectionLine, (Len(strSectionLine) - intPos2)))
objINIDictionary.Item(strSection) = strSectionLine
Call WriteNewINI
DeleteINIValue = 0
End If
End Function

'// =========================================================================================================
'// Name: WriteINISection(Section)
'// Purpose: Write a new section
'// Input: Section The section name
'// Output: None
'// Returns: 0 Success
'// 1 No such key
'// 2 Section already exists
'// 3 No file open
'// 4 Unexpected error in text of file
'// For this Function success would be if the return value < 3
'// =========================================================================================================
Public Function WriteINISection(ByVal strSection)
Select Case CheckBasics(strSection)
Case 3
WriteINISection = 3 '// No file open
Case 2
objINIDictionary.Add strSection, strSeparator
Call WriteNewINI
WriteINISection = 0
Case Else
WriteINISection = 2 '// Section already exists
End Select
End Function

'// =========================================================================================================
'// Name: DeleteINISection(ByVal strSection)
'// Purpose: Delete a section
'// Input: strSection The section name
'// Output: None
'// Returns: 0 Success
'// 1 No such key
'// 2 No such section
'// 3 No file open
'// 4 Unexpected error in text of file
'// For this Function success would be if the return value < 3
'// =========================================================================================================
Public Function DeleteINISection(ByVal strSection)

Select Case CheckBasics(strSection)
Case 3
DeleteINISection = 3 '// No file open
Case 2
DeleteINISection = 2 '// No such section
Case Else
objINIDictionary.Remove strSection
Call WriteNewINI
DeleteINISection = 0
End Select

End Function

'// An internally-called Sub to update INI file after writing new value or adding section.
'// It won't be called unless a file is "open", in which case the file path is valid
'// and objINIDictionary is not Nothing, so just set attributes to 0 and write the new INI file.
'// NB:
'// This has not been tested with system INIs under Windows versions which have system file protection!
Private Sub WriteNewINI()
Dim objFileAttributes
Dim objFile
Dim arrKeys
Dim intIndex
Dim strLine
Dim strItem
Dim strItem2
Dim strGlobal

On Error Resume Next
'// Remove attributes such as read-only and save current attributes
Set objFile = objFSO_INI.GetFile(strINIFile)
objFileAttributes = objFile.Attributes
objFile.Attributes = 0
Set objFile = Nothing

arrKeys = objINIDictionary.Keys
For intIndex = 0 to UBound(arrKeys)
strItem = arrKeys(intIndex)
If strItem = "Glo_bal" Then
strGlobal = objINIDictionary.Item(strItem)
strGlobal = Replace(strGlobal, strSeparator, vbCRLF)
strGlobal = strGlobal & vbCRLF
Else
strItem2 = objINIDictionary.Item(strItem)
strItem2 = Replace(strItem2, strSeparator, vbCRLF)
strLine = strLine & strItem & strItem2 & vbCRLF
End If
Next

strLine = strGlobal & strLine '// Add in global comments section

objFSO_INI.DeleteFile strINIFile, True

Set objINFile = objFSO_INI.CreateTextFile(strINIFile)
objINFile.Write strLine
objINFile.Close
Set objINFile = Nothing

Set objFile = objFSO_INI.GetFile(strINIFile)
objFile.Attributes = objFileAttributes
Set objFile = Nothing

End Sub

'// An internally-called function to check for objINIDictionary instantiation and section existence.
'// It also does the work of putting [ ] around the section name sent in.
'// It's here to save a few lines, so that other functions don't have to be re-written
'// for each method in the class
Private Function CheckBasics(strSection)
If IsObject(objINIDictionary) = False Then
CheckBasics = 3 '// No file open
Exit Function
End If

If (Left(strSection, 1) <> "[") Then
strSection = "[" & strSection
End If

If (Right(strSection, 1) <> "]") Then
strSection = strSection & "]"
End If

If objINIDictionary.Exists(strSection) = False Then
CheckBasics = 2
Else
CheckBasics = 0
End If
End Function

End Class
Answered 03/03/2011 by: VBScab
Red Belt

Please log in to comment
0
Wow. That's a lot of code there. Can you detail the functionality a bit? Thanx.
Answered 03/03/2011 by: stmasi
Senior Yellow Belt

Please log in to comment
0
Nevermind...figured it out. However, I need to be able to check to see if these values exist first...

[strSection]
strKey=strValue

And, if they do, simply append a comma and a new strValue to the end of that existing line.

Thanx again.
Answered 03/03/2011 by: stmasi
Senior Yellow Belt

Please log in to comment
0
Okay, the script adds the data successfully...

[MODULE 1.3]
FolderName=Root,PrintResults, FileTransfer, VolumeControl , RestrictedOperators

However, whenever I want to append a value to the existing string of values for the "FolderName" key, it simply rewrites the existing values without appending my new value on to the end of the list. I just can't figure out how to modify the existing code in order to force the append of the new value onto the existing line. So, when it sees the above data, it should rewrite it like this (note the newly-appended value)...

[MODULE 1.3]
FolderName=Root,PrintResults, FileTransfer, VolumeControl , RestrictedOperators, NewlyAppendedValue

So, if that "NewlyAppendedValue" already exists, it should do nothing, but if the "NewlyAppendedValue" doesn't exist, it should add a comma to the existing list of values, then append the "NewlyAppendedValue" value. Thanx.
Answered 03/03/2011 by: stmasi
Senior Yellow Belt

Please log in to comment
0
I would use Split to separate out the various strings into separate array elements, then loop through the array looking for the text you want. Use Trim to remove extraneous white space before string-matching. I'd also use LCase or UCase on both sides of the string-matching, as "Fred" doesn't equal "FRED".
Answered 03/04/2011 by: VBScab
Red Belt

Please log in to comment
0
Would you happen to have any time at all to assist with another snippet of code? We had an employee leave and his duties have conveniently fallen in my lap. Unfortunately, I'm just not familiar enough with scripting to figure this darn thing out. Thanx.
Answered 03/04/2011 by: stmasi
Senior Yellow Belt

Please log in to comment
0
Anyone available to assist?

Thanx in advance.
Answered 03/08/2011 by: stmasi
Senior Yellow Belt

Please log in to comment
1
I'm too nice...Option Explicit

Dim blnReturn
Dim strFileName
Dim strFilePath
Dim strFile
Dim objWSHShell
Dim objFSO
Dim strMsg
Dim objMSIRecord
Dim blnIsError
Dim blnIsDeferred

Const intLogEventSuccess = 0
Const intLogEventError = 1
Const intLogEventWarning = 2
Const intLogEventInformation = 4
Const intLogEventAuditSuccess = 8
Const intLogEventAuditFailure = 16

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

strFileName = "TEST_CLASS.INI"
strFilePath = "D:\BIN"

Call Main

Sub Main
Dim objINIFile
Dim intReturn
Dim strSection
Dim strKey
Dim strValue
Dim arrValue
Dim intIndex_Value
Dim strItemToSearchFor
Dim strItem
Dim blnItemsMatch

strSection = "[MODULE 1.3]"
strKey = "FolderName"
strItemToSearchFor = "NewlyAppendedValue"

With objFSO
If Not .FolderExists(strFilePath) Then
blnIsError = True
strMsg = "The target folder '" & strSource & "' does not exist. Cannot proceed."
Call Say(strMsg, blnIsError)
Exit Sub
End If

strFile = strFilePath & "\" & strFileName
If Not .FileExists(strFile) Then
blnIsError = True
strMsg = "The target file '" & strFile & "' does not exist. Cannot proceed."
Call Say(strMsg, blnIsError)
Exit Sub
End If
End With

Set objINIFile = New clsINI
blnReturn = objINIFile.OpenINIFile(strFile)
If Not blnReturn Then
blnIsError = True
strMsg = "Unable to open '" & strFile & "' for processing. Cannot proceed."
Call Say(strMsg, blnIsError)
Exit Sub
End If

intReturn = objINIFile.GetINIValue(strSection, strKey, strValue)
Select Case intReturn
Case 0 '// Success, do nothing
Case 1 '// No such key (irrelevant here, since we're creating it...)
Case 2 '// No such section (again, irrelevant here)
Case 3 '// No INI open
blnIsError = True
strMsg = "'" & strFile & "' is not open for processing. Cannot proceed."
Call Say(strMsg, blnIsError)
Exit Sub

Case 4 '// Unexpected error
blnIsError = True
strMsg = "An unexpected error occured while processing '" & strFile & "'. Cannot proceed."
Call Say(strMsg, blnIsError)
Exit Sub
End Select

If InStr(strValue, ",") > 0 Then
'// If there's a comma in the value returned, there's more than one item
arrValue = Split(strValue, ",") '// Split creates an array from a list of items separated by a character, in this case a comma
Else
ReDim arrValue(0)

arrValue(0) = strValue
End If

For intIndex_Value = 0 To UBound(arrValue) '// Loop through the array
strItem = Trim(arrValue(intIndex_Value))'// Get the item from the array and assign its content to strItem.
'// The Trim function removes whitespace from around the string
blnReturn = StringMatch(strItem, strItemToSearchFor, blnItemsMatch)
Next

If blnItemsMatch Then
'// Do nothing
Else
'// Add the new item
If Right(strValue, 1) <> "," Then
strValue = strValue & "," & strItemToSearchFor
Else
strValue = strValue & strItemToSearchFor
End If

intReturn = objINIFile.WriteINIValue(strSection, strKey, strValue)
Select Case intReturn
Case 0 '// Success, do nothing
Case 1 '// No such key (irrelevant here, since we're creating it...)
Case 2 '// No such section (again, irrelevant here)
Case 3 '// No INI open
blnIsError = True
strMsg = "'" & strFile & "' is not open for processing. Cannot proceed."
Call Say(strMsg, blnIsError)
Exit Sub

Case 4 '// Unexpected error
blnIsError = True
strMsg = "An unexpected error occured while processing '" & strFile & "'. Cannot proceed."
Call Say(strMsg, blnIsError)
Exit Sub
End Select
End If

'// Do this last because the dictionary object gets cleared by the function
Call objINIFile.CloseINIFile()

End Sub

Sub Say(ByVal strMsgText, ByVal blnError)
Dim intEventLogMsgType

If blnError Then
intEventLogMsgType = intLogEventError
Else
intEventLogMsgType = intLogEventSuccess
End If

'// Make an entry in Event Log
objWSHShell.LogEvent intEventLogMsgType, strMsg

WScript.Echo strMsgText
End Sub

Sub Sleep(ByVal intSleepPeriod)
'// Timer returns the number of seconds that have elapsed since midnight.

Dim intStartTime
Dim intEndTime
Dim intCurrentTime

On Error Resume Next

intStartTime = Timer
intEndTime = intStartTime + intSleepPeriod

Do While Timer <= intEndTime
Loop

On Error Goto 0

End Sub

'//=========================================================================================================
'// Name: StringMatch
'// Purpose: Checks if two strings match
'// Why not use 'If strFirst = strSecond', you're asking?
'// Well, the 'Equals' operator :
'// - is not very fast (at string comparison)!
'// - compares strings left to right and is smart enough to stop comparing when it spots the first difference, but
'// - is too dumb to first do the most obvious test: comparing the lengths of the strings!
'// Input: strFirst - the first string
'// strSecond - the second string
'// blnMatch - a Boolean indicating whether or not the strings matched
'// Output: None
'// Returns: True/False
'//
'//=========================================================================================================
Function StringMatch(ByVal strFirst, ByVal strSecond, ByRef blnMatch)

StringMatch = True

blnMatch = False

If LenB(strFirst) = LenB(strSecond) Then
blnMatch = (InStrB(1, strFirst, strSecond, vbBinaryCompare) <> 0)
End If

End Function


'// To work with an INI file, first 'open' it.
'// The OpenINIFile Function reads the INI file into a dictionary object.
'// The class is then ready for operations. The file itself is not open but as long as
'// OpenINIFile has been successfully called the class will hold the file in memory as a
'// dictionary object and any number of operations can be performed.
'//
'// blnResult = OpenINIFile(FilePath) Returns Boolean True if file opened successfully
'//
'// Call CloseINIFile() Sub to close INI file after use.
'// This sets the dictionary to Nothing.
'// The INI file itself isn't actually open
'// so CloseINIFile isn't strictly required.
'// If another file is opened the dictionary will be set to Nothing
'// before proceeding. If the Class is Set to Nothing the dictionary
'// will also be cleared.
'//
'// NOTE ABOUT ERROR CODES
'// The error codes are designed to relate to the same thing regardless of the function.
'// 0 Success
'// 1 The key does not exist, regardless of whether you're trying to read from or delete the key.
'// 2 Relates to the section.
'// For functions that require a section, it means the section does not exist.
'// When trying to write a new section it means the section already exists.
'// 3 No file has been 'opened'
'// 4 Any other error condition, indicating that there was an unexpected problem.
'//
'//
'// ____________________ START INI Class HERE ________________________________________

Class clsINI

Private objFSO_INI
Private objINFile
Private objINIDictionary
Private strINIFile
Private strSeparator

Private Sub Class_Initialize()
Set objFSO_INI = CreateObject("Scripting.FileSystemObject")
strSeparator = Chr(149)
End Sub

Private Sub Class_Terminate()
Set objFSO_INI = Nothing
Set objINIDictionary = Nothing
End Sub

'// Function to Read INI file into objINIDictionary
Public Function OpenINIFile(ByVal strINI)
Dim objLine
Dim strSection
Dim strList

strINIFile = strINI

If objFSO_INI.FileExists(strINIFile) = False Then
OpenINIFile = False
Exit Function
End If

'// Reset objINIDictionary in case an earlier file wasn't closed with CloseINIFile
Set objINIDictionary = Nothing


'// Read INI file into dictionary object. Each section will be a key.
'// Section key/value pairs will be added as objINIDictionary.Key item
'// After the file is read there will be one objINIDictionary.Key for each section header.
'// Each key item will be a string of key/value pairs separated by strSeparator characters.

Set objINIDictionary = CreateObject("Scripting.Dictionary")
objINIDictionary.Add "Glo_bal", strSeparator

On Error Resume Next
Set objINFile = objFSO_INI.OpenTextFile(strINIFile, 1)

Do While objINFile.AtEndOfStream = False
objLine = objINFile.ReadLine
objLine = Trim(objLine)
If Len(objLine) > 0 Then
If Left(objLine, 1) = "[" Then
strSection = objLine
objINIDictionary.Add strSection, strSeparator
ElseIf objINIDictionary.Exists(strSection) Then
strList = objINIDictionary.Item(strSection)
strList = strList & objLine & strSeparator
objINIDictionary.Item(strSection) = strList
Else '// global comment at top. If no objINIDictionary.Key strSection exists Then no sections have been read yet.
strList = objINIDictionary.Item("Glo_bal")
strList = strList & objLine & strSeparator
objINIDictionary.Item("Glo_bal") = strList
End If
End If
Loop

objINFile.Close
Set objINFile = Nothing
OpenINIFile = True
End Function

'// Close an open INI file. The file is not actually open but it's closed
'// for the purposes of this class by setting objINIDictionary = Nothing.

Public Sub CloseINIFile()
Set objINIDictionary = Nothing
End Sub

'// =========================================================================================================
'// Name: GetSectionNames
'// Purpose: Retrieves section names
'// Example: blnResult = Cls.GetSectionNames()
'// Input: None
'// Output: UBound of array is 0 and array(0) is "" no file open, or no sections in file
'// Array populated file section names returned in the array
'// Returns: True/False
'// =========================================================================================================
Public Function GetSectionNames()
Dim arrSection
Dim intIndex
Dim strTemp
Dim strSection

If IsObject(objINIDictionary) = False Then
arrSection = Array("")
GetSectionNames = arrSection '// No file open
Exit Function
End If

If objINIDictionary.Count = 0 Then
arrSection = Array("")
GetSectionNames = arrSection '// No keys
Exit Function
End If

On Error Resume Next
arrSection = objINIDictionary.Keys
For intIndex = 0 to UBound(arrSection)
strTemp = arrSection(intIndex)
If (strTemp <> "Glo_bal") Then
strTemp = Mid(strTemp, 2, (len(strTemp) - 2))
strSection = strSection & (strTemp & strSeparator)
End If
Next

GetSectionNames = Split(strSection, strSeparator)
End Function

'// =========================================================================================================
'// Name: GetINIValue(Section, Key, Value)
'// Purpose: Retrieves value from a key
'// Input: Section The section name containing the key
'// Key The key name
'//
'// Output: Value A ByRef variable to store the value
'// Returns: 0 Data returned
'// 1 No such key
'// 2 No such section
'// 3 Unexpected error in text of file
'// =========================================================================================================
Public Function GetINIValue(ByVal strSection, ByVal strKey, ByRef strValue)
Dim strSectionLine
Dim intPos1
Dim intPos2
Dim strItem
Dim intLenStrItem

Select Case CheckBasics(strSection)
Case 3
GetINIValue = 3 '// No file open
Exit Function
Case 2
GetINIValue = 2 '// No such section
Exit Function
End Select

strValue = ""
strSectionLine = objINIDictionary.Item(strSection)
strItem = strSeparator & strKey & "="
intLenStrItem = Len(strItem)

intPos1 = InStr(1, strSectionLine, strItem, 1)
If intPos1 = 0 Then
strValue = ""
GetINIValue = 1 '// No such key
Exit Function
End If

intPos2 = InStr((intPos1 + intLenStrItem), strSectionLine, strSeparator, 1)
If intPos2 = 0 Then
GetINIValue = 4 '// Unexpected error
ElseIf intPos2 = (intPos1 + 1) Then '// Key exists but value is ""
GetINIValue = 0
Else
strValue = Mid(strSectionLine, (intPos1 + intLenStrItem), (intPos2 - (intPos1 + intLenStrItem)))
GetINIValue = 0
End If
End Function

'// =========================================================================================================
'// Name: GetSectionValues(strSection, arrArray)
'// Purpose: Retrieves key/value pairs from a section
'// Input: strSection The section name
'// Output: arrArray A ByRef array of key/value pairs
'// Returns: 0 Data returned
'// 1 No such key
'// 2 No such section
'// 3 No file open
'// 4 Unexpected error in text of file
'// =========================================================================================================
Public Function GetSectionValues(Byval strSection, ByRef arrValues)
Dim arrItem
Dim arrNewItem()
Dim intIndex
Dim intNewIndex

Select Case CheckBasics(strSection)
Case 3
GetSectionValues = 3 '// No file open
Exit Function
Case 2
GetSectionValues = 2 '// No such section
Exit Function
End Select

arrItem = Split(objINIDictionary.Item(strSection), strSeparator)

'// Go through arrItem, weeding out comments.
'// Any non-comment can be added to arrNewItem
intNewIndex = 0

For intIndex = 0 to UBound(arrItem)
If Left(arrItem(intIndex), 1) <> ";" Then
ReDim Preserve arrNewItem(intNewIndex)
arrNewItem(intNewIndex) = arrItem(intIndex)
intNewIndex = (intNewIndex + 1)
End If
Next

arrValues = arrNewItem

GetSectionValues = 0
End Function

'// =========================================================================================================
'// Name: WriteINIValue(Section, Key, Value)
'// Purpose: Writes a value to a key.
'// 'Section' and 'Key' will be written if necessary
'// Input: Section The section name
'// Key The key name
'// Value The data to write into the key
'// Output: None
'// Returns: 0 Success
'// 1 No such key
'// 2 No such section
'// 3 No file open
'// 4 Unexpected error in text of file
'// =========================================================================================================
Public Function WriteINIValue(ByVal strSection, ByVal strKey, ByVal strValue)
Dim strSectionLine
Dim intPos1
Dim intPos2
Dim strItem
Dim intLenStrItem

Select Case CheckBasics(strSection)
Case 3
WriteINIValue = 3 '// No file open
Exit Function
Case 2
'// If section does not exist, write section and key=value, then quit:
strSectionLine = strSeparator & strKey & "=" & strValue & strSeparator
objINIDictionary.Add strSection, strSectionLine
Call WriteNewINI
WriteINIValue = 0
Exit Function
End Select

'// Section exists, get section values
strSectionLine = objINIDictionary.Item(strSection)
strItem = strSeparator & strKey & "="
intLenStrItem = Len(strItem)
intPos1 = InStr(1, strSectionLine, strItem, 1)

'// If strKey doesn't already exist, write it and quit
If intPos1 = 0 Then
strSectionLine = strSectionLine & strKey & "=" & strValue & strSeparator
objINIDictionary.Item(strSection) = strSectionLine
Call WriteNewINI
WriteINIValue = 0
Else
'// strKey exists. Snip out existing value from strSectionLine
'// and rebuild string, adding new value
intPos2 = InStr((intPos1 + intLenStrItem), strSectionLine, strSeparator)
If intPos2 <> 0 Then
If (intPos2 + 1) < Len(strSectionLine) Then '// If Not last value in section, Get left up to "=" & value & right from bullet:
strSectionLine = (Left(strSectionLine, ((intPos1 + intLenStrItem) - 1))) & strValue & (Right(strSectionLine, (Len(strSectionLine) - (intPos2 - 1))))
Else '// Last value in section
strSectionLine = (Left(strSectionLine, ((intPos1 + intLenStrItem) - 1))) & strValue & strSeparator
End If

objINIDictionary.Item(strSection) = strSectionLine
Call WriteNewINI
WriteINIValue = 0
Else
WriteINIValue = 4 '// Unexpected error
Exit Function
End If
End If
End Function

'// =========================================================================================================
'// Name: DeleteINIValue(Section, Key)
'// Purpose: Deletes a value from a key.
'// Input: Section The section name
'// Key The key name
'// Value The data to write into the key
'// Output: None
'// Returns: 0 Success
'// 1 No such key
'// 2 No such section
'// 3 No file open
'// 4 Unexpected error in text of file
'// For this Function success would be if the return value < 3
'// =========================================================================================================
Public Function DeleteINIValue(ByVal strSection, ByVal strKey)
Dim strSectionLine
Dim intPos1
Dim intPos2
Dim strItem

Select Case CheckBasics(strSection)
Case 3
DeleteINIValue = 3 '// No file open
Exit Function
Case 2
DeleteINIValue = 2 '// No such section
Exit Function
End Select

strSectionLine = objINIDictionary.Item(strSection)
strItem = strSeparator & strKey & "="
intPos1 = InStr(1, strSectionLine, strItem, 1)
If intPos1 = 0 Then
DeleteINIValue = 1 '// No such key
Exit Function
End If

intPos2 = InStr((intPos1 + 1), strSectionLine, strSeparator, 1)
If intPos2 = 0 Then
DeleteINIValue = 4 '// Unexpected error
Exit Function
Else
strSectionLine = (Left(strSectionLine, (intPos1))) & (Right(strSectionLine, (Len(strSectionLine) - intPos2)))
objINIDictionary.Item(strSection) = strSectionLine
Call WriteNewINI
DeleteINIValue = 0
End If
End Function

'// =========================================================================================================
'// Name: WriteINISection(Section)
'// Purpose: Write a new section
'// Input: Section The section name
'// Output: None
'// Returns: 0 Success
'// 1 No such key
'// 2 Section already exists
'// 3 No file open
'// 4 Unexpected error in text of file
'// For this Function success would be if the return value < 3
'// =========================================================================================================
Public Function WriteINISection(ByVal strSection)
Select Case CheckBasics(strSection)
Case 3
WriteINISection = 3 '// No file open
Case 2
objINIDictionary.Add strSection, strSeparator
Call WriteNewINI
WriteINISection = 0
Case Else
WriteINISection = 2 '// Section already exists
End Select
End Function

'// =========================================================================================================
'// Name: DeleteINISection(ByVal strSection)
'// Purpose: Delete a section
'// Input: strSection The section name
'// Output: None
'// Returns: 0 Success
'// 1 No such key
'// 2 No such section
'// 3 No file open
'// 4 Unexpected error in text of file
'// For this Function success would be if the return value < 3
'// =========================================================================================================
Public Function DeleteINISection(ByVal strSection)

Select Case CheckBasics(strSection)
Case 3
DeleteINISection = 3 '// No file open
Case 2
DeleteINISection = 2 '// No such section
Case Else
objINIDictionary.Remove strSection
Call WriteNewINI
DeleteINISection = 0
End Select

End Function

'// An internally-called Sub to update INI file after writing new value or adding section.
'// It won't be called unless a file is "open", in which case the file path is valid
'// and objINIDictionary is not Nothing, so just set attributes to 0 and write the new INI file.
'// NB:
'// This has not been tested with system INIs under Windows versions which have system file protection!
Private Sub WriteNewINI()
Dim objFileAttributes
Dim objFile
Dim arrKeys
Dim intIndex
Dim strLine
Dim strItem
Dim strItem2
Dim strGlobal

On Error Resume Next
'// Remove attributes such as read-only and save current attributes
Set objFile = objFSO_INI.GetFile(strINIFile)
objFileAttributes = objFile.Attributes
objFile.Attributes = 0
Set objFile = Nothing

arrKeys = objINIDictionary.Keys
For intIndex = 0 to UBound(arrKeys)
strItem = arrKeys(intIndex)
If strItem = "Glo_bal" Then
strGlobal = objINIDictionary.Item(strItem)
strGlobal = Replace(strGlobal, strSeparator, vbCRLF)
strGlobal = strGlobal & vbCRLF
Else
strItem2 = objINIDictionary.Item(strItem)
strItem2 = Replace(strItem2, strSeparator, vbCRLF)
strLine = strLine & strItem & strItem2 & vbCRLF
End If
Next

strLine = strGlobal & strLine '// Add in global comments section

objFSO_INI.DeleteFile strINIFile, True

Set objINFile = objFSO_INI.CreateTextFile(strINIFile)
objINFile.Write strLine
objINFile.Close
Set objINFile = Nothing

Set objFile = objFSO_INI.GetFile(strINIFile)
objFile.Attributes = objFileAttributes
Set objFile = Nothing

End Sub

'// An internally-called function to check for objINIDictionary instantiation and section existence.
'// It also does the work of putting [ ] around the section name sent in.
'// It's here to save a few lines, so that other functions don't have to be re-written
'// for each method in the class
Private Function CheckBasics(strSection)
If IsObject(objINIDictionary) = False Then
CheckBasics = 3 '// No file open
Exit Function
End If

If (Left(strSection, 1) <> "[") Then
strSection = "[" & strSection
End If

If (Right(strSection, 1) <> "]") Then
strSection = strSection & "]"
End If

If objINIDictionary.Exists(strSection) = False Then
CheckBasics = 2
Else
CheckBasics = 0
End If
End Function

End Class
Answered 03/09/2011 by: VBScab
Red Belt

Please log in to comment
Answer this question or Comment on this question for clarity