|
Создает, пишет и читaет INI файл в формате:
[Имя раздела]
Название параметра = Значение параметра
Пример использования:
WriteINI "Путь к БАЗЕ", CurrentProject.Path, "Настройка Приложения"
MsgBox ReadINI ("Путь к БАЗЕ", "НЕ ЗНАЮ!", "Настройка Приложения") |
|
′=================================================
′es 07.01.04
′Модуль Записи/Чтения INI файла
′==================================================
′Декларация API ......
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 Function PathToINI() As String
′Возвращает путь к файлу INI
′====================================================
Const INI_FileName As String = "Application.ini"
′PathToINI = App.Path & "" & INI_FileName Для VB
PathToINI = CurrentProject.Path & "" & INI_FileName ′Для VBA (2000+)
End Function
Public Sub WriteINI(sName As String, val As String, Optional sPart As String = "Настройки")
′Запись данных в INI файл - аргументы:
′ sName = Название параметра
′ val = Значение параметра
′ sPart = Название раздела
′====================================================
Dim filePath As String
Dim intRet As Integer
On Error GoTo WriteINIErr
′Получаем путь ....
filePath = PathToINI
′Пишем значения
intRet = WritePrivateProfileString(sPart, sName, val, filePath)
′Проверка результата записи
If intRet <> 1 Then ′Неудачное завершение
MsgBox "Процедура WriteINI не смогла записать параметр INI Файла:" & vbCrLf & _
filePath & vbCrLf & _
"-----------------------------------------------------------------" & vbCrLf & _
"[" & sPart & "]" & vbCrLf & sName & "=" & val
End If
Exit Sub
WriteINIErr:
MsgBox "Процедура WriteINI привела к ошибке:" & vbCrLf & _
"#" & Err.Number & " " & Err.Description, vbCritical
End Sub
Public Function ReadINI(sName As String, Optional DefVal As String = "", Optional sPart As String = "Настройки") As String
′Чтение данных из файла INI - с возможностью записи значения по умолчанию где аргументы:
′ sName = Название параметра
′ DefVal = Значение по умолчанию (на случай его отсутствия)
′ sPart = Название раздела
′=====================================================
′Значение возвращаемое функцией GetPrivateProfileString если искомое значение параметра не найдено
Const strNoValue As String = ""
′
Dim filePath As String ′Путь к INI файлу
Dim intRet As Integer ′Длина возвращаемой строки (функцией GetPrivateProfileString)
Dim strRet As String ′Возвращаемая строка
On Error GoTo ReadINIErr
′Получаем путь ....
filePath = PathToINI
′Получаем значение из файла - если его нет будет возвращен 3й аргумент = strNoValue
strRet = String(255, Chr(0))
intRet = GetPrivateProfileString(sPart, sName, strNoValue, strRet, 255, filePath)
strRet = Left$(strRet, intRet)
′Определяем было найдено значение или нет (если возвращено знач. константы strNoValue то = НЕТ)
If strRet = strNoValue Then ′Значение не было найдено
If DefVal <> "" Then ′Если знач по умолчанию задано
WriteINI sName, DefVal, sPart ′Записываем заданное аргументом DefVal значение по умолчанию
strRet = DefVal ′и возвращаем его же
End If
End If
′Возвращаем найденное
ReadINI = strRet
Exit Function
ReadINIErr:
MsgBox "Функция ReadINI привела к ошибке:" & vbCrLf & _
"#" & Err.Number & " " & Err.Description, vbCritical
End Function |
