VB下的TIniFile类(模拟Delphi)

因为一个需求,写了这样一个类..写的我很胸闷.好多东西都没有现成的...记得一定要SetFileName,不然没法用..而且可能报异常,实在不想写异常处理了..
我实在没找到构造函数在哪里....
我只尝试了WriteString,ReadString,ReadSections这几个函数,其他的都没测试.
调用代码如下:

Dim sectionlist() As String
IniFile.SetFileName (".\Test.ini")
IniFile.ReadSections sectionlist
Dim i As Long
Combo1.Clear
For i = 0 To UBound(sectionlist)
  Combo1.AddItem (sectionlist(i))
Next

　　以下是类代码.

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 FFileName As String

Public Sub SetFileName(ByVal FileName As String)
FFileName = FileName
End Sub

Public Sub WriteString(ByVal Section, Ident, Value As String)
Dim WriteKey As Long
WriteKey = WritePrivateProfileString(Section, CStr(Ident), CStr(Value), FFileName)
End Sub

Public Sub WriteInteger(ByVal Section, Ident As String, Value As Long)
WriteString Section, Ident, CStr(Value)
End Sub

Public Sub WriteDate(ByVal Section, Ident As String, Value As Date)
WriteString Section, Ident, DateValue(Value)
End Sub

Public Sub WriteDateTime(ByVal Section, Ident As String, Value As Date)
WriteString Section, Ident, CStr(Value)
End Sub

Public Sub WriteFloat(ByVal Section, Ident As String, Value As Double)
WriteString Section, Ident, CStr(Value)
End Sub

Public Sub WriteTime(ByVal Section, Ident As String, Value As Date)
WriteString Section, Ident, TimeValue(Value)
End Sub

Public Sub WriteBool(ByVal Section, Ident As String, Value As Boolean)
If Value Then
  WriteString Section, Ident, "1"
Else
  WriteString Section, Ident, "0"
End If
End Sub

Public Sub ReadSectionValues(ByVal Section As String, ByRef Strings() As String)
Dim KeyList() As String
ReadSection Section, KeyList
Dim i As Long
For i = 0 To UBound(KeyList)
  ReDim Preserve Strings(i)
  Strings(i) = ReadString(Section, KeyList(i), "")
Next
End Sub
    
Public Sub EreSection(ByVal Section As String)
Dim WriteKey As Long
WriteKey = WritePrivateProfileString(Section, vbNullString, vbNullString, FFileName)
End Sub

Public Sub DeleteKey(ByVal Section, Ident As String)
Dim WriteKey As Long
WriteKey = WritePrivateProfileString(Section, Ident, vbNullString, FFileName)
End Sub

Public Sub UpdateFile()
Dim WriteKey As Long
WriteKey = WritePrivateProfileString(vbNullString, vbNullString, vbNullString, FFileName)
End Sub

Public Function SectionExists(ByVal Section As String) As Boolean
Dim Strings() As String
ReadSection Section, Strings
SectionExists = UBound(Strings) >= 0
End Function

Public Function ReadString(ByVal Section As String, ByVal Ident As String, ByVal Default As String) As String
Dim Buffer As String
Dim Length As Long
Buffer = String$(2048, Chr(0))
Length = GetPrivateProfileString(Section, CStr(Ident), Default, Buffer, Len(Buffer), FFileName)
ReadString = Buffer
End Function


Public Function ReadInteger(ByVal Section, Ident As String, Default As Long) As Long
Dim DataStr As String
ReadInteger = Default
DataStr = ReadString(Section, Ident, "")
If DataStr <> "" Then
  If IsNumeric(DataStr) And (Int(DataStr) = DataStr) Then
    ReadInteger = CInt(DataStr)
  End If
End If
End Function

Public Function ReadBool(ByVal Section, Ident As String, Default As Boolean) As Boolean
ReadBool = ReadInteger(Section, Ident, Asc(Default)) <> 0
End Function

Public Function ReadDate(ByVal Section, Ident As String, Default As Date) As Date
Dim DataStr As String
DataStr = ReadString(Section, Ident, "")
If DataStr <> "" Then
  If IsDate(DataStr) Then
    ReadDate = DateValue(CDate(DataStr))
  End If
End If
End Function

Public Function ReadDateTime(ByVal Section, Ident As String, Default As Date) As Date
Dim DataStr As String
DataStr = ReadString(Section, Ident, "")
If DataStr <> "" Then
  If IsDate(DataStr) Then
    ReadDateTime = CDate(DataStr)
  End If
End If
End Function

Public Function ReadFloat(ByVal Section, Ident As String, Default As Double) As Double
Dim DataStr As String
ReadFloat = Default
DataStr = ReadString(Section, Ident, "")
If DataStr <> "" Then
  If IsNumeric(DataStr) Then
    ReadFloat = CSng(DataStr)
  End If
End If
End Function

Public Function ReadTime(ByVal Section, Ident As String, Default As Date) As Date
Dim DataStr As String
DataStr = ReadString(Section, Ident, "")
If DataStr <> "" Then
  If IsDate(DataStr) Then
    ReadTime = TimeValue(CDate(DataStr))
  End If
End If
End Function

Public Sub ReadSection(ByVal Section As String, ByRef Strings() As String)
Dim Buffer As String
Dim NowLen As Long
Dim Index As Long
Index = 0
ReDim Strings(Index)
Buffer = String$(16384, Chr(0))
If GetPrivateProfileString(Section, CStr(vbNullString), vbNullString, Buffer, Len(Buffer), FFileName) <> 0 Then
  NowLen = InStr(Buffer, Chr(0)) - 1
  Do While NowLen > 0
    ReDim Preserve Strings(Index)
    Strings(Index) = Left(Buffer, NowLen + 1)
    Buffer = Right(Buffer, Len(Buffer) - NowLen - 1)
    NowLen = InStr(Buffer, Chr(0)) - 1
    Index = Index + 1
  Loop
End If
End Sub

Public Sub ReadSections(ByRef Strings() As String)
Dim Buffer As String
Dim NowLen As Long
Dim Index As Long
Index = 0
ReDim Strings(Index)
Buffer = String$(16384, Chr(0))
If GetPrivateProfileString(vbNullString, CStr(vbNullString), vbNullString, Buffer, Len(Buffer), FFileName) <> 0 Then
  NowLen = InStr(Buffer, Chr(0)) - 1
  Do While NowLen > 0
    ReDim Preserve Strings(Index)
    Strings(Index) = Left(Buffer, NowLen + 1)
    Buffer = Right(Buffer, Len(Buffer) - NowLen - 1)
    NowLen = InStr(Buffer, Chr(0)) - 1
    Index = Index + 1
  Loop
End If
End Sub

Public Function ValueExists(ByVal Section, Ident As String) As Boolean
ValueExists = False
Dim Strings() As String
ReadSection Section, Strings
Dim i As Integer
For i = 0 To UBound(Strings)
  If Ident = Strings(i) Then
    ValueExists = True
    Exit Function
  End If
Next
End Function

Public Function FileName() As String
FileName = FFileName
End Function