Option Explicit
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
Private Declare Function GetProfileInt Lib
"kernel32" _
Alias "GetProfileIntA" _
(ByVal strSection As String, _
ByVal strKeyName As
String, _
ByVal lngDefault As
Long) _
As Integer
Private Declare Function GetProfileString Lib
"kernel32" _
Alias "GetProfileStringA"
_
(ByVal strSection As String, _
ByVal strKeyName As
String, _
ByVal strDefault As
String, _
ByVal strReturned As
String, _
ByVal intSize As Long)
_
As Long
Private Declare Function WriteProfileString Lib
"kernel32" _
Alias "WriteProfileStringA"
_
(ByVal strSection As String, _
ByVal strKeyName As
String, _
ByVal strValue As
String) _
As Integer
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 GetValueInteger(strSection As String, _
strKey As String, strFile As
String) As Integer
Dim intValue As Integer
On Error GoTo PROC_ERR
intValue = GetPrivateProfileInt(strSection, strKey, 0, strFile)
GetValueInteger = intValue
PROC_EXIT:
Exit Function
PROC_ERR:
MsgBox
"Ошибка: <" & Err.Number
& "> - " & Err.Description, _
vbExclamation +
vbOKOnly, "GetValueInteger"
Resume PROC_EXIT
End Function
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
Public Function WinINIGetValueInteger(strSection As
String, _
strKey As String) As Integer
Dim intValue As Integer
On Error GoTo PROC_ERR
intValue = GetProfileInt(strSection, strKey, 0)
WinINIGetValueInteger = intValue
PROC_EXIT:
Exit Function
PROC_ERR:
MsgBox
"Ошибка: <" & Err.Number
& "> - " & Err.Description, _
vbExclamation +
vbOKOnly, "WinINIGetValueInteger"
Resume PROC_EXIT
End Function
Public Function WinINIGetValueString(strSection As
String, _
strKey As String) As String
Dim strBuffer As String * 256
Dim intSize As Integer
On Error GoTo PROC_ERR
intSize = GetProfileString(strSection, strKey, "", strBuffer, 256)
WinINIGetValueString = Left$(strBuffer, intSize)
PROC_EXIT:
Exit Function
PROC_ERR:
MsgBox
"Ошибка: <" & Err.Number
& "> - " & Err.Description, _
vbExclamation +
vbOKOnly, "WinINIGetValueString"
Resume PROC_EXIT
End Function
Public Function WinINISetValue(strSection As String, _
strKey As String, strValue As
String) As Integer
Dim intStatus As Integer
On Error GoTo PROC_ERR
intStatus = WriteProfileString(strSection, strKey, strValue)
WinINISetValue = (intStatus <> 0)
PROC_EXIT:
Exit Function
PROC_ERR:
MsgBox
"Ошибка: <" & Err.Number
& "> - " & Err.Description, _
vbExclamation +
vbOKOnly, "WinINISetValue"
Resume PROC_EXIT
End Function
Public Function GetSection(strSection As String, strFile As String)
Dim strBuffer As String * 512
Dim intSize As Integer
Dim strTemp As String
Dim intTemp As Integer
Dim Index As Integer
Dim arrSection() As String
Dim key As String, value As String, str As String
On Error GoTo PROC_ERR
intSize = GetPrivateProfileSection(strSection, strBuffer, 512, strFile)
strTemp = Left$(strBuffer, intSize)
Do Until Len(strTemp) = 0
intTemp = InStr(1, strTemp, Chr(0))
ReDim Preserve arrSection(1, Index) As String
str = Mid(strTemp, 1, intTemp)
key = Mid(str, 1, InStr(1, str, "=") - 1)
value = Mid(str, InStr(1, str, "=") + 1)
arrSection(0, Index) = key
arrSection(1, Index) = value
Index = Index + 1
strTemp = Mid(strTemp, intTemp + 1, Len(strTemp))
Loop
GetSection = arrSection
PROC_EXIT:
Exit Function
PROC_ERR:
MsgBox "Ошибка: <" &
Err.Number & "> - " & Err.Description, _
vbExclamation +
vbOKOnly, "GetValueString"
Resume PROC_EXIT
End Function