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