Visual Basic File Routines
WritePrivateProfileString: INI Files - Saving Entire Sections
     
Posted:   Friday August 13, 1999
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6, and VB3, VB4-16 with appropriate declarations
Developed with:   VB6, Windows NT4
OS restrictions:   None
Author:   VBnet - Randy Birch
     

Related:  

WritePrivateProfileString: INI Files - The Basics
     
 Prerequisites
None, but an understanding of INI files through the page WritePrivateProfileString: INI Files - The Basics is advised.

Now that the basics are out of the way, here is a method to save (and restore) the contents of a list box using an INI file. The routines here use and build upon those created in WritePrivateProfileString: INI Files - The Basics.  This takes a simple list and writes its contents to the INI file, creating the familiar numerically-incremented keys as the unique key names. 

The Reset and Clear buttons act only on the list box. Reset populates the list with a few default values to play with. The other four buttons act on the INI file itself - changes made by those buttons are not reflected in the list. The textbox however always shows the up-to-date contents of the INI file.

Once caveat .. the "Delete Selected List Key and Value" button provides a way to delete items from both the list as well as the INI file. This button will work as advertised as long as you have not removed any list items from the list by double clicking. The reason is simple: in this demo the key name for the item to delete is created by combining the default Key Name and the selected item's ListIndex. Should an item have been removed from the list by double clicking, the list items below that now have new list indexes that no longer correspond to the values in the file. So deleting "Orange" which has a list index of 2 will cause "Grape" to become item 2. Subsequently, selecting "Grape" and executing the "Delete Selected List Key and Value" button will remove Colour2 item from the INI file, which is still the Orange item (double clicking the list does not delete an item from the INI file). The double-click remove method is provides simply to allow you to create different combinations of items to test modifying the file using different Section or Key Names.

 BAS Module Code
None.

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function StripNulls(startStrg As String) As String

'take a string separated by nulls,
'split off 1 item, and shorten the string
'so the next item is ready for removal.

'The passed string must have a terminating
'null for this function to work correctly.
'If you remain in a loop, check this first!

   Dim pos As Long
   Dim item As String
   
   pos = InStr(1, startStrg, Chr$(0))
   
   If pos Then

      item = Mid$(startStrg, 1, pos - 1)
      startStrg = Mid$(startStrg, pos + 1, Len(startStrg))
      StripNulls = item
    
   End If

End Function


Public Function ProfileLoadList(lst As ListBox, _
                                lpSectionName As String, _
                                inifile As String) As Long

'This is the main function for loading the listbox data
'from an ini file.  First, it calls GetPrivateProfileString
'to get all key name entries under lpSectionName.  It then loops,
'passing each key name to ppGetItemsInfo(), and the returned
'value is added to the listbox.
        
   Dim success As Long
   Dim c As Long
   Dim nSize As Long
   Dim KeyData As String
   Dim lpKeyName As String
   Dim ret As String
  
  'call the API passing null as the parameter
  'for the lpKeyName parameter. This causes
  'the API to return a list of all keys under
  'that section. Pad the passed string large
  'enough to hold the data.
   ret = Space$(2048)
   nSize = Len(ret)
   success = GetPrivateProfileString(lpSectionName, _
                                     vbNullString, _
                                     "", _
                                     ret, _
                                     nSize, _
                                     inifile)
   
  'The returned string is a null-separated
  'list of key names, terminated by a pair
  'of null characters. If the Get call was
  'successful, success holds the length of the
  'string in ret up to but not including
  'that second terminating null. The
  'ProfileGetItem function below extracts
  'each key item using the nulls as markers,
  'so trim off the terminating null.
   If success Then
    
     'trim terminating null and trailing spaces
      ret = Left$(ret, success)
      
        'with the resulting string,
        'extract each element
         Do Until ret = ""
      
           'strip off an item (i.e. "Item1", "Item2")
            lpKeyName = StripNulls(ret)
        
           'pass the lpKeyName received to a routine that
           'again calls GetPrivateProfileString, this
           'time passing the real key name. Returned
           'is the value associated with that key,
           'ie the "Apple" corresponding to the ini
           'entry "Item1=Apple"
            KeyData = ProfileGetItem(lpSectionName, _
                                            lpKeyName, _
                                            "", _
                                            inifile)
         
           'add the item retruned to the listbox
            lst.AddItem KeyData
      
         Loop
  
   End If
  
  'return the number of items as an
  'indicator of success
   ProfileLoadList = lst.ListCount

