migrationanalysis/src/wizard/IniSupport.bas

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