CREATING .INI FILES THROUGH VB

How to refer and use the information in the various sections of ".INI" files through software code and how to implement that .INI file feature in my projects.
SRIVBAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

y2kwackoCommented:
INI READ WRITE ROUTINE
http://www.planet-source-code.com/vb/default.asp?lngWId=1&blnFrm=true
---------------------------------------
declares:

Declare Function GetPrivateProfileString Lib "Kernel" (ByVal
    lpApplicationName As String, lpKeyName As Any, ByVal lpDefault As String,
    ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName
    As String) As Integer


Declare Function WritePrivateProfileString% Lib "Kernel" (ByVal
    lpApplicationName$, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal
    lpFileName$)

functions:



Function mfncGetFromIni (strSectionHeader As String, strVariableName As


    String, strFileName As String) As String
    '*** DESCRIPTION:Reads from an *.INI file strFileName (full path
    '     &
    file name)
    '*** RETURNS:The string stored in [strSectionHeader], line
    beginning strVariableName=
    '*** NOTE: Requires declaration of API call
    GetPrivateProfileString
    'Initialise variable
    Dim strReturn As String
    'Blank the return string
    strReturn = String(255, Chr(0))
    'Get requested information, trimming the returned string
    mfncGetFromIni = Left$(strReturn,
    GetPrivateProfileString(strSectionHeader, ByVal strVariableName, "",
    strReturn, Len(strReturn), strFileName))
End Function



Function mfncParseString (strIn As String, intOffset As Integer,


    strDelimiter As String) As String
    '*** DESCRIPTION:Parses the passed string, returning the value
    indicated
    '***by the offset specified, eg: the string "Hello,
    World",
    '***offset 2 = "World".
    '*** RETURNS:See description.
    '*** NOTE: The offset starts at 1 and the delimiter is the
    character
    '***which separates the elements of the string.
    'Trap any bad calls


    If Len(strIn) = 0 Or intOffset = 0 Then
        mfncParseString = ""
        Exit Function
    End If


    'Declare local variables
    Dim intStartPos As Integer
    ReDim intDelimPos(10) As Integer
    Dim intStrLen As Integer
    Dim intNoOfDelims As Integer
    Dim intCount As Integer
    Dim strQuotationMarks As String
    Dim intInsideQuotationMarks As Integer
    strQuotationMarks = Chr(34) & Chr(147) & Chr(148)
    intInsideQuotationMarks = False


    For intCount = 1 To Len(strIn)
        'If character is a double-quote then toggle the In Quotation flag
        '    


        If InStr(strQuotationMarks, Mid$(strIn, intCount, 1)) <> 0 Then
            intInsideQuotationMarks = (Not intInsideQuotationMarks)
        End If


        If (Not intInsideQuotationMarks) And (Mid$(strIn, intCount, 1) =
        strDelimiter) Then
        intNoOfDelims = intNoOfDelims + 1
        'If array filled then enlarge it, keeping existing contents


        If (intNoOfDelims Mod 10) = 0 Then
            ReDim Preserve intDelimPos(intNoOfDelims + 10)
        End If


        intDelimPos(intNoOfDelims) = intCount
    End If


Next intCount


'Handle request for value not present (over-run)


If intOffset > (intNoOfDelims + 1) Then
    mfncParseString = ""
    Exit Function
End If


'Handle boundaries of string


If intOffset = 1 Then
    intStartPos = 1
End If


'Requesting last value - handle null


If intOffset = (intNoOfDelims + 1) Then


    If Right$(strIn, 1) = strDelimiter Then
        intStartPos = -1
        intStrLen = -1
        mfncParseString = ""
        Exit Function
    Else
        intStrLen = Len(strIn) - intDelimPos(intOffset - 1)
    End If


End If


'Set start and length variables if not handled by boundary check
'     above


If intStartPos = 0 Then
    intStartPos = intDelimPos(intOffset - 1) + 1
End If



If intStrLen = 0 Then
    intStrLen = intDelimPos(intOffset) - intStartPos
End If


'Set the return string
mfncParseString = Mid$(strIn, intStartPos, intStrLen)
End Function



Function mfncWriteIni (strSectionHeader As String, strVariableName As


    String, strValue As String, strFileName As String) As Integer
    '*** DESCRIPTION:Writes to an *.INI file called strFileName (full
    '    
    path & file name)
    '*** RETURNS:Integer indicating failure (0) or success (other)
    to write
    '*** NOTE: Requires declaration of API call
    WritePrivateProfileString
    'Call the API
    mfncWriteIni = WritePrivateProfileString(strSectionHeader,
    strVariableName, strValue, strFileName)
