Friday, July 17, 2009

Read and write INI File

Following representing code to read and write INI file by using System API. First of all, make a module class, and give name "INIFILE", afterwards insert code following:

Option Explicit

Private Declare Function WritePrivateProfileString& Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As String, ByVal lpFileName As String)
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 mIniFileName As String

Public Property Let FileName(ByVal INIFileName As String)
Dim tmps As String

tmps = ""

If Dir(INIFileName, vbNormal) = "" Then
Open INIFileName For Output As #1
Print #1, tmps
Close #1
End If
mIniFileName = INIFileName
End Property

Public Property Get FileName() As String
FileName = mIniFileName
End Property

Public Function GetValue(ByVal Section As String, ByVal Key As String, Optional ByVal DefaultValue As String) As String
On Error GoTo Hell
Dim Value As String, retval As String, X As Integer
retval = String$(255, 0)
X = GetPrivateProfileString(Section, Key, DefaultValue, retval, Len(retval), mIniFileName)
GetValue = Trim(Left(retval, X))
Exit Function
Hell:
GetValue = DefaultValue
End Function

Public Function WriteValue(ByVal Section As String, ByVal Key As String, ByVal Value As String) As Boolean
On Error GoTo Hell
Dim X As Integer
X = WritePrivateProfileString(Section, Key, Value, mIniFileName)
If X <> 0 Then WriteValue = True
Exit Function
Hell:
End Function

Public Function GetAllSections() As Collection
Dim Value As String, retval As String, X As Integer
Dim S() As String, I As Integer
retval = String$(255, 0)
X = GetPrivateProfileString(vbNullString, "", "", retval, Len(retval), mIniFileName)
Value = Trim(Left(retval, X))
S = Split(Value, Chr(0))
Set GetAllSections = New Collection
With GetAllSections
For I = LBound(S) To UBound(S)
If S(I) <> "" Then .Add S(I)
Next
End With
End Function

Public Function GetAllKeys(ByVal Section As String) As Collection
Dim Value As String, retval As String, X As Integer
Dim S() As String, I As Integer
retval = String$(255, 0)
X = GetPrivateProfileString(Section, vbNullString, "", retval, Len(retval), mIniFileName)
Value = Trim(Left(retval, X))
S = Split(Value, Chr(0))
Set GetAllKeys = New Collection
With GetAllKeys
For I = LBound(S) To UBound(S)
If S(I) <> "" Then .Add S(I)
Next
End With
End Function

Public Function DeleteSection(ByVal Section As String) As Boolean
On Error GoTo Hell
Dim X As Integer
X = WritePrivateProfileString(Section, vbNullString, "", mIniFileName)
If X <> 0 Then DeleteSection = True
Exit Function
Hell:
End Function

Public Function DeleteKey(ByVal Section As String, ByVal Key As String) As Boolean
On Error GoTo Hell
Dim X As Integer
X = WritePrivateProfileString(Section, Key, vbNullString, mIniFileName)
If X <> 0 Then DeleteKey = True
Exit Function
Hell:
End Function

Private Sub Class_Initialize()
mIniFileName = ""
End Sub


No comments:

Post a Comment