Option Explicit
'Standard class declarations
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 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 WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private ErStr         As String  'holds text for last error encountered
Private DataBaseName  As String  'holds name of database
Private IAmADll       As Boolean 'TRUE if module is running as a DLL
Private IniRead       As Boolean 'TRUE if .ini file has been read
Private MyIniFileName As String  'location of my .ini file
Private MyPath        As String  'path where this code resides
Private Srvr          As String  'holds name of server for database

'Class specific declarations
Private Const ModuleName = "ClassName"  'name of module; used for error messages and .ini file access
Const DefaultDB = "defaultdatabasename" 'default name of our database
Const DefaultSvr = "defaultservername"  'default name of the server holding our database

Private Function AddPath(s As String) As String 'Add path value to file name if not already specified
  If InStr(s, ":") = 0 And InStr(s, "\\") = 0 Then
    AddPath = MyPath + s               'no path given; add it
  Else
    AddPath = s                        'path already provided
  End If
End Function

Private Function ConditionPath(s)      'Guarantees trailing \ on path value S
  Dim ans As String
  ans = Trim(s)
  If ans = "\" Then ans = ""           'eliminate \ only
  If ans <> "" Then                    'prevent \ only
    If Right$(ans, 1) <> "\" Then ans = ans & "\"
  End If
  ConditionPath = ans
End Function

Public Property Get Error() As String  'Returns text describing last error occurrance. Use clears the stored text.
  Error = ErStr
  ErStr = ""
End Property

Private Function Exists(FileName As String) As Boolean 'Returns TRUE if FileName exists.
  On Error Resume Next
  Exists = Len(Dir$(FileName)) <> 0 And FileName <> ""
  If Err <> 0 Then Exists = False
  On Error GoTo 0
End Function

Private Sub FormatError(SubName, ErrorNumber, Description, Optional ErrorLine As Integer = 0) 'Formats an error message as "ModuleName.SubName: ErrorNumber ErrorLine: Description"
  ErStr = ModuleName + "." + SubName + ": Error " + Trim(str(ErrorNumber))
  If ErrorLine <> 0 Then ErStr = ErStr + " at line " + Trim(str(ErrorLine))
  ErStr = ErStr + ": " + Description
End Sub

Private Sub GetProfile()
Const DBName = "DBName"            '.ini name for the database name parameter
Const Svr = "Svr"                  '.ini name for the database server parameter
  If Not IniRead Then              'need to get .ini file information
    If Exists(MyIniFileName) Then     'if we have an .ini file
      DataBaseName = GetProfileText(ModuleName, DBName, DefaultDB)
      Srvr = GetProfileText(ModuleName, Svr, DefaultSvr)
    Else                           'if we don't have an .ini file
      DataBaseName = DefaultDB
      Srvr = DefaultSvr
    End If
    Call PutProfileText(ModuleName, DBName, RemoveMyPath(DataBaseName)) 
    Call PutProfileText(ModuleName, Svr, Srvr)
    IniRead = True                 '.ini has been read
  End If
End Sub

Function GetProfileInt(PName As String, ItemName As String, Default As Long) As Long
  GetProfileInt = GetPrivateProfileInt(ByVal PName, ByVal ItemName, Default, MyIniFileName)
End Function

Private Function GetProfileText(PName As String, ItemName As String, Optional Default As String = "") As String 'Returns MyIniFileName contents from section [Pname] for item [ItemName]. Default provides a value if nothing is found.
  Dim ans As String * 255
  Dim Result As Integer
  ans = ""
  Result = GetPrivateProfileString(ByVal PName, ByVal ItemName, ByVal Default, ans, Len(ans), MyIniFileName)
  ans = (Left$(ans, Result))
  If Trim(ans) = "" Then ans = Default
  GetProfileText = Trim(ans)
End Function

Private Sub PutProfileText(Sect As String, Item As String, V As String) 'Write string 'V' to the .ini file in section 'Sect' with the name 'Item'
  Dim Result As Integer
  Result = WritePrivateProfileString(ByVal Sect, ByVal Item, ByVal V, MyIniFileName)
End Sub

Private Function RemoveMyPath(s As String) As String 'If S begins with MyPath, returns S with MyPath removed. Otherwise returns S unchanged.
'Using this with .ini files, allows them to be moved to new directories without
'change as long as the associated data files are in the same directory as the program.
  If InStr(UCase$(s), UCase$(MyPath)) = 1 Then
    RemoveMyPath = Right$(s, Len(s) - Len(MyPath))
  Else
    RemoveMyPath = s
  End If
End Function

Public Sub SetupIni(APath As String, AnIniFile As String) 'Sets MyPath=APath and MyIniFileName=AnIniFile
  If APath <> "" Then MyPath = ConditionPath(APath)
  If AnIniFile <> "" Then MyIniFileName = AddPath(AnIniFile)
End Sub

Private Sub Class_Initialize()
  IAmADll = (App.StartMode = vbSModeAutomation) 'TRUE if operating as a DLL
  If IAmADll Then
    MyPath = App.Path + "\"
    MyIniFileName = MyPath + App.EXEName + ".ini"
  Else
  End If
  IniRead = False
End Sub

Private Sub Class_Terminate()
End Sub