End Function
0
vettrangerCommented:
Do bear in mind that Microsoft officially considers INI files to be obsolete. The preferred method now is to save this information in keys in the registry. The GetSettings and SaveSettings functions in VB help you do this, and they are MUCH easier to use than the various Read and Write Profile APIs.
0
itacanCommented:
Why don't you use Windows Registry instesd of ini files?

You can access Windows Registry...

'Create a key
'CreateKey <ROOT_HKEY>, "Sub-key-path"
'Delete a key
'DeleteKey<ROOT_HKEY>, "Sub-key-path"
'Delete a value
'DeleteValue <ROOT_HKEY>, "Sub-key-path", "Value-label"
'Get a string value
'var = GetValueString(<ROOT_HKEY>, "Sub-key-path", "Value-label"[, "Default-value-data"])
'Set a string value
'SetValueString <ROOT_HKEY>, "Sub-key-path", "Value-label", "Value-data"
'Get a long-integer value
'var = GetValueLong(<ROOT_HKEY>, "Sub-key-path", "Value-label"[, Default-value-data])
'Set a long-integer value
'SetValueLong <ROOT_HKEY>, "Sub-key-path", "Value-label", Vaule-data
'Get a byte array
'var AS VARIANT = GetValueByte(<ROOT_HKEY>, "Sub-key-path", "Value-label"[, Default-value-data {AS VARIANT}])
'Set a byte array
'SetValueByte <ROOT_HKEY>, "Sub-key-path", "Value-label", Value-data() AS BYTE-ARRAY



'Constants and declarations
Public Enum EnumHKEYs
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
    HKEY_CURRENT_CONFIG = &H80000005
    HKEY_DYN_DATA = &H80000006
End Enum
Private Const REG_SZ = 1             'Unicode null terminated string
Private Const REG_BINARY = 3         'Free form binary
Private Const REG_DWORD = 4          '32-bit number
Private Const ERROR_SUCCESS = 0&

Private Declare Function RegCloseKey Lib "advapi32.dll" _
    (ByVal hKey As Long) As Long

Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" _
    (ByVal hKey As Long, _
    ByVal lpSubKey As String, _
    phkResult As Long) As Long

Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
    (ByVal hKey As Long, _
    ByVal lpSubKey As String) As Long

Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
    (ByVal hKey As Long, _
    ByVal lpValueName As String) As Long

Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
    (ByVal hKey As Long, _
    ByVal lpSubKey As String, _
    phkResult As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
    (ByVal hKey As Long, _
    ByVal lpValueName As String, _
    ByVal lpReserved As Long, _
    lpType As Long, _
    lpData As Any, _
    lpcbData As Long) As Long

Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
    (ByVal hKey As Long, _
    ByVal lpValueName As String, _
    ByVal Reserved As Long, _
    ByVal dwType As Long, _
    lpData As Any, _
    ByVal cbData As Long) As Long

'Public functions
Public Sub CreateKey _
    (hKey As EnumHKEYs, _
    strPath As String)

    Dim hCurKey As Long, lRegResult As Long

    lRegResult = RegCreateKey(hKey, strPath, hCurKey)
    If lRegResult <> ERROR_SUCCESS Then
        'Error code
    End If

    lRegResult = RegCloseKey(hCurKey)

End Sub

Public Sub DeleteKey _
    (ByVal hKey As EnumHKEYs, _
    ByVal strPath As String)

    Dim lRegResult As Long

    lRegResult = RegDeleteKey(hKey, strPath)

End Sub

Public Sub DeleteValue _
    (ByVal hKey As EnumHKEYs, _
    ByVal strPath As String, _
    ByVal strValue As String)

    Dim hCurKey As Long, lRegResult As Long

    lRegResult = RegOpenKey(hKey, strPath, hCurKey)

    lRegResult = RegDeleteValue(hCurKey, strValue)

    lRegResult = RegCloseKey(hCurKey)

End Sub


Public Function GetValueString _
    (hKey As EnumHKEYs, _
    strPath As String, _
    strValue As String, _
    Optional Default As String) As String

    Dim hCurKey As Long, lResult As Long, lValueType As Long, _
        strBuffer As String, lDataBufferSize As Long, intZeroPos As Integer, _
        lRegResult As Long

    'Set up default value
    If Not IsEmpty(Default) Then
        GetValueString = Default
    Else
        GetValueString = ""
    End If

    lRegResult = RegOpenKey(hKey, strPath, hCurKey)
    lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, _
        lValueType, ByVal 0&, lDataBufferSize)

    If lRegResult = ERROR_SUCCESS Then
        If lValueType = REG_SZ Then
            strBuffer = String(lDataBufferSize, " ")
            lResult = RegQueryValueEx(hCurKey, strValue, 0&, 0&, _
                ByVal strBuffer, lDataBufferSize)
            intZeroPos = InStr(strBuffer, Chr$(0))
            If intZeroPos > 0 Then
                GetValueString = Left$(strBuffer, intZeroPos - 1)
            Else
                GetValueString = strBuffer
            End If
        End If
    Else
        'Error code
    End If

    lRegResult = RegCloseKey(hCurKey)
