Giovani e vecchi manager

Una semplice versione di un "ini manager"... Finalmente ne ho avuto bisogno pure io! Senza ricorrere a classi o artifici strani di manipolazione stringhe, prendo l'idea di Scott Lylerly e la faccio mia con qualche piccolo aggiustamento :) L'utilizzo è davvero semplice:
ini_manager ("r|w", "section", "key", <"value">)
dove "r" sta per read e "w" sta per write, quindi con una sola chiamata decido quale azione intraprendere (se in lettura o in scrittura). Il codice poi effettua a un certo punto una chiamata ricorsiva a se stesso che ho voluto inserire (naturalmente si può modificare questo punto) per sollevare errore se in modalità scrittura la sezione indicata non esiste.
Option Explicit

'managing INI files
'from an idea of scott lyerly
'https://scottlyerly.wordpress.com/2013/12/03/excel-geeking-using-vba-with-
'configuration-files/


'read INI
Public Declare Function GetPrivateProfileString Lib "kernel32" _
                 Alias "GetPrivateProfileStringA" _
                 (ByVal lpApplicationName As String, _
                   ByVal lpKeyName As String, _
                   ByVal lpDefault As String, _
                   ByVal lpReturnedString As String, _
                   ByVal nSize As Long, _
                   ByVal lpFileName As String) As Long
'write INI
Public Declare Function WritePrivateProfileString Lib "kernel32" _
                 Alias "WritePrivateProfileStringA" _
                 (ByVal lpApplicationName As String, _
                   ByVal lpKeyName As String, _
                   ByVal lpString As String, _
                   ByVal lpFileName As String) As Long

' +--------------------------------------------------+
' | INI manager                                      |
' | ini_manager ("r|w", "section", "key", <"value">) |
' +--------------------------------------------------+

Function ini_manager(action As String, section As String, key As String, _
                     Optional value As String) As String
Const INI_FILE As String = "path\inifilename.ini"
Dim sRetBuf As String
Dim iLenBuf As Integer
Dim sReturnValue As String
Dim lRetVal As Long
    
    On Error GoTo gest_err

    Select Case LCase(Left(action, 1))
    Case "r"            'READ INI
        sRetBuf = Space(256)
        iLenBuf = Len(sRetBuf)

        ' Read the INI Section/Key value into the return variable.
        sReturnValue = GetPrivateProfileString(section, key, "", sRetBuf, _
                                               iLenBuf, INI_FILE)

        ' Trim the excess garbage that comes through with the variable.
        sReturnValue = Trim(Left(sRetBuf, sReturnValue))

        ' If we get a value returned, pass it back as the argument,
        'Else pass "False".
        If Len(sReturnValue) > 0 Then
            ini_manager = sReturnValue
        Else
            ini_manager = "Error"
        End If
    
    Case "w"            'WRITE INI
        If Len(value) = 0 Then
            ini_manager = "Error"
        Else
            If ini_manager("r", section, key) <> "Error" Then
                lRetVal = WritePrivateProfileString(section, key, value, _
                                                    INI_FILE)
            Else
                lRetVal = 0
            End If
            ' Check to see if we had an error wrting to the INI file.
            If lRetVal = 0 Then ini_manager = "Error" Else ini_manager = "Ok"
        End If
        
    Case Else
        ini_manager = "Error"
        
    End Select
    
    Exit Function
    
gest_err:
    MsgBox Err.Number & ": " & Err.Description, vbInformation, "INI Manager"
    
End Function

posted @ lunedì 8 agosto 2016 11:52

Print

Comments on this entry:

No comments posted yet.

Your comment:



 (will not be displayed)


 
 
 
Please add 1 and 1 and type the answer here:
 

Live Comment Preview: