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