自动换行 【由 孤帆代码着色器1.1.0.0 着色】 孤帆Blog
Attribute VB_Name = "mIni"'*************************************************************************'**模 块 名：mIni'**说 明：孤帆 版权所有2005 - 2006(C)'**创 建 人：孤帆'**日 期：2005-5-25 13:16:33'**描 述：读写ini文件键值/段值模块（可以穷举一个ini文件里的所有段名'** 和指定段的键名/键值）'**版 本：V1.0.0'*************************************************************************Option Base 0Private Declare Function GetPrivateProfileIntA Lib "kernel32" (ByVal Senction$, ByVal lpKeyName$, ByVal nDefault&, ByVal lpFileName$) As LongPrivate Declare Function GetPrivateProfileSectionNamesA Lib "kernel32.dll" (ByVal szValue$, ByVal nSize&, ByVal szFileName$) As LongPrivate Declare Function WritePrivateProfileSectionA Lib "kernel32" (ByVal Senction$, ByVal szValue$, ByVal szFileName$) As LongPrivate Declare Function GetPrivateProfileSectionA Lib "kernel32" (ByVal Senction$, ByVal szValue As String, ByVal nSize&, ByVal szFileName$) As LongPrivate Declare Function WritePrivateProfileStringA Lib "kernel32" (ByVal Section$, ByVal Key$, ByVal szValue$, ByVal lpFileName$) As LongPrivate Declare Function GetPrivateProfileStringA Lib "kernel32" (ByVal Senction$, ByVal Key As Any, ByVal lpDefault$, _ ByVal szValue$, ByVal nSize As Long, ByVal szFileName$) As LongPrivate m_Path$'--------------------------------' 一个ini段中的数据结构' 通过次结构穷举指定段里的' 键的数据'--------------------------------Public Type TSection kName As String '键名 kValue As String '键值End Type'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<' 属性'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'*************************************************************************' ini文件路径属性'*************************************************************************Public Property Let Path(ByVal szValue$) m_Path = szValueEnd PropertyPublic Property Get Path() As String Path = m_PathEnd Property'*************************************************************************' 获取当前程序文件路径(后加"/")'*************************************************************************Property Get AppPath() As String AppPath = App.Path If Right$(AppPath, 1) <> "/" Then AppPath = AppPath & "/"End Property'*************************************************************************' 锁定ini文件属性' 参 数：是否锁定'*************************************************************************Property Let Locked(ByVal bYes As Boolean) On Error GoTo Out If bYes Then Call SetAttr(m_Path, vbNormal) Else Call SetAttr(m_Path, vbHidden Or vbReadOnly Or vbSystem) End IfOut:End Property'*************************************************************************' 获取ini文件大小属性'*************************************************************************Property Get iniSize() As Long iniSize = FileLen(m_Path)End Property'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<' 读写ini键值'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'*************************************************************************' 读取ini段里的字符串键值' 参 数：段名，键名，键值' 返回值：键值'*************************************************************************Function getStrKey(ByVal Section$, ByVal KeyName$, Optional ByVal szDefaultValue$ = vbNullString) As String Dim szBuffer$, nLen% szBuffer = String$(1024, 0) nLen = GetPrivateProfileStringA(Section, KeyName, szDefaultValue, szBuffer, 1024, m_Path) If nLen > 0 Then getStrKey = Left$(szBuffer, nLen)End Function'*************************************************************************' 写ini段里的字符串键值' 参 数：段名，键名，键值' 返回值：成功则为true'*************************************************************************Function setStrKey(ByVal Section$, ByVal KeyName$, Optional ByVal szValue$ = vbNullString) As Boolean setStrKey = WritePrivateProfileStringA(Section, KeyName, szValue, m_Path)End Function'*************************************************************************' 读取ini段里的整形键值' 参 数：段名，键名，键值' 返回值：键值'*************************************************************************Function getIntKey(ByVal Section$, ByVal KeyName$, Optional DefaultValue& = -1) As Long getIntKey = GetPrivateProfileIntA(Section, KeyName, DefaultValue, m_Path)End Function'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<' 读写ini段值'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'*************************************************************************' 读取ini段里的所有字符串到一个TSection结构的数组里' 参 数：段名，提供返回段中字符串的动态TSection数组' 返回值：成功则返回数组下限，否则返回-1'*************************************************************************Function getStrSection2Structs(ByVal Section$, rSection() As TSection) As Long Dim strTmp() As String, strTmp2() As String, szBuffer$ Dim nLen%, I%, Bottom% szBuffer = String$(32767, 0) nLen = GetPrivateProfileSectionA(Section, szBuffer, 32767, m_Path) If nLen > 0 Then On Error GoTo Out szBuffer = Left$(szBuffer, nLen) Tmp2 = Split(szBuffer, vbNullChar, nLen) '分解出每一个键的数据 Bottom = UBound(Tmp2) - 1 ReDim rSection(Bottom) For I = 0 To Bottom Tmp = Split(Tmp2(I), "=") '分解键名和键值 rSection(I).kName = Tmp(0) rSection(I).kValue = Tmp(1) Next getStrSection2Structs = Bottom Else getStrSection2Structs = -1 End IfOut:End Function'*************************************************************************' 读取ini段里的所有字符串' 参 数：段名，提供返回段中字符串的动态字符串数组(每一行一个元素)' 返回值：成功则返回数组下限，否则返回-1'*************************************************************************Function getStrSection(ByVal Section$, rValue() As String) As Long Dim szBuffer$ Dim nLen%, I%, Bottom% szBuffer = String$(32767, 0) nLen = GetPrivateProfileSectionA(Section, szBuffer, 32767, m_Path) If nLen > 0 Then On Error GoTo Out szBuffer = Left$(szBuffer, nLen) rValue = Split(szBuffer, vbNullChar, nLen) Bottom = UBound(rValue) - 1 getStrSection = Bottom Else getStrSection = -1 End IfOut:End Function'*************************************************************************' 写一个ini段' 参 数：段名，段值(缺省为删除这个段,键与键之间的数据以vbNullChar分隔且以vbNullChar结尾)' 返回值：成功则为true'*************************************************************************Function setStrSection(ByVal Section$, Optional ByVal szValue$ = vbNullString) As Boolean setStrSection = WritePrivateProfileSectionA(Section, szValue, m_Path)End Function'*************************************************************************' 读取ini文件里的所有段名' 参 数：提供返回段名的动态字符串数组' 返回值：成功则返回数组下限，否则返回-1'*************************************************************************Function getSectionsName(rSectionName() As String) As Long Dim szBuffer$, nLen% szBuffer = String(1024, 0) nLen = GetPrivateProfileSectionNamesA(szBuffer, 1024, m_Path) If nLen = 0 Then getSectionsName = -1 Exit Function End If If nLen > 0 Then szBuffer = Left$(szBuffer, nLen) On Error GoTo Out rSectionName = Split(szBuffer, vbNullChar, nLen) getSectionsName = UBound(rSectionName) - 1 End IfOut:End Function
