1cdf0e10cSrcweirAttribute VB_Name = "IniSupport"
2*e76eebc6SAndrew Rist'*************************************************************************
3*e76eebc6SAndrew Rist'
4*e76eebc6SAndrew Rist'  Licensed to the Apache Software Foundation (ASF) under one
5*e76eebc6SAndrew Rist'  or more contributor license agreements.  See the NOTICE file
6*e76eebc6SAndrew Rist'  distributed with this work for additional information
7*e76eebc6SAndrew Rist'  regarding copyright ownership.  The ASF licenses this file
8*e76eebc6SAndrew Rist'  to you under the Apache License, Version 2.0 (the
9*e76eebc6SAndrew Rist'  "License"); you may not use this file except in compliance
10*e76eebc6SAndrew Rist'  with the License.  You may obtain a copy of the License at
11*e76eebc6SAndrew Rist'
12*e76eebc6SAndrew Rist'    http://www.apache.org/licenses/LICENSE-2.0
13*e76eebc6SAndrew Rist'
14*e76eebc6SAndrew Rist'  Unless required by applicable law or agreed to in writing,
15*e76eebc6SAndrew Rist'  software distributed under the License is distributed on an
16*e76eebc6SAndrew Rist'  "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
17*e76eebc6SAndrew Rist'  KIND, either express or implied.  See the License for the
18*e76eebc6SAndrew Rist'  specific language governing permissions and limitations
19*e76eebc6SAndrew Rist'  under the License.
20*e76eebc6SAndrew Rist'
21*e76eebc6SAndrew Rist'*************************************************************************
22cdf0e10cSrcweirOption Explicit
23cdf0e10cSrcweir
24cdf0e10cSrcweirPrivate Declare Function GetPrivateProfileString Lib "kernel32" _
25cdf0e10cSrcweir   Alias "GetPrivateProfileStringA" _
26cdf0e10cSrcweir  (ByVal lpSectionName As String, _
27cdf0e10cSrcweir   ByVal lpKeyName As Any, _
28cdf0e10cSrcweir   ByVal lpDefault As String, _
29cdf0e10cSrcweir   ByVal lpReturnedString As String, _
30cdf0e10cSrcweir   ByVal nSize As Long, _
31cdf0e10cSrcweir   ByVal lpFileName As String) As Long
32cdf0e10cSrcweir
33cdf0e10cSrcweirPrivate Declare Function WritePrivateProfileString Lib "kernel32" _
34cdf0e10cSrcweir   Alias "WritePrivateProfileStringA" _
35cdf0e10cSrcweir  (ByVal lpSectionName As String, _
36cdf0e10cSrcweir   ByVal lpKeyName As Any, _
37cdf0e10cSrcweir   ByVal lpString As Any, _
38cdf0e10cSrcweir   ByVal lpFileName As String) As Long
39cdf0e10cSrcweir
40cdf0e10cSrcweir
41cdf0e10cSrcweirPublic Function ProfileGetItem(lpSectionName As String, _
42cdf0e10cSrcweir                               lpKeyName As String, _
43cdf0e10cSrcweir                               defaultValue As String, _
44cdf0e10cSrcweir                               inifile As String) As String
45cdf0e10cSrcweir
46cdf0e10cSrcweir'Retrieves a value from an ini file corresponding
47cdf0e10cSrcweir'to the section and key name passed.
48cdf0e10cSrcweir
49cdf0e10cSrcweir   Dim success As Long
50cdf0e10cSrcweir   Dim nSize As Long
51cdf0e10cSrcweir   Dim ret As String
52cdf0e10cSrcweir
53cdf0e10cSrcweir  'call the API with the parameters passed.
54cdf0e10cSrcweir  'The return value is the length of the string
55cdf0e10cSrcweir  'in ret, including the terminating null. If a
56cdf0e10cSrcweir  'default value was passed, and the section or
57cdf0e10cSrcweir  'key name are not in the file, that value is
58cdf0e10cSrcweir  'returned. If no default value was passed (""),
59cdf0e10cSrcweir  'then success will = 0 if not found.
60cdf0e10cSrcweir
61cdf0e10cSrcweir  'Pad a string large enough to hold the data.
62cdf0e10cSrcweir   ret = Space$(2048)
63cdf0e10cSrcweir   nSize = Len(ret)
64cdf0e10cSrcweir   success = GetPrivateProfileString(lpSectionName, _
65cdf0e10cSrcweir                                     lpKeyName, _
66cdf0e10cSrcweir                                     defaultValue, _
67cdf0e10cSrcweir                                     ret, _
68cdf0e10cSrcweir                                     nSize, _
69cdf0e10cSrcweir                                     inifile)
70cdf0e10cSrcweir
71cdf0e10cSrcweir   If success Then
72cdf0e10cSrcweir      ProfileGetItem = Left$(ret, success)
73cdf0e10cSrcweir   End If
74cdf0e10cSrcweir
75cdf0e10cSrcweirEnd Function
76cdf0e10cSrcweir
77cdf0e10cSrcweir
78cdf0e10cSrcweirPublic Sub ProfileDeleteItem(lpSectionName As String, _
79cdf0e10cSrcweir                             lpKeyName As String, _
80cdf0e10cSrcweir                             inifile As String)
81cdf0e10cSrcweir
82cdf0e10cSrcweir'this call will remove the keyname and its
83cdf0e10cSrcweir'corresponding value from the section specified
84cdf0e10cSrcweir'in lpSectionName. This is accomplished by passing
85cdf0e10cSrcweir'vbNullString as the lpValue parameter. For example,
86cdf0e10cSrcweir'assuming that an ini file had:
87cdf0e10cSrcweir'  [Colours]
88cdf0e10cSrcweir'  Colour1=Red
89cdf0e10cSrcweir'  Colour2=Blue
90cdf0e10cSrcweir'  Colour3=Green
91cdf0e10cSrcweir'
92cdf0e10cSrcweir'and this sub was called passing "Colour2"
93cdf0e10cSrcweir'as lpKeyName, the resulting ini file
94cdf0e10cSrcweir'would contain:
95cdf0e10cSrcweir'  [Colours]
96cdf0e10cSrcweir'  Colour1=Red
97cdf0e10cSrcweir'  Colour3=Green
98cdf0e10cSrcweir
99cdf0e10cSrcweir   Call WritePrivateProfileString(lpSectionName, _
100cdf0e10cSrcweir                                  lpKeyName, _
101cdf0e10cSrcweir                                  vbNullString, _
102cdf0e10cSrcweir                                  inifile)
103cdf0e10cSrcweir
104cdf0e10cSrcweirEnd Sub
105cdf0e10cSrcweir
106cdf0e10cSrcweir
107cdf0e10cSrcweirPublic Sub ProfileDeleteSection(lpSectionName As String, _
108cdf0e10cSrcweir                                inifile As String)
109cdf0e10cSrcweir
110cdf0e10cSrcweir'this call will remove the entire section
111cdf0e10cSrcweir'corresponding to lpSectionName. This is
112cdf0e10cSrcweir'accomplished by passing vbNullString
113cdf0e10cSrcweir'as both the lpKeyName and lpValue parameters.
114cdf0e10cSrcweir'For example, assuming that an ini file had:
115cdf0e10cSrcweir'  [Colours]
116cdf0e10cSrcweir'  Colour1=Red
117cdf0e10cSrcweir'  Colour2=Blue
118cdf0e10cSrcweir'  Colour3=Green
119cdf0e10cSrcweir'
120cdf0e10cSrcweir'and this sub was called passing "Colours"
121cdf0e10cSrcweir'as lpSectionName, the resulting Colours
122cdf0e10cSrcweir'section in the ini file would be deleted.
123cdf0e10cSrcweir
124cdf0e10cSrcweir   Call WritePrivateProfileString(lpSectionName, _
125cdf0e10cSrcweir                                  vbNullString, _
126cdf0e10cSrcweir                                  vbNullString, _
127cdf0e10cSrcweir                                  inifile)
128cdf0e10cSrcweir
129cdf0e10cSrcweirEnd Sub
130cdf0e10cSrcweir
131cdf0e10cSrcweirPrivate Function StripNulls(startStrg As String) As String
132cdf0e10cSrcweir
133cdf0e10cSrcweir'take a string separated by nulls, split off 1 item, and shorten the string
134cdf0e10cSrcweir'so the next item is ready for removal.
135cdf0e10cSrcweir'The passed string must have a terminating null for this function to work correctly.
136cdf0e10cSrcweir'If you remain in a loop, check this first!
137cdf0e10cSrcweir
138cdf0e10cSrcweir   Dim pos As Long
139cdf0e10cSrcweir   Dim item As String
140cdf0e10cSrcweir
141cdf0e10cSrcweir   pos = InStr(1, startStrg, Chr$(0))
142cdf0e10cSrcweir
143cdf0e10cSrcweir   If pos Then
144cdf0e10cSrcweir
145cdf0e10cSrcweir      item = Mid$(startStrg, 1, pos - 1)
146cdf0e10cSrcweir      startStrg = Mid$(startStrg, pos + 1, Len(startStrg))
147cdf0e10cSrcweir      StripNulls = item
148cdf0e10cSrcweir
149cdf0e10cSrcweir   End If
150cdf0e10cSrcweir
151cdf0e10cSrcweirEnd Function
152cdf0e10cSrcweir
153cdf0e10cSrcweirPublic Function ProfileLoadList(lst As ComboBox, _
154cdf0e10cSrcweir                                lpSectionName As String, _
155cdf0e10cSrcweir                                inifile As String) As Long
156cdf0e10cSrcweir   Dim success As Long
157cdf0e10cSrcweir   Dim c As Long
158cdf0e10cSrcweir   Dim nSize As Long
159cdf0e10cSrcweir   Dim KeyData As String
160cdf0e10cSrcweir   Dim lpKeyName As String
161cdf0e10cSrcweir   Dim ret As String
162cdf0e10cSrcweir
163cdf0e10cSrcweir  ' call the API passing lpKeyName = null. This causes
164cdf0e10cSrcweir  ' the API to return a list of all keys under that section.
165cdf0e10cSrcweir  ' Pad the passed string large enough to hold the data.
166cdf0e10cSrcweir   ret = Space$(2048)
167cdf0e10cSrcweir   nSize = Len(ret)
168cdf0e10cSrcweir   success = GetPrivateProfileString( _
169cdf0e10cSrcweir    lpSectionName, vbNullString, "", ret, nSize, inifile)
170cdf0e10cSrcweir
171cdf0e10cSrcweir  ' The returned string is a null-separated list of key names,
172cdf0e10cSrcweir  ' terminated by a pair of null characters.
173cdf0e10cSrcweir  ' If the Get call was successful, success holds the length of the
174cdf0e10cSrcweir  ' string in ret up to but not including that second terminating null.
175cdf0e10cSrcweir  ' The ProfileGetItem function below extracts each key item using the
176cdf0e10cSrcweir  ' nulls as markers, so trim off the terminating null.
177cdf0e10cSrcweir   If success Then
178cdf0e10cSrcweir
179cdf0e10cSrcweir     'trim terminating null and trailing spaces
180cdf0e10cSrcweir      ret = Left$(ret, success)
181cdf0e10cSrcweir
182cdf0e10cSrcweir        'with the resulting string extract each element
183cdf0e10cSrcweir         Do Until ret = ""
184cdf0e10cSrcweir           'strip off an item (i.e. "Item1", "Item2")
185cdf0e10cSrcweir            lpKeyName = StripNulls(ret)
186cdf0e10cSrcweir
187cdf0e10cSrcweir           'pass the lpKeyName received to a routine that
188cdf0e10cSrcweir           'again calls GetPrivateProfileString, this
189cdf0e10cSrcweir           'time passing the real key name. Returned
190cdf0e10cSrcweir           'is the value associated with that key,
191cdf0e10cSrcweir           'ie the "Apple" corresponding to the ini
192cdf0e10cSrcweir           'entry "Item1=Apple"
193cdf0e10cSrcweir            KeyData = ProfileGetItem( _
194cdf0e10cSrcweir                lpSectionName, lpKeyName, "", inifile)
195cdf0e10cSrcweir
196cdf0e10cSrcweir           'add the item retruned to the listbox
197cdf0e10cSrcweir            lst.AddItem KeyData
198cdf0e10cSrcweir         Loop
199cdf0e10cSrcweir
200cdf0e10cSrcweir   End If
201cdf0e10cSrcweir
202cdf0e10cSrcweir  'return the number of items as an
203cdf0e10cSrcweir  'indicator of success
204cdf0e10cSrcweir   ProfileLoadList = lst.ListCount
205cdf0e10cSrcweirEnd Function
206cdf0e10cSrcweir
207cdf0e10cSrcweirPublic Function ProfileLoadDict(dict As Scripting.Dictionary, _
208cdf0e10cSrcweir                                lpSectionName As String, _
209cdf0e10cSrcweir                                inifile As String) As Long
210cdf0e10cSrcweir   Dim success As Long
211cdf0e10cSrcweir   Dim c As Long
212cdf0e10cSrcweir   Dim nSize As Long
213cdf0e10cSrcweir   Dim KeyData As String
214cdf0e10cSrcweir   Dim lpKeyName As String
215cdf0e10cSrcweir   Dim ret As String
216cdf0e10cSrcweir
217cdf0e10cSrcweir  ' call the API passing lpKeyName = null. This causes
218cdf0e10cSrcweir  ' the API to return a list of all keys under that section.
219cdf0e10cSrcweir  ' Pad the passed string large enough to hold the data.
220cdf0e10cSrcweir   ret = Space$(2048)
221cdf0e10cSrcweir   nSize = Len(ret)
222cdf0e10cSrcweir   success = GetPrivateProfileString( _
223cdf0e10cSrcweir    lpSectionName, vbNullString, "", ret, nSize, inifile)
224cdf0e10cSrcweir
225cdf0e10cSrcweir  ' The returned string is a null-separated list of key names,
226cdf0e10cSrcweir  ' terminated by a pair of null characters.
227cdf0e10cSrcweir  ' If the Get call was successful, success holds the length of the
228cdf0e10cSrcweir  ' string in ret up to but not including that second terminating null.
229cdf0e10cSrcweir  ' The ProfileGetItem function below extracts each key item using the
230cdf0e10cSrcweir  ' nulls as markers, so trim off the terminating null.
231cdf0e10cSrcweir   If success Then
232cdf0e10cSrcweir
233cdf0e10cSrcweir     'trim terminating null and trailing spaces
234cdf0e10cSrcweir      ret = Left$(ret, success)
235cdf0e10cSrcweir
236cdf0e10cSrcweir        'with the resulting string extract each element
237cdf0e10cSrcweir         Do Until ret = ""
238cdf0e10cSrcweir           'strip off an item (i.e. "Item1", "Item2")
239cdf0e10cSrcweir            lpKeyName = StripNulls(ret)
240cdf0e10cSrcweir
241cdf0e10cSrcweir           'pass the lpKeyName received to a routine that
242cdf0e10cSrcweir           'again calls GetPrivateProfileString, this
243cdf0e10cSrcweir           'time passing the real key name. Returned
244cdf0e10cSrcweir           'is the value associated with that key,
245cdf0e10cSrcweir           'ie the "Apple" corresponding to the ini
246cdf0e10cSrcweir           'entry "Item1=Apple"
247cdf0e10cSrcweir            KeyData = ProfileGetItem( _
248cdf0e10cSrcweir                lpSectionName, lpKeyName, "", inifile)
249cdf0e10cSrcweir
250cdf0e10cSrcweir           dict.add lpKeyName, KeyData
251cdf0e10cSrcweir         Loop
252cdf0e10cSrcweir
253cdf0e10cSrcweir   End If
254cdf0e10cSrcweir
255cdf0e10cSrcweir   ProfileLoadDict = dict.count
256cdf0e10cSrcweirEnd Function
257cdf0e10cSrcweir
258cdf0e10cSrcweir
259cdf0e10cSrcweir
260cdf0e10cSrcweir
261cdf0e10cSrcweir
262cdf0e10cSrcweir
263cdf0e10cSrcweir
264