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

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