Module IniWork
Friend Class clsIniFile
'模块名称 clsIniFile
'功能描述 提供对Ini文件的一些操作
'创建日期 20031026
'开发机构 石家庄天海科技有限公司
'声明API函数
Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Integer
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Integer
Private objFilesys As Scripting.FileSystemObject '文件系统对象
Private fFileName As String '保存Ini文件名
'过程名称:fGetIniString
'功能描述:从ini文件中得到指定Section中的指定Key的值
'接收参数:SectionName指定Section的名字,指定Key的名字
'返回参数:返回读出的值
'创建人员及日期:zzz@20031104
Public Function fGetIniString(ByVal sSectionName As String, _
ByVal sKeyName As String, _
ByVal IniFilePathName As String, _
Optional ByVal sDefaultValue As String = "") As String
Try
If Not objFilesys.FileExists(IniFilePathName) Then '如果文件不存在则退出
fGetIniString = sDefaultValue
Exit Function
End If
Dim sValue As String
sValue = Space(255)
Dim i, iResult, iPos As Short
iResult = GetPrivateProfileString(sSectionName, sKeyName, sDefaultValue, sValue, Len(sValue), IniFilePathName)
iPos = InStr(1, sValue, Chr(0))
If iPos > 0 Then '去掉未尾的chr(0)字符
fGetIniString = Mid(sValue, 1, iPos - 1)
Else
fGetIniString = sValue
End If
Catch ex As Exception
Throw New Exception("Error In fGetIniString!!!" & vbCrLf & _
"Source:" & ex.Source.ToString() & "Message:" & ex.Message)
End Try
End Function
'过程名称:sInitializeIniFile
'功能描述:初始化ini文件对象,保存文件名字
'接收参数:FullIniName要处理的ini文件名字(全路途文件名),bNoExistCreate如果文件不存是否创建
'返回参数:
'创建人员及日期:zzz@20031104
Public Sub sInitializeIniFile(ByVal FullIniName As String, Optional ByVal bNoExistCreate As Boolean = True)
Try
If Not objFilesys.FileExists(FullIniName) And bNoExistCreate Then '如果文件不存在并且需要创建则创建
WritePrivateProfileSection("Created Date", "Created=" & Today & " " & TimeOfDay & Chr(0) & Chr(0), FullIniName)
End If
fFileName = FullIniName
Catch ex As Exception
Throw New Exception("Error In sInitializeIniFile!!!" & vbCrLf & _
"Source:" & ex.Source.ToString() & "Message:" & ex.Message)
End Try
End Sub
'过程名称:fWriteIniSection
'功能描述:将包含多个key及key值的数组写入ini文件中的指定Section
'接收参数:SectionName指定要写入的Section,FieldArr表示key及key值的字符串如
' FieldArr(0) = "a=0" FieldArr(0) = "b=1",如果Section不存在则创建
'返回参数:成功返回True,否则返回False
'创建人员及日期:zzz@20031104
Public Function fWriteIniSection(ByVal SectionName As String, Optional ByRef FieldArr As Object = Nothing) As Boolean
Try
Dim iResult As Short
If Not objFilesys.FileExists(fFileName) Then
fWriteIniSection = False
Exit Function
End If
'
Dim sTemp As String
sTemp = ""
Dim i As Short
If Not IsNothing(FieldArr) Then
For i = LBound(FieldArr) To UBound(FieldArr)
sTemp = sTemp + FieldArr(i) & Chr(0)
Next
End If
sTemp = sTemp & Chr(0)
iResult = WritePrivateProfileSection(SectionName, sTemp, fFileName)
fWriteIniSection = iResult <> 0
Catch ex As Exception
Throw New Exception("Error In fWriteIniSection!!!" & vbCrLf & _
"Source:" & ex.Source.ToString() & "Message:" & ex.Message)
End Try
End Function
'过程名称:fWriteIniString
'功能描述:将单个key及key值写入ini文件中的指定Section
'接收参数:SectionName指定要写入的Section,KeyName表示key的名字,KeyValue表示key的值
'返回参数:成功返回True,否则返回False
'创建人员及日期:zzz@20031104
Public Function fWriteIniString(ByVal SectionName As String, _
ByVal KeyName As String, _
ByVal KeyValue As String, _
ByVal IniFilePathName As String) As Boolean
Try
Dim iResult As Short
If Not objFilesys.FileExists(IniFilePathName) Then '文件不存在则退出
fWriteIniString = False
Exit Function
End If
iResult = WritePrivateProfileString(SectionName, KeyName, KeyValue, IniFilePathName)
fWriteIniString = iResult <> 0
Catch ex As Exception
Throw New Exception("Error In fWriteIniString!!!" & vbCrLf & _
"Source:" & ex.Source.ToString() & "Message:" & ex.Message)
End Try
End Function
Private Sub Class_Initialize_Renamed()
Try
objFilesys = New Scripting.FileSystemObject
Catch ex As Exception
Throw New Exception("Error In Class_Initialize_Renamed!!!" & vbCrLf & _
"Source:" & ex.Source.ToString() & "Message:" & ex.Message)
End Try
End Sub
Public Sub New()
MyBase.New()
Class_Initialize_Renamed()
End Sub
Private Sub Class_Terminate_Renamed()
Try
objFilesys = Nothing
Catch ex As Exception
Throw New Exception("Error In Class_Terminate_Renamed!!!" & vbCrLf & _
"Source:" & ex.Source.ToString() & "Message:" & ex.Message)
End Try
End Sub
Protected Overrides Sub Finalize()
Class_Terminate_Renamed()
MyBase.Finalize()
End Sub
End Class
End Module
Friend Class clsIniFile
'模块名称 clsIniFile
'功能描述 提供对Ini文件的一些操作
'创建日期 20031026
'开发机构 石家庄天海科技有限公司
'声明API函数
Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Integer
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Integer
Private objFilesys As Scripting.FileSystemObject '文件系统对象
Private fFileName As String '保存Ini文件名
'过程名称:fGetIniString
'功能描述:从ini文件中得到指定Section中的指定Key的值
'接收参数:SectionName指定Section的名字,指定Key的名字
'返回参数:返回读出的值
'创建人员及日期:zzz@20031104
Public Function fGetIniString(ByVal sSectionName As String, _
ByVal sKeyName As String, _
ByVal IniFilePathName As String, _
Optional ByVal sDefaultValue As String = "") As String
Try
If Not objFilesys.FileExists(IniFilePathName) Then '如果文件不存在则退出
fGetIniString = sDefaultValue
Exit Function
End If
Dim sValue As String
sValue = Space(255)
Dim i, iResult, iPos As Short
iResult = GetPrivateProfileString(sSectionName, sKeyName, sDefaultValue, sValue, Len(sValue), IniFilePathName)
iPos = InStr(1, sValue, Chr(0))
If iPos > 0 Then '去掉未尾的chr(0)字符
fGetIniString = Mid(sValue, 1, iPos - 1)
Else
fGetIniString = sValue
End If
Catch ex As Exception
Throw New Exception("Error In fGetIniString!!!" & vbCrLf & _
"Source:" & ex.Source.ToString() & "Message:" & ex.Message)
End Try
End Function
'过程名称:sInitializeIniFile
'功能描述:初始化ini文件对象,保存文件名字
'接收参数:FullIniName要处理的ini文件名字(全路途文件名),bNoExistCreate如果文件不存是否创建
'返回参数:
'创建人员及日期:zzz@20031104
Public Sub sInitializeIniFile(ByVal FullIniName As String, Optional ByVal bNoExistCreate As Boolean = True)
Try
If Not objFilesys.FileExists(FullIniName) And bNoExistCreate Then '如果文件不存在并且需要创建则创建
WritePrivateProfileSection("Created Date", "Created=" & Today & " " & TimeOfDay & Chr(0) & Chr(0), FullIniName)
End If
fFileName = FullIniName
Catch ex As Exception
Throw New Exception("Error In sInitializeIniFile!!!" & vbCrLf & _
"Source:" & ex.Source.ToString() & "Message:" & ex.Message)
End Try
End Sub
'过程名称:fWriteIniSection
'功能描述:将包含多个key及key值的数组写入ini文件中的指定Section
'接收参数:SectionName指定要写入的Section,FieldArr表示key及key值的字符串如
' FieldArr(0) = "a=0" FieldArr(0) = "b=1",如果Section不存在则创建
'返回参数:成功返回True,否则返回False
'创建人员及日期:zzz@20031104
Public Function fWriteIniSection(ByVal SectionName As String, Optional ByRef FieldArr As Object = Nothing) As Boolean
Try
Dim iResult As Short
If Not objFilesys.FileExists(fFileName) Then
fWriteIniSection = False
Exit Function
End If
'
Dim sTemp As String
sTemp = ""
Dim i As Short
If Not IsNothing(FieldArr) Then
For i = LBound(FieldArr) To UBound(FieldArr)
sTemp = sTemp + FieldArr(i) & Chr(0)
Next
End If
sTemp = sTemp & Chr(0)
iResult = WritePrivateProfileSection(SectionName, sTemp, fFileName)
fWriteIniSection = iResult <> 0
Catch ex As Exception
Throw New Exception("Error In fWriteIniSection!!!" & vbCrLf & _
"Source:" & ex.Source.ToString() & "Message:" & ex.Message)
End Try
End Function
'过程名称:fWriteIniString
'功能描述:将单个key及key值写入ini文件中的指定Section
'接收参数:SectionName指定要写入的Section,KeyName表示key的名字,KeyValue表示key的值
'返回参数:成功返回True,否则返回False
'创建人员及日期:zzz@20031104
Public Function fWriteIniString(ByVal SectionName As String, _
ByVal KeyName As String, _
ByVal KeyValue As String, _
ByVal IniFilePathName As String) As Boolean
Try
Dim iResult As Short
If Not objFilesys.FileExists(IniFilePathName) Then '文件不存在则退出
fWriteIniString = False
Exit Function
End If
iResult = WritePrivateProfileString(SectionName, KeyName, KeyValue, IniFilePathName)
fWriteIniString = iResult <> 0
Catch ex As Exception
Throw New Exception("Error In fWriteIniString!!!" & vbCrLf & _
"Source:" & ex.Source.ToString() & "Message:" & ex.Message)
End Try
End Function
Private Sub Class_Initialize_Renamed()
Try
objFilesys = New Scripting.FileSystemObject
Catch ex As Exception
Throw New Exception("Error In Class_Initialize_Renamed!!!" & vbCrLf & _
"Source:" & ex.Source.ToString() & "Message:" & ex.Message)
End Try
End Sub
Public Sub New()
MyBase.New()
Class_Initialize_Renamed()
End Sub
Private Sub Class_Terminate_Renamed()
Try
objFilesys = Nothing
Catch ex As Exception
Throw New Exception("Error In Class_Terminate_Renamed!!!" & vbCrLf & _
"Source:" & ex.Source.ToString() & "Message:" & ex.Message)
End Try
End Sub
Protected Overrides Sub Finalize()
Class_Terminate_Renamed()
MyBase.Finalize()
End Sub
End Class
End Module