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