Работа с файлами INI

[denver]

Значится так: Подключаю к проекту библиотечку Microsoft Word 8.0/9.0 Object Library, в ней есть обьект SYSTEM и свойство этого обьекта PrivateProfileString. С помощью него можно читать и писать файлы типа myfile.ini

System.PrivateProfileString("d:\ MyFile.INI", "test1", "key1") = "andy" - создаём в INI файле запись типа

[test1]
key1=andy

Но при запуске проекта выскакивает ругательное окошко:"ActiveX component can't create object".

Может кто знает в связи с чем это происходит и как решить эту проблемку ??? Заранее спасибо.

[MEMBER]

Может зарегистрировать осх?
Нафиг он, кстати, нужен?

Код: Выделить всё

' В модуль
Private Declare Function GetPrivateProfileInt Lib "kernel32" _
Alias "GetPrivateProfileIntA" _
(ByVal strSection As String, _
  ByVal strKeyName As String, _
  ByVal lngDefault As Long, _
  ByVal strFileName As String) As Long

 

Private Declare Function GetPrivateProfileString Lib "kernel32" _
Alias "GetPrivateProfileStringA" _
  (ByVal strSection As String, _
   ByVal strKeyName As String, _
   ByVal strDefault As String, _
   ByVal strReturned As String, _
   ByVal lngSize As Long, _
   ByVal strFileName As String) As Long

 

Private Declare Function WritePrivateProfileString Lib "kernel32" _
  Alias "WritePrivateProfileStringA" _
  (ByVal strSection As String, _
    ByVal strKeyNam As String, _
    ByVal strValue As String, _
    ByVal strFileName As String) As Long
Public Function GetValueString(strSection As String, _
  strKey As String, strFile As String) As String
Dim strBuffer As String * 256
Dim intSize As Integer
On Error GoTo PROC_ERR

intSize = GetPrivateProfileString(strSection, strKey, "", _
strBuffer, 256, strFile)
GetValueString = Left$(strBuffer, intSize)

PROC_EXIT:
  Exit Function

PROC_ERR:
  MsgBox "Ошибка: <" & Err.Number & "> - " & Err.Description, _
  vbExclamation = vbOKOnly, "GetValueString"
  Resume PROC_EXIT
End Function
Public Function SetValue(strSection As String, strKey As String, _
strValue As String, strFile As String) As Integer
Dim intStatus As Integer
On Error GoTo PROC_ERR

intStatus = WritePrivateProfileString(strSection, strKey, _
strValue, strFile)
SetValue = (intStatus <> 0)

PROC_EXIT:
  Exit Function

PROC_ERR:
  MsgBox "Ошибка: <" & Err.Number & "> - " & Err.Description, _
  vbExclamation = vbOKOnly, "SetValue"
  Resume PROC_EXIT
End Function

' В форму
  чтение
GetValueString("Раздел", "Имя параметра", "Путь до ini")
  запись
SetValue("Раздел", "Имя параметра", "Значение", "Путь до ini")


[denver]

Постоялец, СПАСИБО, всё заработало )))

[Chuvak]

вопрос к MEMBER:
а если структура INI такая

Код: Выделить всё

[devices]
device1=qwert
device2=asdfg
device3=zxcvb
.....
device15=yuiop
.....



т.е. число ключей не известно.
Как, например, значения ключей загнать в массив?

[MEMBER]

Не понял вопроса. Вышеприведённый код позволяет сделать то, о чём вы спрашиваете.

[denver]

вопрос к MEMBER:
а если структура INI такая

Код: Выделить всё

[devices]
device1=qwert
device2=asdfg
device3=zxcvb
.....
device15=yuiop
.....



т.е. число ключей не известно.
Как, например, значения ключей загнать в массив?

Хххмммм, дак если обращаешся к ключам, то знаеш их имена, а этого достаточно чтобы вытянуть из них значения.

[Chuvak]

было написано

Код: Выделить всё

' В форму
    чтение
GetValueString("Раздел", "Имя параметра", "Путь до ini")


а если у меня 15 параметров или 20, или ещё больше... точно неизвестно.
если было бы ровно, скажем 10 параметров, то 10 раз использую функцию и всё нормально, а здесь у меня такая неопределённость.
выше приведённой функцией эту задачу не решить, либо я чего-то не догоняю.

[MEMBER]

Есть такая штука - циклы называется. For Next там и прочее...

[Chuvak]

а как узнать количество ключей(параметров) в разделе для цикла

[MEMBER]

Не пойму я вас. ИНИ ваш, а вы у меня спрашиваете, как узнать, сколько записей в ини файле... Да никак. Потому что это не нужно. Если запись будет отсутствовать, то код возвратит "".

[Chuvak]

вполне понятный и ясный ответ

[skiperski]

вполне понятный и ясный ответ

И не верный!

Код: Выделить всё

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

Код: Выделить всё

Public Function LoadProfileSection( _
        ByVal SectionName As String, _
        Optional ByVal IniFileName As String = vbNullString _
) As Variant

    Const max_char          As Long = 32767
    Dim s                   As String
    Dim i                   As Long
    Dim arr()               As String
    Dim v                   As Variant
   
    s = String$(max_char, vbNullChar)
    i = GetPrivateProfileSection(SectionName, ByVal s, Len(s), ByVal IniFileName)
    If (i = 0) Then GoTo ExitRoutine
   
    s = Left$(s, i - 1)
    v = Split(s, vbNullChar)
    If (UBound(v) < 0) Then GoTo ExitRoutine
   
    ReDim Preserve arr(1, UBound(v))
    For i = 0 To UBound(v)
        arr(0, i) = GetNextItemFromValueList(v(i), "=", vbTextCompare)
        arr(1, i) = v(i)
    Next
    LoadProfileSection = arr
ExitRoutine:
    On Error Resume Next
    Erase v, arr
End Function

Функция GetNextItemFromValueList() возвращает подстроку до искомого символа и обрезает исходную. Код очевиден и не приводится.

[MEMBER]

skiperski
Это к чему?

[skiperski]

К тому, что Chuvak спрашивал как вычитать значения заранее не зная ни их кол-ва, ни их имён. Ты написал: "Да никак". Chuvak безропотно согласился с этим лаконичным ответом. А задача, тем не менее, решабельная. Пример выше как раз это и демонстрирует.

[MEMBER]

А я голову ломал, чего ему надо...

[Chuvak]

у меня почему-то массив arr всегда пустой получается

[Chuvak]

всё, теперь работает

[skiperski]

тихо сам с собою я веду беседу...

[moderator]

тихо сам с собою я веду беседу...

Молодцы!