End Function


Public Sub ProfileSaveList(lst As ListBox, _
                           lpSectionName As String, _
                           lpKeyName As String, _
                           inifile As String)

'This function saves the contents of a passed listbox
'to an ini file. It creates a sequential set of key names
'based on the default lpKeyName passed, appending a count
'to each (ie pass "Colours" and it saves entries under
'"Colours1=", "Colours2=" etc.)
   
   Dim c As Long
   Dim numberedKeyName As String
   Dim tmp As String
   Dim totalItems As Long
  
  'Delete lpSectionName and all items under it
  'to assure only the current listbox items are saved
   ProfileDeleteSection lpSectionName, inifile

 
  'write the list to the ini file
   For c = 0 To lst.ListCount - 1
   
     'create the numbered keyname for
     'each entry & save to the file
      numberedKeyName = lpKeyName & CStr(c + 1)
      tmp = lst.List(c)
      
      Call ProfileSaveItem(lpSectionName, numberedKeyName, tmp, inifile)
   
   Next
 
End Sub
 Form Code
On a form (the same form used in the Basic demo can be used; control names have been adjusted to accommodate this), add six command buttons (Command5 - Command11), three text boxes (Text4, Text5, Text6 (Text6 will exist if reusing the basic form)), and a Label (Label2). Other  labels can be added as needed. Finally, add a listbox (List1) and the following code to the form:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private sIniFile As String

Private Declare Function GetPrivateProfileString _
   Lib "kernel32" Alias "GetPrivateProfileStringA" _
  (ByVal sSection As String, _
   ByVal sKeyName As Any, _
   ByVal lpDefault As String, _
   ByVal lpReturnedString As String, _
   ByVal nSize As Long, _
   ByVal lpFileName As String) As Long
   
Private Declare Function WritePrivateProfileString _
   Lib "kernel32" Alias "WritePrivateProfileStringA" _
  (ByVal sSection As String, _
   ByVal sKeyName As Any, _
   ByVal lpString As Any, _
   ByVal lpFileName As String) As Long



Private Sub Form_Load()

  'setup
   Text1.Text = "Colours"
   Text2.Text = "Colour"
   
  'Text3 is used to display the contents
  'of the raw file only. Changing the
  'contents of this text box will have
  'no effect on the results. Ensure
  'Text3 is set to Multiline.
   Text3.Text = ""
   
   With Command1
      .Caption = "Save List using Key Name"
      .Width = 2800
   End With
   
   With Command2
      .Caption = "Load List by Section Name"
      .Width = 2800
   End With
   
   With Command3
      .Caption = "Delete Selected List Key and Value"
      .Width = 2800
   End With
   
   With Command4
      .Caption = "Delete Entire Section"
      .Width = 2800
   End With
      
   With Command5
      .Caption = "Reset List Contents"
      .Width = 1850
   End With
            
   With Command6
      .Caption = "Empty List"
      .Width = 1850
   End With
       
  'this will be our test file
   sIniFile = App.Path & "\test.ini"
   
  'show the file contents (empty at first)
   Call ResetListData
   Call LoadIniFile
End Sub


Private Sub Command1_Click()

   Dim lpSection As String
   Dim sKeyName As String
   
   lpSection = Text1.Text
   sKeyName = Text2.Text

   ProfileSaveList List1, lpSection, sKeyName, sIniFile
   
   Label2.Caption = "Data saved"
   LoadIniFile
   
End Sub


Private Sub Command2_Click()
   
   Dim success As Long
   Dim lpSection As String

   lpSection = Text1.Text
   List1.Clear
   
   success = ProfileLoadList(List1, lpSection, sIniFile)
   
   Label2.Caption = CStr(success) & " items loaded."
   LoadIniFile
   Command3.Enabled = List1.ListIndex > -1
   
End Sub


Private Sub Command3_Click()

   Dim sSection As String
   Dim sKeyName As String
   
  'create the key; its made up of the
  'keyname and the list index + 1
  '(because the list is 0-based)
   sKeyName = Text2.Text & CStr(List1.ListIndex + 1)
   sSection = Text1.Text
   
   Call ProfileDeleteItem(sSection, sKeyName, sIniFile)
   LoadIniFile
   
