因为一个需求,写了这样一个类..写的我很胸闷.好多东西都没有现成的...记得一定要SetFileName,不然没法用..而且可能报异常,实在不想写异常处理了..
我实在没找到构造函数在哪里....
我只尝试了WriteString,ReadString,ReadSections这几个函数,其他的都没测试.
调用代码如下:
1 Dim sectionlist() As String
2 IniFile.SetFileName (".\Test.ini")
3 IniFile.ReadSections sectionlist
4 Dim i As Long
5 Combo1.Clear
6 For i = 0 To UBound(sectionlist)
7 Combo1.AddItem (sectionlist(i))
8 Next
以下是类代码.
1 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
2 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
3
4 Private FFileName As String
5
6 Public Sub SetFileName(ByVal FileName As String)
7 FFileName = FileName
8 End Sub
9
10 Public Sub WriteString(ByVal Section, Ident, Value As String)
11 Dim WriteKey As Long
12 WriteKey = WritePrivateProfileString(Section, CStr(Ident), CStr(Value), FFileName)
13 End Sub
14
15 Public Sub WriteInteger(ByVal Section, Ident As String, Value As Long)
16 WriteString Section, Ident, CStr(Value)
17 End Sub
18
19 Public Sub WriteDate(ByVal Section, Ident As String, Value As Date)
20 WriteString Section, Ident, DateValue(Value)
21 End Sub
22
23 Public Sub WriteDateTime(ByVal Section, Ident As String, Value As Date)
24 WriteString Section, Ident, CStr(Value)
25 End Sub
26
27 Public Sub WriteFloat(ByVal Section, Ident As String, Value As Double)
28 WriteString Section, Ident, CStr(Value)
29 End Sub
30
31 Public Sub WriteTime(ByVal Section, Ident As String, Value As Date)
32 WriteString Section, Ident, TimeValue(Value)
33 End Sub
34
35 Public Sub WriteBool(ByVal Section, Ident As String, Value As Boolean)
36 If Value Then
37 WriteString Section, Ident, "1"
38 Else
39 WriteString Section, Ident, "0"
40 End If
41 End Sub
42
43 Public Sub ReadSectionValues(ByVal Section As String, ByRef Strings() As String)
44 Dim KeyList() As String
45 ReadSection Section, KeyList
46 Dim i As Long
47 For i = 0 To UBound(KeyList)
48 ReDim Preserve Strings(i)
49 Strings(i) = ReadString(Section, KeyList(i), "")
50 Next
51 End Sub
52
53 Public Sub EreSection(ByVal Section As String)
54 Dim WriteKey As Long
55 WriteKey = WritePrivateProfileString(Section, vbNullString, vbNullString, FFileName)
56 End Sub
57
58 Public Sub DeleteKey(ByVal Section, Ident As String)
59 Dim WriteKey As Long
60 WriteKey = WritePrivateProfileString(Section, Ident, vbNullString, FFileName)
61 End Sub
62
63 Public Sub UpdateFile()
64 Dim WriteKey As Long
65 WriteKey = WritePrivateProfileString(vbNullString, vbNullString, vbNullString, FFileName)
66 End Sub
67
68 Public Function SectionExists(ByVal Section As String) As Boolean
69 Dim Strings() As String
70 ReadSection Section, Strings
71 SectionExists = UBound(Strings) >= 0
72 End Function
73
74 Public Function ReadString(ByVal Section As String, ByVal Ident As String, ByVal Default As String) As String
75 Dim Buffer As String
76 Dim Length As Long
77 Buffer = String$(2048, Chr(0))
78 Length = GetPrivateProfileString(Section, CStr(Ident), Default, Buffer, Len(Buffer), FFileName)
79 ReadString = Buffer
80 End Function
81
82
83 Public Function ReadInteger(ByVal Section, Ident As String, Default As Long) As Long
84 Dim DataStr As String
85 ReadInteger = Default
86 DataStr = ReadString(Section, Ident, "")
87 If DataStr <> "" Then
88 If IsNumeric(DataStr) And (Int(DataStr) = DataStr) Then
89 ReadInteger = CInt(DataStr)
90 End If
91 End If
92 End Function
93
94 Public Function ReadBool(ByVal Section, Ident As String, Default As Boolean) As Boolean
95 ReadBool = ReadInteger(Section, Ident, Asc(Default)) <> 0
96 End Function
97
98 Public Function ReadDate(ByVal Section, Ident As String, Default As Date) As Date
99 Dim DataStr As String
100 DataStr = ReadString(Section, Ident, "")
101 If DataStr <> "" Then
102 If IsDate(DataStr) Then
103 ReadDate = DateValue(CDate(DataStr))
104 End If
105 End If
106 End Function
107
108 Public Function ReadDateTime(ByVal Section, Ident As String, Default As Date) As Date
109 Dim DataStr As String
110 DataStr = ReadString(Section, Ident, "")
111 If DataStr <> "" Then
112 If IsDate(DataStr) Then
113 ReadDateTime = CDate(DataStr)
114 End If
115 End If
116 End Function
117
118 Public Function ReadFloat(ByVal Section, Ident As String, Default As Double) As Double
119 Dim DataStr As String
120 ReadFloat = Default
121 DataStr = ReadString(Section, Ident, "")
122 If DataStr <> "" Then
123 If IsNumeric(DataStr) Then
124 ReadFloat = CSng(DataStr)
125 End If
126 End If
127 End Function
128
129 Public Function ReadTime(ByVal Section, Ident As String, Default As Date) As Date
130 Dim DataStr As String
131 DataStr = ReadString(Section, Ident, "")
132 If DataStr <> "" Then
133 If IsDate(DataStr) Then
134 ReadTime = TimeValue(CDate(DataStr))
135 End If
136 End If
137 End Function
138
139 Public Sub ReadSection(ByVal Section As String, ByRef Strings() As String)
140 Dim Buffer As String
141 Dim NowLen As Long
142 Dim Index As Long
143 Index = 0
144 ReDim Strings(Index)
145 Buffer = String$(16384, Chr(0))
146 If GetPrivateProfileString(Section, CStr(vbNullString), vbNullString, Buffer, Len(Buffer), FFileName) <> 0 Then
147 NowLen = InStr(Buffer, Chr(0)) - 1
148 Do While NowLen > 0
149 ReDim Preserve Strings(Index)
150 Strings(Index) = Left(Buffer, NowLen + 1)
151 Buffer = Right(Buffer, Len(Buffer) - NowLen - 1)
152 NowLen = InStr(Buffer, Chr(0)) - 1
153 Index = Index + 1
154 Loop
155 End If
156 End Sub
157
158 Public Sub ReadSections(ByRef Strings() As String)
159 Dim Buffer As String
160 Dim NowLen As Long
161 Dim Index As Long
162 Index = 0
163 ReDim Strings(Index)
164 Buffer = String$(16384, Chr(0))
165 If GetPrivateProfileString(vbNullString, CStr(vbNullString), vbNullString, Buffer, Len(Buffer), FFileName) <> 0 Then
166 NowLen = InStr(Buffer, Chr(0)) - 1
167 Do While NowLen > 0
168 ReDim Preserve Strings(Index)
169 Strings(Index) = Left(Buffer, NowLen + 1)
170 Buffer = Right(Buffer, Len(Buffer) - NowLen - 1)
171 NowLen = InStr(Buffer, Chr(0)) - 1
172 Index = Index + 1
173 Loop
174 End If
175 End Sub
176
177 Public Function ValueExists(ByVal Section, Ident As String) As Boolean
178 ValueExists = False
179 Dim Strings() As String
180 ReadSection Section, Strings
181 Dim i As Integer
182 For i = 0 To UBound(Strings)
183 If Ident = Strings(i) Then
184 ValueExists = True
185 Exit Function
186 End If
187 Next
188 End Function
189
190 Public Function FileName() As String
191 FileName = FFileName
192 End Function