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