End Sub


Private Sub Command4_Click()

   Dim lpSection As String
   
   lpSection = Text1.Text
   
  'delete sSection and all items under it
   ProfileDeleteSection lpSection, sIniFile
   
   Label2.Caption = "The '" & lpSection & "' section has been deleted."
   LoadIniFile
   
   
End Sub


Private Sub Command5_Click()

   ResetListData
   LoadIniFile
   
End Sub


Private Sub Command6_Click()

   List1.Clear
   
End Sub


Private Sub List1_Click()

   Command3.Enabled = List1.ListIndex > -1

End Sub


Private Sub List1_DblClick()

   List1.RemoveItem (List1.ListIndex)
   Command3.Enabled = List1.ListIndex > -1
   Label2.Caption = CStr(List1.ListCount) & " items in list."

End Sub


Private Function ProfileLoadList(lst As ListBox, _
                                 sSection As String, _
                                 sIniFile As String) As Long

  'This is the main function for loading
  'the listbox data from an ini file.
  'First, it calls GetPrivateProfileString
  'to get all key name entries under sSection.
  'It then loops, passing each key name
  'to ppGetItemsInfo() and the returned
  'value is added to the listbox.
   Dim success As Long
   Dim nSize As Long
   Dim KeyData As String
   Dim sKeyName As String
   Dim ret As String
  
  'call the API passing null as the parameter
  'for the sKeyName parameter. This causes
  'the API to return a list of all keys under
  'that section. Pad the passed string large
  'enough to hold the data.
   ret = Space$(4096)
   nSize = Len(ret)
   success = GetPrivateProfileString(sSection, _
                                     vbNullString, _
                                     "", _
                                     ret, _
                                     nSize, _
                                     sIniFile)
   
  'The returned string is a null-separated
  'list of key names, terminated by a pair
  'of null characters. If the Get call was
  'successful, success holds the length of the
  'string in ret up to but not including
  'that second terminating null. The
  'ProfileGetItem function below extracts
  'each key item using the nulls as markers,
  'so trim off the terminating null.
   If success Then
    
     'trim terminating null and trailing spaces
      ret = Left$(ret, success)
      
        'with the resulting string,
        'extract each element
         Do Until ret = ""
      
           'strip off an item (i.e. "Item1", "Item2")
            sKeyName = StripItem(ret)
        
           'pass the sKeyName received to a routine that
           'again calls GetPrivateProfileString, this
           'time passing the real key name. Returned
           'is the value associated with that key,
           'ie the "Apple" corresponding to the ini
           'entry "Item1=Apple"
            KeyData = ProfileGetItem(sSection, sKeyName, "", sIniFile)
         
           'add the item retruned to the listbox
            lst.AddItem KeyData
      
         Loop
  
   End If
  
  'return the number of items as an
  'indicator of success
   ProfileLoadList = lst.ListCount

End Function


Private Sub ProfileSaveList(lst As ListBox, _
                            sSection As String, _
                            sKeyName As String, _
                            sIniFile As String)

  'This function saves the contents of
  'a passed listbox to an ini file. It
  'creates a sequential set of key names
  'based on the default sKeyName passed,
  'appending a count to each (ie pass
  '"Colour" and it saves entries under
  '"Colours1=", "Colours2=" etc.)
   Dim cnt As Long
   Dim sNumKeyName As String
   Dim buff As String
  
  'Delete sSection and all items under it to
  'assure only the current listbox items are saved
   ProfileDeleteSection sSection, sIniFile

 
  'write the list to the ini file
   For cnt = 0 To lst.ListCount - 1
   
     'create the numbered keyname for
     'each entry & save to the file
      sNumKeyName = sKeyName & CStr(cnt + 1)
      buff = lst.List(cnt)
      
      Call ProfileSaveItem(sSection, _
                           sNumKeyName, _
                           buff, _
                           sIniFile)
   
   Next
 
End Sub


Private Sub ProfileDeleteItem(sSection As String, _
                              sKeyName As String, _
                              sIniFile As String)

  'this call will remove the keyname and its
  'corresponding value from the section specified
  'in sSection. This is accomplished by passing
  'vbNullString as the sValue parameter. For example,
  'assuming that an ini file had:
  ' [Colours]
  '  Colour1=Red
  '  Colour2=Blue
  '  Colour3=Green
  '
  'and this sub was called passing "Colour2"
  'as sKeyName, the resulting ini file
  'would contain:
  ' [Colours]
  '  Colour1=Red
  '  Colour3=Green
   
   Call WritePrivateProfileString(sSection, _
                                  sKeyName, _
                                  vbNullString, _
                                  sIniFile)