End Function

Public Sub SetValueString _
    (hKey As EnumHKEYs, _
    strPath As String, _
    strValue As String, _
    strData As String)

    Dim hCurKey As Long, lRegResult As Long

    lRegResult = RegCreateKey(hKey, strPath, hCurKey)
    lRegResult = RegSetValueEx(hCurKey, strValue, 0, REG_SZ, _
        ByVal strData, Len(strData))

    If lRegResult <> ERROR_SUCCESS Then
        'Error code
    End If

    lRegResult = RegCloseKey(hCurKey)
End Sub

Public Function GetValueLong _
    (ByVal hKey As EnumHKEYs, _
    ByVal strPath As String, _
    ByVal strValue As String, _
    Optional Default As Long) As Long

    Dim lRegResult As Long, lValueType As Long, _
        lBuffer As Long, lDataBufferSize As Long, _
        hCurKey As Long

    'Set up default value
    If Not IsEmpty(Default) Then
        GetValueLong = Default
    Else
        GetValueLong = 0
    End If

    lRegResult = RegOpenKey(hKey, strPath, hCurKey)
    lDataBufferSize = 4 ' 4 bytes = 32 bits = long
    lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, _
        lValueType, lBuffer, lDataBufferSize)

    If lRegResult = ERROR_SUCCESS Then
        If lValueType = REG_DWORD Then
            GetValueLong = lBuffer
        End If
    Else
        'Error code
    End If

    lRegResult = RegCloseKey(hCurKey)
End Function

Public Sub SetValueLong _
    (ByVal hKey As EnumHKEYs, _
    ByVal strPath As String, _
    ByVal strValue As String, _
    ByVal lData As Long)

    Dim hCurKey As Long, lRegResult As Long

    lRegResult = RegCreateKey(hKey, strPath, hCurKey)
    lRegResult = RegSetValueEx(hCurKey, strValue, 0&, _
        REG_DWORD, lData, 4)

    If lRegResult <> ERROR_SUCCESS Then
        'Error code
    End If

    lRegResult = RegCloseKey(hCurKey)
End Sub

Public Function GetValueByte _
    (ByVal hKey As EnumHKEYs, _
    ByVal strPath As String, _
    ByVal strValueName As String, _
    Optional Default As Variant) As Variant

    Dim lValueType As Long, byBuffer() As Byte, _
        lDataBufferSize As Long, lRegResult As Long, _
        hCurKey As Long

    'Set up default value
    If Not IsEmpty(Default) Then
        If VarType(Default) = vbArray + vbByte Then
            GetValueByte = Default
        Else
            GetValueByte = 0
        End If
    Else
        GetValueByte = 0
    End If

    lRegResult = RegOpenKey(hKey, strPath, hCurKey)
    lRegResult = RegQueryValueEx(hCurKey, strValueName, 0&, _
        lValueType, ByVal 0&, lDataBufferSize)

    If lRegResult = ERROR_SUCCESS Then
        If lValueType = REG_BINARY Then
            ReDim byBuffer(lDataBufferSize - 1) As Byte
            lRegResult = RegQueryValueEx(hCurKey, strValueName, 0&, _
                lValueType, byBuffer(0), lDataBufferSize)
            GetValueByte = byBuffer
        End If
    Else
        'Error code
    End If

    lRegResult = RegCloseKey(hCurKey)
End Function

Public Sub SetValueByte _
    (ByVal hKey As EnumHKEYs, _
    ByVal strPath As String, _
    ByVal strValueName As String, _
    byData() As Byte)

    Dim lRegResult As Long, hCurKey As Long

    lRegResult = RegCreateKey(hKey, strPath, hCurKey)
    lRegResult = RegSetValueEx(hCurKey, strValueName, _
        0&, REG_BINARY, byData(0), UBound(byData()) + 1)

    lRegResult = RegCloseKey(hCurKey)
End Sub
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

y2kwackoCommented:
vettranger correct, but let's say he is making an application for the win16 environment? as for itacan in the future post your answer as a comment if the user gets his answer from you he will ask for you to post an answer this helps by not locking the question and possibly making the person asking lose an opportunity to get the correct answer from someone else

Adios,
Kevin
0
vettrangerCommented:
Well, its so rare for questioners to actually include their development environment and target platform, I just try to list any options not already mentioned.
0
y2kwackoCommented:
vett, I'll stick with you on this :)

Kevin
0
SRIVBAuthor Commented:
thank you
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.