[111111]
aa=11
bb=22
如何可以取得[]中的111111,使用API,而不是使用OPEN 读取?
5 个解决方案
#1
有專門的API函數來讀的。
GOOGLE搜索一下吧。
GOOGLE搜索一下吧。
#2
把下面的代码保存为 classIniFile.cls ,然后加入工程。怎么用这个类,不用再多说了吧!:)
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "Class1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'--------classIniFile.cls 代码----------------
'这里定义了一个classIniFile类
'一个绝对经典的在VB中操作.ini文件的通用类源代码
Private strINI As String
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 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 Function MakePath(ByVal strDrv As String, ByVal strDir As String) As String
' Makes an INI file: Guarantees a sub dir
Do While Right$(strDrv, 1) = "\"
strDrv = Left$(strDrv, Len(strDrv) - 1)
Loop
Do While Left$(strDir, 1) = "\"
strDir = Mid$(strDir, 2)
Loop
' Return the path
MakePath = strDrv & "\" & strDir
End Function
Private Sub CreateIni(strDrv As String, strDir As String)
' Make a new ini file
strINI = MakePath(strDrv, strDir)
End Sub
Public Sub WriteIniKey(strSection As String, strKey As String, strValue As String)
' Write to strINI
WritePrivateProfileString strSection, strKey, strValue, strINI
End Sub
Public Function GetIniKey(strSection As String, strKey As String) As String
Dim strTmp As String
Dim lngRet As String
Dim I As Integer
Dim strTmp2 As String
strTmp = String$(1024, Chr(32))
lngRet = GetPrivateProfileString(strSection, strKey, "", strTmp, Len(strTmp), strINI)
strTmp = Trim(strTmp)
strTmp2 = ""
For I = 1 To Len(strTmp)
If Asc(Mid(strTmp, I, 1)) <> 0 Then
strTmp2 = strTmp2 + Mid(strTmp, I, 1)
End If
Next I
strTmp = strTmp2
GetIniKey = strTmp
End Function
Public Property Let INIFileName(ByVal New_IniPath As String)
' Sets the new ini path
strINI = New_IniPath
End Property
Public Property Get INIFileName() As String
' Returns the current ini path
INIFileName = strINI
End Property
'***************************************清除KeyWord"键"(Sub)***********************************************
Public Function DelIniKey(ByVal SectionName As String, ByVal KeyWord As String)
Dim RetVal As Integer
RetVal = WritePrivateProfileString(SectionName, KeyWord, 0&, strINI)
End Function
'如果是清除section就少写一个Key多一个""。
'**************************************清除 Section"段"(Sub)***********************************************
Public Function DelIniSec(ByVal SectionName As String) '清除section
Dim RetVal As Integer
RetVal = WritePrivateProfileString(SectionName, 0&, "", strINI)
End Function
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "Class1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'--------classIniFile.cls 代码----------------
'这里定义了一个classIniFile类
'一个绝对经典的在VB中操作.ini文件的通用类源代码
Private strINI As String
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 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 Function MakePath(ByVal strDrv As String, ByVal strDir As String) As String
' Makes an INI file: Guarantees a sub dir
Do While Right$(strDrv, 1) = "\"
strDrv = Left$(strDrv, Len(strDrv) - 1)
Loop
Do While Left$(strDir, 1) = "\"
strDir = Mid$(strDir, 2)
Loop
' Return the path
MakePath = strDrv & "\" & strDir
End Function
Private Sub CreateIni(strDrv As String, strDir As String)
' Make a new ini file
strINI = MakePath(strDrv, strDir)
End Sub
Public Sub WriteIniKey(strSection As String, strKey As String, strValue As String)
' Write to strINI
WritePrivateProfileString strSection, strKey, strValue, strINI
End Sub
Public Function GetIniKey(strSection As String, strKey As String) As String
Dim strTmp As String
Dim lngRet As String
Dim I As Integer
Dim strTmp2 As String
strTmp = String$(1024, Chr(32))
lngRet = GetPrivateProfileString(strSection, strKey, "", strTmp, Len(strTmp), strINI)
strTmp = Trim(strTmp)
strTmp2 = ""
For I = 1 To Len(strTmp)
If Asc(Mid(strTmp, I, 1)) <> 0 Then
strTmp2 = strTmp2 + Mid(strTmp, I, 1)
End If
Next I
strTmp = strTmp2
GetIniKey = strTmp
End Function
Public Property Let INIFileName(ByVal New_IniPath As String)
' Sets the new ini path
strINI = New_IniPath
End Property
Public Property Get INIFileName() As String
' Returns the current ini path
INIFileName = strINI
End Property
'***************************************清除KeyWord"键"(Sub)***********************************************
Public Function DelIniKey(ByVal SectionName As String, ByVal KeyWord As String)
Dim RetVal As Integer
RetVal = WritePrivateProfileString(SectionName, KeyWord, 0&, strINI)
End Function
'如果是清除section就少写一个Key多一个""。
'**************************************清除 Section"段"(Sub)***********************************************
Public Function DelIniSec(ByVal SectionName As String) '清除section
Dim RetVal As Integer
RetVal = WritePrivateProfileString(SectionName, 0&, "", strINI)
End Function
#3
Attribute VB_Name = "ini_old"
Option Explicit
'/******************************************************\
'模块说明:
' INI文件读写for vb
'实现过程:
' 由于98下用api写入后不能立刻变换文件(缓冲问题)
' 所以仿照
' API WritePrivateProfileString
' API GetPrivateProfileString
' 采用VB+API试探API INI函数工作原理改写
' 编写了一个
'具体细节有下:
'1: 任何一行先经过trim处理
' 2:如果left(line,1)="["说明为一个section
' 然后往后查找"]"或者该行结束,表示找到一个section
' 3:如果ucase(trim(section))=ucase(trim(section input))
' 说明找到正确的section
' 4:接着往下找key,先找=号。左边为key,右边为value
' 5:如果ucase(trim(key))=ucase(trim(key input))
' 说明找到正确的section
' 6:如果ucase(trim(vale))的被"或者'包括。则取里面数据
' 7:如果在没找key之前发现文件结束,或者找到"["
' 说明里面不包含key
' -----
' 关于write操作
'8: 如果没找到section文件结束.则开始追加section , Key, Value
' 最后一行(只不包含回车符的一行,下同)经过trim操作后
' 如果为空.则用section , Key, value替换最后一行
' 否则 在最后一行下面追加section, Key, Value
' 9: 如果找到了section.
' 找到了key , 则替换该行
' 没找到key , 文件结束(找到最后一行), 或者找到新的section
' 则在该行(最后一行或新的section)前插入section,key,value
'发行:
' 版本 1#
' 日期 2004年3月22日
' 作者 胡俊杰
'\******************************************************/
'//////////////////////////////////////////////////////////////////////////////////
'函数名: GetProfile
'函数功能: 读INI
'函数参数: strFileName 文件名, strSection 段, strName 名称
'返回值: key内容
'完成日期: 2004-3-22
'//////////////////////////////////////////////////////////////////////////////////
Public Function GetProfile(ByVal strFileName As String, ByVal strSection As String, _
ByVal strName As String) As String
On Error GoTo errHandle
Dim lngFileNumber As Long, pos As Long
Dim strTemp As String
'check file exist?
If Dir(strFileName) = "" Then Exit Function
lngFileNumber = 0
lngFileNumber = FreeFile()
Open strFileName For Input As #lngFileNumber
strSection = Trim(strSection)
strName = Trim(strName)
'try to found section
Do
If EOF(lngFileNumber) Then Close #lngFileNumber: Exit Function
Line Input #1, strTemp
strTemp = Trim(strTemp)
If Left(strTemp, 1) = "[" Then
For pos = 2 To Len(strTemp)
If Mid(strTemp, pos, 1) = "]" Then Exit For
Next pos
If UCase(Trim(Mid(strTemp, 2, pos - 2))) = UCase(strSection) Then Exit Do
End If
Loop
'try to found name
Do
If EOF(lngFileNumber) Then Close #lngFileNumber: Exit Function
Line Input #1, strTemp
strTemp = Trim(strTemp)
If Left(strTemp, 1) = "[" Then Close #lngFileNumber: Exit Function
pos = InStr(1, strTemp, "=", vbTextCompare)
If pos <> 0 Then
If UCase(Trim(Left(strTemp, pos - 1))) = UCase(strName) Then Exit Do
End If
Loop
'get value
GetProfile = Trim(Mid(strTemp, pos + 1))
If ((Left(GetProfile, 1) = "'" And Right(GetProfile, 1) = "'") Or _
(Left(GetProfile, 1) = """" And Right(GetProfile, 1) = """")) And Len(GetProfile) >= 2 Then
GetProfile = Mid(GetProfile, 2, Len(GetProfile) - 2)
End If
errHandle:
If lngFileNumber <> 0 Then Close #lngFileNumber
End Function
'//////////////////////////////////////////////////////////////////////////////////
'函数名: SetProfile
'函数功能: 写INI
'函数参数: strFileName 文件名, strSection 段, strName 名称, strSave 内容
'返回值: 是否成功
'完成日期: 2004-3-22
'//////////////////////////////////////////////////////////////////////////////////
Public Function SetProfile(strFileName As String, strSection As String, _
strName As String, strSave As String) As Boolean
On Error GoTo errHandle
Dim lngFileNumber As Long, pos As Long
Dim strTemp As String, strFileBak() As String, i As Long, j As Long, mode As Long
lngFileNumber = 0: mode = 0
strSection = Trim(strSection)
strName = Trim(strName)
'check file exist or filelen = 0?
If Dir(strFileName) <> "" Then
If FileLen(strFileName) > 0 Then GoTo lbl_1
End If
lngFileNumber = FreeFile
Open strFileName For Output As #lngFileNumber
Print #lngFileNumber, "[" & strSection & "]"
Print #lngFileNumber, strName & " = " & """" & strSave & """"
Close #lngFileNumber
SetProfile = True
Exit Function
lbl_1:
'read file to buff
lngFileNumber = FreeFile
i = 0
Open strFileName For Input As #lngFileNumber
Do
If EOF(lngFileNumber) Then Exit Do
Line Input #lngFileNumber, strTemp
ReDim Preserve strFileBak(i)
strFileBak(i) = Trim(strTemp)
i = i + 1
Loop
Close #lngFileNumber
'try to found section
mode = 0
For i = 0 To UBound(strFileBak)
If Left(strFileBak(i), 1) = "[" Then
For pos = 2 To Len(strFileBak(i))
If Mid(strFileBak(i), pos, 1) = "]" Then Exit For
Next pos
If UCase(Trim(Mid(strFileBak(i), 2, pos - 2))) = UCase(strSection) Then Exit For
End If
Next i
If i > UBound(strFileBak) Then GoTo lbl_over
'try to found name
mode = 1
For i = i + 1 To UBound(strFileBak)
If Left(strFileBak(i), 1) = "[" Then GoTo lbl_over
pos = InStr(1, strFileBak(i), "=", vbTextCompare)
If pos <> 0 Then
If UCase(Trim(Left(strFileBak(i), pos - 1))) = UCase(strName) Then Exit For
End If
Next i
If i > UBound(strFileBak) Then GoTo lbl_over
'found name
mode = 2
'set values
lbl_over:
'mode 0 found nothing
'mode 1 found section
'mode 2 found name
lngFileNumber = FreeFile
Open strFileName For Output As #lngFileNumber
For j = 0 To i - 1
Print #lngFileNumber, strFileBak(j)
Next j
'------------
If mode = 0 Then 'print section
Print #lngFileNumber, "[" & strSection & "]"
End If
Print #lngFileNumber, strName & " = " & """" & strSave & """"
'------------
If i <= UBound(strFileBak) Then 'file not over
If mode <> 2 Then
Print #lngFileNumber, strFileBak(i)
End If
For j = i + 1 To UBound(strFileBak)
Print #lngFileNumber, strFileBak(j)
Next j
End If
SetProfile = True
errHandle:
If lngFileNumber <> 0 Then Close #lngFileNumber
End Function
Option Explicit
'/******************************************************\
'模块说明:
' INI文件读写for vb
'实现过程:
' 由于98下用api写入后不能立刻变换文件(缓冲问题)
' 所以仿照
' API WritePrivateProfileString
' API GetPrivateProfileString
' 采用VB+API试探API INI函数工作原理改写
' 编写了一个
'具体细节有下:
'1: 任何一行先经过trim处理
' 2:如果left(line,1)="["说明为一个section
' 然后往后查找"]"或者该行结束,表示找到一个section
' 3:如果ucase(trim(section))=ucase(trim(section input))
' 说明找到正确的section
' 4:接着往下找key,先找=号。左边为key,右边为value
' 5:如果ucase(trim(key))=ucase(trim(key input))
' 说明找到正确的section
' 6:如果ucase(trim(vale))的被"或者'包括。则取里面数据
' 7:如果在没找key之前发现文件结束,或者找到"["
' 说明里面不包含key
' -----
' 关于write操作
'8: 如果没找到section文件结束.则开始追加section , Key, Value
' 最后一行(只不包含回车符的一行,下同)经过trim操作后
' 如果为空.则用section , Key, value替换最后一行
' 否则 在最后一行下面追加section, Key, Value
' 9: 如果找到了section.
' 找到了key , 则替换该行
' 没找到key , 文件结束(找到最后一行), 或者找到新的section
' 则在该行(最后一行或新的section)前插入section,key,value
'发行:
' 版本 1#
' 日期 2004年3月22日
' 作者 胡俊杰
'\******************************************************/
'//////////////////////////////////////////////////////////////////////////////////
'函数名: GetProfile
'函数功能: 读INI
'函数参数: strFileName 文件名, strSection 段, strName 名称
'返回值: key内容
'完成日期: 2004-3-22
'//////////////////////////////////////////////////////////////////////////////////
Public Function GetProfile(ByVal strFileName As String, ByVal strSection As String, _
ByVal strName As String) As String
On Error GoTo errHandle
Dim lngFileNumber As Long, pos As Long
Dim strTemp As String
'check file exist?
If Dir(strFileName) = "" Then Exit Function
lngFileNumber = 0
lngFileNumber = FreeFile()
Open strFileName For Input As #lngFileNumber
strSection = Trim(strSection)
strName = Trim(strName)
'try to found section
Do
If EOF(lngFileNumber) Then Close #lngFileNumber: Exit Function
Line Input #1, strTemp
strTemp = Trim(strTemp)
If Left(strTemp, 1) = "[" Then
For pos = 2 To Len(strTemp)
If Mid(strTemp, pos, 1) = "]" Then Exit For
Next pos
If UCase(Trim(Mid(strTemp, 2, pos - 2))) = UCase(strSection) Then Exit Do
End If
Loop
'try to found name
Do
If EOF(lngFileNumber) Then Close #lngFileNumber: Exit Function
Line Input #1, strTemp
strTemp = Trim(strTemp)
If Left(strTemp, 1) = "[" Then Close #lngFileNumber: Exit Function
pos = InStr(1, strTemp, "=", vbTextCompare)
If pos <> 0 Then
If UCase(Trim(Left(strTemp, pos - 1))) = UCase(strName) Then Exit Do
End If
Loop
'get value
GetProfile = Trim(Mid(strTemp, pos + 1))
If ((Left(GetProfile, 1) = "'" And Right(GetProfile, 1) = "'") Or _
(Left(GetProfile, 1) = """" And Right(GetProfile, 1) = """")) And Len(GetProfile) >= 2 Then
GetProfile = Mid(GetProfile, 2, Len(GetProfile) - 2)
End If
errHandle:
If lngFileNumber <> 0 Then Close #lngFileNumber
End Function
'//////////////////////////////////////////////////////////////////////////////////
'函数名: SetProfile
'函数功能: 写INI
'函数参数: strFileName 文件名, strSection 段, strName 名称, strSave 内容
'返回值: 是否成功
'完成日期: 2004-3-22
'//////////////////////////////////////////////////////////////////////////////////
Public Function SetProfile(strFileName As String, strSection As String, _
strName As String, strSave As String) As Boolean
On Error GoTo errHandle
Dim lngFileNumber As Long, pos As Long
Dim strTemp As String, strFileBak() As String, i As Long, j As Long, mode As Long
lngFileNumber = 0: mode = 0
strSection = Trim(strSection)
strName = Trim(strName)
'check file exist or filelen = 0?
If Dir(strFileName) <> "" Then
If FileLen(strFileName) > 0 Then GoTo lbl_1
End If
lngFileNumber = FreeFile
Open strFileName For Output As #lngFileNumber
Print #lngFileNumber, "[" & strSection & "]"
Print #lngFileNumber, strName & " = " & """" & strSave & """"
Close #lngFileNumber
SetProfile = True
Exit Function
lbl_1:
'read file to buff
lngFileNumber = FreeFile
i = 0
Open strFileName For Input As #lngFileNumber
Do
If EOF(lngFileNumber) Then Exit Do
Line Input #lngFileNumber, strTemp
ReDim Preserve strFileBak(i)
strFileBak(i) = Trim(strTemp)
i = i + 1
Loop
Close #lngFileNumber
'try to found section
mode = 0
For i = 0 To UBound(strFileBak)
If Left(strFileBak(i), 1) = "[" Then
For pos = 2 To Len(strFileBak(i))
If Mid(strFileBak(i), pos, 1) = "]" Then Exit For
Next pos
If UCase(Trim(Mid(strFileBak(i), 2, pos - 2))) = UCase(strSection) Then Exit For
End If
Next i
If i > UBound(strFileBak) Then GoTo lbl_over
'try to found name
mode = 1
For i = i + 1 To UBound(strFileBak)
If Left(strFileBak(i), 1) = "[" Then GoTo lbl_over
pos = InStr(1, strFileBak(i), "=", vbTextCompare)
If pos <> 0 Then
If UCase(Trim(Left(strFileBak(i), pos - 1))) = UCase(strName) Then Exit For
End If
Next i
If i > UBound(strFileBak) Then GoTo lbl_over
'found name
mode = 2
'set values
lbl_over:
'mode 0 found nothing
'mode 1 found section
'mode 2 found name
lngFileNumber = FreeFile
Open strFileName For Output As #lngFileNumber
For j = 0 To i - 1
Print #lngFileNumber, strFileBak(j)
Next j
'------------
If mode = 0 Then 'print section
Print #lngFileNumber, "[" & strSection & "]"
End If
Print #lngFileNumber, strName & " = " & """" & strSave & """"
'------------
If i <= UBound(strFileBak) Then 'file not over
If mode <> 2 Then
Print #lngFileNumber, strFileBak(i)
End If
For j = i + 1 To UBound(strFileBak)
Print #lngFileNumber, strFileBak(j)
Next j
End If
SetProfile = True
errHandle:
If lngFileNumber <> 0 Then Close #lngFileNumber
End Function
#4
如果你只是要读取ini 的一个小节,很容易的.用WritePrivateProfileSection 函数,就可以达到目的了
'声明api
Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
'把下面的的代码 Private Sub Command1_Click()
Dim s As String, l As Long, ret As Long
l = 1024
s = String(l, Chr(0))
ret = GetPrivateProfileSection(Section, s, l, IniPath)
If ret <> 0 Then
s = Left(s, InStr(s, Chr(0) & Chr(0)) - 1)
End If
End Sub
's 是你读出来的一个小节的内容
各个key 是已chr(0)分割的.最后一个key 以两个chr(0) 结尾
'声明api
Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
'把下面的的代码 Private Sub Command1_Click()
Dim s As String, l As Long, ret As Long
l = 1024
s = String(l, Chr(0))
ret = GetPrivateProfileSection(Section, s, l, IniPath)
If ret <> 0 Then
s = Left(s, InStr(s, Chr(0) & Chr(0)) - 1)
End If
End Sub
's 是你读出来的一个小节的内容
各个key 是已chr(0)分割的.最后一个key 以两个chr(0) 结尾
#5
mark
#1
有專門的API函數來讀的。
GOOGLE搜索一下吧。
GOOGLE搜索一下吧。
#2
把下面的代码保存为 classIniFile.cls ,然后加入工程。怎么用这个类,不用再多说了吧!:)
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "Class1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'--------classIniFile.cls 代码----------------
'这里定义了一个classIniFile类
'一个绝对经典的在VB中操作.ini文件的通用类源代码
Private strINI As String
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 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 Function MakePath(ByVal strDrv As String, ByVal strDir As String) As String
' Makes an INI file: Guarantees a sub dir
Do While Right$(strDrv, 1) = "\"
strDrv = Left$(strDrv, Len(strDrv) - 1)
Loop
Do While Left$(strDir, 1) = "\"
strDir = Mid$(strDir, 2)
Loop
' Return the path
MakePath = strDrv & "\" & strDir
End Function
Private Sub CreateIni(strDrv As String, strDir As String)
' Make a new ini file
strINI = MakePath(strDrv, strDir)
End Sub
Public Sub WriteIniKey(strSection As String, strKey As String, strValue As String)
' Write to strINI
WritePrivateProfileString strSection, strKey, strValue, strINI
End Sub
Public Function GetIniKey(strSection As String, strKey As String) As String
Dim strTmp As String
Dim lngRet As String
Dim I As Integer
Dim strTmp2 As String
strTmp = String$(1024, Chr(32))
lngRet = GetPrivateProfileString(strSection, strKey, "", strTmp, Len(strTmp), strINI)
strTmp = Trim(strTmp)
strTmp2 = ""
For I = 1 To Len(strTmp)
If Asc(Mid(strTmp, I, 1)) <> 0 Then
strTmp2 = strTmp2 + Mid(strTmp, I, 1)
End If
Next I
strTmp = strTmp2
GetIniKey = strTmp
End Function
Public Property Let INIFileName(ByVal New_IniPath As String)
' Sets the new ini path
strINI = New_IniPath
End Property
Public Property Get INIFileName() As String
' Returns the current ini path
INIFileName = strINI
End Property
'***************************************清除KeyWord"键"(Sub)***********************************************
Public Function DelIniKey(ByVal SectionName As String, ByVal KeyWord As String)
Dim RetVal As Integer
RetVal = WritePrivateProfileString(SectionName, KeyWord, 0&, strINI)
End Function
'如果是清除section就少写一个Key多一个""。
'**************************************清除 Section"段"(Sub)***********************************************
Public Function DelIniSec(ByVal SectionName As String) '清除section
Dim RetVal As Integer
RetVal = WritePrivateProfileString(SectionName, 0&, "", strINI)
End Function
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "Class1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'--------classIniFile.cls 代码----------------
'这里定义了一个classIniFile类
'一个绝对经典的在VB中操作.ini文件的通用类源代码
Private strINI As String
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 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 Function MakePath(ByVal strDrv As String, ByVal strDir As String) As String
' Makes an INI file: Guarantees a sub dir
Do While Right$(strDrv, 1) = "\"
strDrv = Left$(strDrv, Len(strDrv) - 1)
Loop
Do While Left$(strDir, 1) = "\"
strDir = Mid$(strDir, 2)
Loop
' Return the path
MakePath = strDrv & "\" & strDir
End Function
Private Sub CreateIni(strDrv As String, strDir As String)
' Make a new ini file
strINI = MakePath(strDrv, strDir)
End Sub
Public Sub WriteIniKey(strSection As String, strKey As String, strValue As String)
' Write to strINI
WritePrivateProfileString strSection, strKey, strValue, strINI
End Sub
Public Function GetIniKey(strSection As String, strKey As String) As String
Dim strTmp As String
Dim lngRet As String
Dim I As Integer
Dim strTmp2 As String
strTmp = String$(1024, Chr(32))
lngRet = GetPrivateProfileString(strSection, strKey, "", strTmp, Len(strTmp), strINI)
strTmp = Trim(strTmp)
strTmp2 = ""
For I = 1 To Len(strTmp)
If Asc(Mid(strTmp, I, 1)) <> 0 Then
strTmp2 = strTmp2 + Mid(strTmp, I, 1)
End If
Next I
strTmp = strTmp2
GetIniKey = strTmp
End Function
Public Property Let INIFileName(ByVal New_IniPath As String)
' Sets the new ini path
strINI = New_IniPath
End Property
Public Property Get INIFileName() As String
' Returns the current ini path
INIFileName = strINI
End Property
'***************************************清除KeyWord"键"(Sub)***********************************************
Public Function DelIniKey(ByVal SectionName As String, ByVal KeyWord As String)
Dim RetVal As Integer
RetVal = WritePrivateProfileString(SectionName, KeyWord, 0&, strINI)
End Function
'如果是清除section就少写一个Key多一个""。
'**************************************清除 Section"段"(Sub)***********************************************
Public Function DelIniSec(ByVal SectionName As String) '清除section
Dim RetVal As Integer
RetVal = WritePrivateProfileString(SectionName, 0&, "", strINI)
End Function
#3
Attribute VB_Name = "ini_old"
Option Explicit
'/******************************************************\
'模块说明:
' INI文件读写for vb
'实现过程:
' 由于98下用api写入后不能立刻变换文件(缓冲问题)
' 所以仿照
' API WritePrivateProfileString
' API GetPrivateProfileString
' 采用VB+API试探API INI函数工作原理改写
' 编写了一个
'具体细节有下:
'1: 任何一行先经过trim处理
' 2:如果left(line,1)="["说明为一个section
' 然后往后查找"]"或者该行结束,表示找到一个section
' 3:如果ucase(trim(section))=ucase(trim(section input))
' 说明找到正确的section
' 4:接着往下找key,先找=号。左边为key,右边为value
' 5:如果ucase(trim(key))=ucase(trim(key input))
' 说明找到正确的section
' 6:如果ucase(trim(vale))的被"或者'包括。则取里面数据
' 7:如果在没找key之前发现文件结束,或者找到"["
' 说明里面不包含key
' -----
' 关于write操作
'8: 如果没找到section文件结束.则开始追加section , Key, Value
' 最后一行(只不包含回车符的一行,下同)经过trim操作后
' 如果为空.则用section , Key, value替换最后一行
' 否则 在最后一行下面追加section, Key, Value
' 9: 如果找到了section.
' 找到了key , 则替换该行
' 没找到key , 文件结束(找到最后一行), 或者找到新的section
' 则在该行(最后一行或新的section)前插入section,key,value
'发行:
' 版本 1#
' 日期 2004年3月22日
' 作者 胡俊杰
'\******************************************************/
'//////////////////////////////////////////////////////////////////////////////////
'函数名: GetProfile
'函数功能: 读INI
'函数参数: strFileName 文件名, strSection 段, strName 名称
'返回值: key内容
'完成日期: 2004-3-22
'//////////////////////////////////////////////////////////////////////////////////
Public Function GetProfile(ByVal strFileName As String, ByVal strSection As String, _
ByVal strName As String) As String
On Error GoTo errHandle
Dim lngFileNumber As Long, pos As Long
Dim strTemp As String
'check file exist?
If Dir(strFileName) = "" Then Exit Function
lngFileNumber = 0
lngFileNumber = FreeFile()
Open strFileName For Input As #lngFileNumber
strSection = Trim(strSection)
strName = Trim(strName)
'try to found section
Do
If EOF(lngFileNumber) Then Close #lngFileNumber: Exit Function
Line Input #1, strTemp
strTemp = Trim(strTemp)
If Left(strTemp, 1) = "[" Then
For pos = 2 To Len(strTemp)
If Mid(strTemp, pos, 1) = "]" Then Exit For
Next pos
If UCase(Trim(Mid(strTemp, 2, pos - 2))) = UCase(strSection) Then Exit Do
End If
Loop
'try to found name
Do
If EOF(lngFileNumber) Then Close #lngFileNumber: Exit Function
Line Input #1, strTemp
strTemp = Trim(strTemp)
If Left(strTemp, 1) = "[" Then Close #lngFileNumber: Exit Function
pos = InStr(1, strTemp, "=", vbTextCompare)
If pos <> 0 Then
If UCase(Trim(Left(strTemp, pos - 1))) = UCase(strName) Then Exit Do
End If
Loop
'get value
GetProfile = Trim(Mid(strTemp, pos + 1))
If ((Left(GetProfile, 1) = "'" And Right(GetProfile, 1) = "'") Or _
(Left(GetProfile, 1) = """" And Right(GetProfile, 1) = """")) And Len(GetProfile) >= 2 Then
GetProfile = Mid(GetProfile, 2, Len(GetProfile) - 2)
End If
errHandle:
If lngFileNumber <> 0 Then Close #lngFileNumber
End Function
'//////////////////////////////////////////////////////////////////////////////////
'函数名: SetProfile
'函数功能: 写INI
'函数参数: strFileName 文件名, strSection 段, strName 名称, strSave 内容
'返回值: 是否成功
'完成日期: 2004-3-22
'//////////////////////////////////////////////////////////////////////////////////
Public Function SetProfile(strFileName As String, strSection As String, _
strName As String, strSave As String) As Boolean
On Error GoTo errHandle
Dim lngFileNumber As Long, pos As Long
Dim strTemp As String, strFileBak() As String, i As Long, j As Long, mode As Long
lngFileNumber = 0: mode = 0
strSection = Trim(strSection)
strName = Trim(strName)
'check file exist or filelen = 0?
If Dir(strFileName) <> "" Then
If FileLen(strFileName) > 0 Then GoTo lbl_1
End If
lngFileNumber = FreeFile
Open strFileName For Output As #lngFileNumber
Print #lngFileNumber, "[" & strSection & "]"
Print #lngFileNumber, strName & " = " & """" & strSave & """"
Close #lngFileNumber
SetProfile = True
Exit Function
lbl_1:
'read file to buff
lngFileNumber = FreeFile
i = 0
Open strFileName For Input As #lngFileNumber
Do
If EOF(lngFileNumber) Then Exit Do
Line Input #lngFileNumber, strTemp
ReDim Preserve strFileBak(i)
strFileBak(i) = Trim(strTemp)
i = i + 1
Loop
Close #lngFileNumber
'try to found section
mode = 0
For i = 0 To UBound(strFileBak)
If Left(strFileBak(i), 1) = "[" Then
For pos = 2 To Len(strFileBak(i))
If Mid(strFileBak(i), pos, 1) = "]" Then Exit For
Next pos
If UCase(Trim(Mid(strFileBak(i), 2, pos - 2))) = UCase(strSection) Then Exit For
End If
Next i
If i > UBound(strFileBak) Then GoTo lbl_over
'try to found name
mode = 1
For i = i + 1 To UBound(strFileBak)
If Left(strFileBak(i), 1) = "[" Then GoTo lbl_over
pos = InStr(1, strFileBak(i), "=", vbTextCompare)
If pos <> 0 Then
If UCase(Trim(Left(strFileBak(i), pos - 1))) = UCase(strName) Then Exit For
End If
Next i
If i > UBound(strFileBak) Then GoTo lbl_over
'found name
mode = 2
'set values
lbl_over:
'mode 0 found nothing
'mode 1 found section
'mode 2 found name
lngFileNumber = FreeFile
Open strFileName For Output As #lngFileNumber
For j = 0 To i - 1
Print #lngFileNumber, strFileBak(j)
Next j
'------------
If mode = 0 Then 'print section
Print #lngFileNumber, "[" & strSection & "]"
End If
Print #lngFileNumber, strName & " = " & """" & strSave & """"
'------------
If i <= UBound(strFileBak) Then 'file not over
If mode <> 2 Then
Print #lngFileNumber, strFileBak(i)
End If
For j = i + 1 To UBound(strFileBak)
Print #lngFileNumber, strFileBak(j)
Next j
End If
SetProfile = True
errHandle:
If lngFileNumber <> 0 Then Close #lngFileNumber
End Function
Option Explicit
'/******************************************************\
'模块说明:
' INI文件读写for vb
'实现过程:
' 由于98下用api写入后不能立刻变换文件(缓冲问题)
' 所以仿照
' API WritePrivateProfileString
' API GetPrivateProfileString
' 采用VB+API试探API INI函数工作原理改写
' 编写了一个
'具体细节有下:
'1: 任何一行先经过trim处理
' 2:如果left(line,1)="["说明为一个section
' 然后往后查找"]"或者该行结束,表示找到一个section
' 3:如果ucase(trim(section))=ucase(trim(section input))
' 说明找到正确的section
' 4:接着往下找key,先找=号。左边为key,右边为value
' 5:如果ucase(trim(key))=ucase(trim(key input))
' 说明找到正确的section
' 6:如果ucase(trim(vale))的被"或者'包括。则取里面数据
' 7:如果在没找key之前发现文件结束,或者找到"["
' 说明里面不包含key
' -----
' 关于write操作
'8: 如果没找到section文件结束.则开始追加section , Key, Value
' 最后一行(只不包含回车符的一行,下同)经过trim操作后
' 如果为空.则用section , Key, value替换最后一行
' 否则 在最后一行下面追加section, Key, Value
' 9: 如果找到了section.
' 找到了key , 则替换该行
' 没找到key , 文件结束(找到最后一行), 或者找到新的section
' 则在该行(最后一行或新的section)前插入section,key,value
'发行:
' 版本 1#
' 日期 2004年3月22日
' 作者 胡俊杰
'\******************************************************/
'//////////////////////////////////////////////////////////////////////////////////
'函数名: GetProfile
'函数功能: 读INI
'函数参数: strFileName 文件名, strSection 段, strName 名称
'返回值: key内容
'完成日期: 2004-3-22
'//////////////////////////////////////////////////////////////////////////////////
Public Function GetProfile(ByVal strFileName As String, ByVal strSection As String, _
ByVal strName As String) As String
On Error GoTo errHandle
Dim lngFileNumber As Long, pos As Long
Dim strTemp As String
'check file exist?
If Dir(strFileName) = "" Then Exit Function
lngFileNumber = 0
lngFileNumber = FreeFile()
Open strFileName For Input As #lngFileNumber
strSection = Trim(strSection)
strName = Trim(strName)
'try to found section
Do
If EOF(lngFileNumber) Then Close #lngFileNumber: Exit Function
Line Input #1, strTemp
strTemp = Trim(strTemp)
If Left(strTemp, 1) = "[" Then
For pos = 2 To Len(strTemp)
If Mid(strTemp, pos, 1) = "]" Then Exit For
Next pos
If UCase(Trim(Mid(strTemp, 2, pos - 2))) = UCase(strSection) Then Exit Do
End If
Loop
'try to found name
Do
If EOF(lngFileNumber) Then Close #lngFileNumber: Exit Function
Line Input #1, strTemp
strTemp = Trim(strTemp)
If Left(strTemp, 1) = "[" Then Close #lngFileNumber: Exit Function
pos = InStr(1, strTemp, "=", vbTextCompare)
If pos <> 0 Then
If UCase(Trim(Left(strTemp, pos - 1))) = UCase(strName) Then Exit Do
End If
Loop
'get value
GetProfile = Trim(Mid(strTemp, pos + 1))
If ((Left(GetProfile, 1) = "'" And Right(GetProfile, 1) = "'") Or _
(Left(GetProfile, 1) = """" And Right(GetProfile, 1) = """")) And Len(GetProfile) >= 2 Then
GetProfile = Mid(GetProfile, 2, Len(GetProfile) - 2)
End If
errHandle:
If lngFileNumber <> 0 Then Close #lngFileNumber
End Function
'//////////////////////////////////////////////////////////////////////////////////
'函数名: SetProfile
'函数功能: 写INI
'函数参数: strFileName 文件名, strSection 段, strName 名称, strSave 内容
'返回值: 是否成功
'完成日期: 2004-3-22
'//////////////////////////////////////////////////////////////////////////////////
Public Function SetProfile(strFileName As String, strSection As String, _
strName As String, strSave As String) As Boolean
On Error GoTo errHandle
Dim lngFileNumber As Long, pos As Long
Dim strTemp As String, strFileBak() As String, i As Long, j As Long, mode As Long
lngFileNumber = 0: mode = 0
strSection = Trim(strSection)
strName = Trim(strName)
'check file exist or filelen = 0?
If Dir(strFileName) <> "" Then
If FileLen(strFileName) > 0 Then GoTo lbl_1
End If
lngFileNumber = FreeFile
Open strFileName For Output As #lngFileNumber
Print #lngFileNumber, "[" & strSection & "]"
Print #lngFileNumber, strName & " = " & """" & strSave & """"
Close #lngFileNumber
SetProfile = True
Exit Function
lbl_1:
'read file to buff
lngFileNumber = FreeFile
i = 0
Open strFileName For Input As #lngFileNumber
Do
If EOF(lngFileNumber) Then Exit Do
Line Input #lngFileNumber, strTemp
ReDim Preserve strFileBak(i)
strFileBak(i) = Trim(strTemp)
i = i + 1
Loop
Close #lngFileNumber
'try to found section
mode = 0
For i = 0 To UBound(strFileBak)
If Left(strFileBak(i), 1) = "[" Then
For pos = 2 To Len(strFileBak(i))
If Mid(strFileBak(i), pos, 1) = "]" Then Exit For
Next pos
If UCase(Trim(Mid(strFileBak(i), 2, pos - 2))) = UCase(strSection) Then Exit For
End If
Next i
If i > UBound(strFileBak) Then GoTo lbl_over
'try to found name
mode = 1
For i = i + 1 To UBound(strFileBak)
If Left(strFileBak(i), 1) = "[" Then GoTo lbl_over
pos = InStr(1, strFileBak(i), "=", vbTextCompare)
If pos <> 0 Then
If UCase(Trim(Left(strFileBak(i), pos - 1))) = UCase(strName) Then Exit For
End If
Next i
If i > UBound(strFileBak) Then GoTo lbl_over
'found name
mode = 2
'set values
lbl_over:
'mode 0 found nothing
'mode 1 found section
'mode 2 found name
lngFileNumber = FreeFile
Open strFileName For Output As #lngFileNumber
For j = 0 To i - 1
Print #lngFileNumber, strFileBak(j)
Next j
'------------
If mode = 0 Then 'print section
Print #lngFileNumber, "[" & strSection & "]"
End If
Print #lngFileNumber, strName & " = " & """" & strSave & """"
'------------
If i <= UBound(strFileBak) Then 'file not over
If mode <> 2 Then
Print #lngFileNumber, strFileBak(i)
End If
For j = i + 1 To UBound(strFileBak)
Print #lngFileNumber, strFileBak(j)
Next j
End If
SetProfile = True
errHandle:
If lngFileNumber <> 0 Then Close #lngFileNumber
End Function
#4
如果你只是要读取ini 的一个小节,很容易的.用WritePrivateProfileSection 函数,就可以达到目的了
'声明api
Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
'把下面的的代码 Private Sub Command1_Click()
Dim s As String, l As Long, ret As Long
l = 1024
s = String(l, Chr(0))
ret = GetPrivateProfileSection(Section, s, l, IniPath)
If ret <> 0 Then
s = Left(s, InStr(s, Chr(0) & Chr(0)) - 1)
End If
End Sub
's 是你读出来的一个小节的内容
各个key 是已chr(0)分割的.最后一个key 以两个chr(0) 结尾
'声明api
Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
'把下面的的代码 Private Sub Command1_Click()
Dim s As String, l As Long, ret As Long
l = 1024
s = String(l, Chr(0))
ret = GetPrivateProfileSection(Section, s, l, IniPath)
If ret <> 0 Then
s = Left(s, InStr(s, Chr(0) & Chr(0)) - 1)
End If
End Sub
's 是你读出来的一个小节的内容
各个key 是已chr(0)分割的.最后一个key 以两个chr(0) 结尾
#5
mark