自动换行 【由 孤帆代码着色器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 0
Private Declare Function GetPrivateProfileIntA Lib "kernel32" (ByVal Senction$, ByVal lpKeyName$, ByVal nDefault&, ByVal lpFileName$) As Long
Private Declare Function GetPrivateProfileSectionNamesA Lib "kernel32.dll" (ByVal szValue$, ByVal nSize&, ByVal szFileName$) As Long
Private Declare Function WritePrivateProfileSectionA Lib "kernel32" (ByVal Senction$, ByVal szValue$, ByVal szFileName$) As Long
Private Declare Function GetPrivateProfileSectionA Lib "kernel32" (ByVal Senction$, ByVal szValue As String, ByVal nSize&, ByVal szFileName$) As Long
Private Declare Function WritePrivateProfileStringA Lib "kernel32" (ByVal Section$, ByVal Key$, ByVal szValue$, ByVal lpFileName$) As Long
Private Declare Function GetPrivateProfileStringA Lib "kernel32" (ByVal Senction$, ByVal Key As Any, ByVal lpDefault$, _
ByVal szValue$, ByVal nSize As Long, ByVal szFileName$) As Long
Private m_Path$
'--------------------------------
' 一个ini段中的数据结构
' 通过次结构穷举指定段里的
' 键的数据
'--------------------------------
Public Type TSection
kName As String '键名
kValue As String '键值
End Type
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' 属性
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'*************************************************************************
' ini文件路径属性
'*************************************************************************
Public Property Let Path(ByVal szValue$)
m_Path = szValue
End Property
Public Property Get Path() As String
Path = m_Path
End 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 If
Out:
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 If
Out:
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 If
Out:
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 If
Out:
End Function