Source code for Issue Number 63

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home


Source Code

Just paste this source code into a new class module called cIniFiles

'----------------------------------------------------------------------
'
'   Module Name:    cIniFiles
'   Written By:     C&D Programming Corp.
'   Create Date:    2/97
'   Copyright:      Copyright 1998 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit

#If Win16 Then
Private Declare Function GetPrivateProfileInt Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Integer, ByVal lpFileName As String) As Integer
Private Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
Private Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lplFileName As String) As Integer
Private Declare Function WriteProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any) As Integer
#Else
Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
#End If

Dim m_sFilename As String
Dim m_sSection As String

Property Let Section(sSection As String)
  m_sSection = sSection
End Property

Property Get Section() As String
  Section = m_sSection
End Property

Property Get Filename() As String
  Filename = m_sFilename
End Property

Property Let Filename(sFileName As String)
  m_sFilename = sFileName
End Property

#If Win16 Then

Public Function ReadInt(sKey As String, iValue As Integer, iDefault As Integer) As Integer

    Dim iRet As Integer

    If m_sSection = "" Or m_sFilename = "" Then
        ReadInt = False
        Exit Function
    End If
    iValue = GetPrivateProfileInt(m_sSection, sKey, iDefault, m_sFilename)
    ReadInt = True
End Function

Public Function ReadString(sKey As String, sValue As String, sDefault As String) As Integer
    Dim iRet As Integer
    Dim sReturn As String * 250

    If m_sSection = "" Or m_sFilename = "" Then
        ReadString = False
        Exit Function
    End If
    iRet = GetPrivateProfileString(m_sSection, sKey, sDefault, sReturn, 250, m_sFilename)
    If iRet > -1 Then
      sValue = Left$(sReturn, iRet)
    End If
    ReadString = (iRet > -1)
End Function

Public Function WriteInt(sKey As String, iValue As Integer) As Integer
    Dim iRet As Integer
    Dim sValue As String

    If m_sSection = "" Or m_sFilename = "" Then
        WriteInt = False
        Exit Function
    End If
    sValue = Trim(Str(iValue)) ' Since there is no WritePrivateProfileInt
    iRet = WritePrivateProfileString(m_sSection, sKey, sValue, m_sFilename)
    WriteInt = (iRet = 0)
End Function

Public Function WriteString(sKey As String, sValue As String) As Integer
    Dim iRet As Integer

    If m_sSection = "" Or m_sFilename = "" Then
        WriteString = False
        Exit Function
    End If
    iRet = WritePrivateProfileString(m_sSection, sKey, sValue, m_sFilename)
    WriteString = (iRet = 0)
End Function

#Else

Public Function ReadInt(sKey As String, iValue As Long, iDefault As Long) As Long
    Dim iRet As Long

    If m_sSection = "" Or m_sFilename = "" Then
        ReadInt = False
        Exit Function
    End If
    iValue = GetPrivateProfileInt(m_sSection, sKey, iDefault, m_sFilename)
    ReadInt = True
End Function

Public Function ReadString(sKey As String, sValue As String, sDefault As String) As Long
    Dim iRet As Long
    Dim sReturn As String * 250

    If m_sSection = "" Or m_sFilename = "" Then
        ReadString = False
        Exit Function
    End If
    iRet = GetPrivateProfileString(m_sSection, sKey, sDefault, sReturn, 250, m_sFilename)
    If iRet > -1 Then
      sValue = Left$(sReturn, iRet)
    End If
    ReadString = (iRet > -1)
End Function

Public Function WriteInt(sKey As String, iValue As Long) As Long
    Dim iRet As Long
    Dim sValue As String

    If m_sSection = "" Or m_sFilename = "" Then
        WriteInt = False
        Exit Function
    End If
    sValue = Trim(Str(iValue)) ' Since there is no WritePrivateProfileInt
    iRet = WritePrivateProfileString(m_sSection, sKey, sValue, m_sFilename)
    WriteInt = (iRet = 0)
End Function

Public Function WriteString(sKey As String, sValue As String) As Long
    Dim iRet As Long

    If m_sSection = "" Or m_sFilename = "" Then
        WriteString = False
        Exit Function
    End If
    iRet = WritePrivateProfileString(m_sSection, sKey, sValue, m_sFilename)
    WriteString = (iRet = 0)
End Function

#End If

Private Sub Class_Initialize()
  m_sFilename = ""
  m_sSection = ""
End Sub