End Sub


Private Sub ProfileDeleteSection(sSection As String, sIniFile As String)

  'this call will remove the entire section
  'corresponding to sSection from the file.
  'This is accomplished by passing vbNullString 
  'as both the sKeyName and sValue parameters. 
  'For example, assuming that an ini file had:
  ' [Colours]
  '  Colour1=Red
  '  Colour2=Blue
  '  Colour3=Green
  '
  'and this sub was called passing "Colours"
  'as sSection, the resulting Colours
  'section in the ini file would be deleted.
   
   Call WritePrivateProfileString(sSection, _
                                  vbNullString, _
                                  vbNullString, _
                                  sIniFile)

End Sub


Private Function ProfileGetItem(sSection As String, _
                                sKeyName As String, _
                                sDefValue As String, _
                                sIniFile As String) As String

  'retrieves a value from an ini file
  'corresponding to the section and
  'key name passed
   Dim dwSize As Long
   Dim nBuffSize As Long
   Dim buff As String
  
  'Call the API with the parameters passed.
  'nBuffSize is the length of the string
  'in buff, including the terminating null.
  'If a default value was passed, and the
  'section or key name are not in the file,
  'that value is returned. If no default
  'value was passed (""), then dwSize
  'will = 0 if not found.

  'pad a string large enough to hold the data
   buff = Space$(2048)
   nBuffSize = Len(buff)
   dwSize = GetPrivateProfileString(sSection, _
                                    sKeyName, _
                                    sDefValue, _
                                    buff, _
                                    nBuffSize, _
                                    sIniFile)
   
   If dwSize > 0 Then
      ProfileGetItem = Left$(buff, dwSize)
   End If
   
End Function


Private Sub ProfileSaveItem(sSection As String, _
                            sKeyName As String, _
                            sValue As String, _
                            sIniFile As String)

  'This function saves the passed
  'value to the file under the section
  'and key name specified.
  '
  'If the ini file does not exist, it is created.
  'If the section does not exist, it is created within the file.
  'If the key name does not exist, it is created under the section.
  'If the key name exists, it's value is replaced.
   
   Call WritePrivateProfileString(sSection, sKeyName, sValue, sIniFile)

End Sub


Private Sub ResetListData()

  'Just reset to redo the demo.
  'Does not affect the INI file.
   With List1
      .Clear
      .AddItem "Apple"
      .AddItem "Orange"
      .AddItem "Grape"
      .AddItem "Strawberry"
      .AddItem "Salmon"
      .AddItem "Cyan"
      .AddItem "Green"
      .AddItem "Cherry"
      .AddItem "Yellow"
      .AddItem "Cyan"
      .AddItem "Gray"
      .AddItem "Purple"
      .AddItem "Magenta"
   End With
   
   Label2.Caption = CStr(List1.ListCount) & " items; " & _
                    "Double-click to remove an item " & _
                    "from list (this does not remove " & _
                    "the item from the file, only  " & _
                    "shorten the list!)"
                    
   Command3.Enabled = List1.ListIndex > -1
   
End Sub


Private Sub LoadIniFile()

   Dim hFile As Integer
   
   On Local Error Resume Next

  'obtain the next free file handle
   hFile = FreeFile

  'load the file
   Open sIniFile For Input As #hFile
      Text3.Text = Input$(LOF(hFile), hFile)
   Close #hFile
   
End Sub


Private Function StripItem(startStrg As String) As String

  'Take a string separated by nulls,
  'split off 1 item, and shorten the string
  'so the next item is ready for removal.

  'The passed string must have a terminating
  'null for this function to work correctly.
  'If you remain in a loop, check this first!
   Dim pos As Long
   Dim item As String
   
   pos = InStr(1, startStrg, Chr$(0))
   
   If pos Then

      item = Mid$(startStrg, 1, pos - 1)
      startStrg = Mid$(startStrg, pos + 1, Len(startStrg))
      StripItem = item
    
   End If

End Function
 Comments
 

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter