主页

怎么用vb读取INI里的各值

xiangyunff 2007-12-14 07:04:12

INI内容为未知
[section1]
keyword1=valuel
keyword2=value2
……
[section2]
keyword1=value1
keyword2=value2
……
我想读取 SECTION1的值和section1里的KEYWORD值

...全文

12 条回复

切换为时间正序

请发表友善的回复…

发表回复

fzx4936 2010-09-16

不好意思用红字还写错了
应该是VBNULLSTRING

回复赞

fzx4936 2010-09-16

INI中未知元素一律用VBNONESTRING来代替！
例如
lRet = GetPrivateProfileString(vbNullString, vbNullString, vbNullString, sBuf, 1024, App.Path & "\myini.ini")
可以取得所有的Section值
lRet = GetPrivateProfileString("XXXX", vbNullString, vbNullString, sBuf, 1024, App.Path & "\myini.ini")
可以取得XXXX所有的key值

回复赞

xtfgha 2010-09-14

不错的代码收藏了。。。

回复赞

HtSoft 2007-12-26

这样的代码网上到处都可以找的到
不过还是贴一个，让你参考参考：



Option Explicit

Public iniFileName As String 

Public Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long

Public 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

Public 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



'****************************************获取Ini字符串值(Function)******************************************

Function GetIniS(ByVal SectionName As String, ByVal KeyWord As String, ByVal DefString As String) As String

Dim ResultString As String * 144, Temp As Integer

Dim s As String, i As Integer

Temp% = GetPrivateProfileString(SectionName, KeyWord, "", ResultString, 144, AppProFileName(iniFileName))

'检索关键词的值

If Temp% > 0 Then '关键词的值不为空

s = ""

For i = 1 To 144

If Asc(Mid$(ResultString, i, 1)) = 0 Then

Exit For

Else

s = s & Mid$(ResultString, i, 1)

End If

Next

Else

Temp% = WritePrivateProfileString(SectionName, KeyWord, DefString, AppProFileName(iniFileName))

'将缺省值写入INI文件

s = DefString

End If

GetIniS = s

End Function



'**************************************获取Ini数值(Function)***************************************************

Function GetIniN(ByVal SectionName As String, ByVal KeyWord As String, ByVal DefValue As Long) As Integer

Dim d As Long, s As String

d = DefValue

GetIniN = GetPrivateProfileInt(SectionName, KeyWord, DefValue, AppProFileName(iniFileName))

If d <> DefValue Then

s = "" & d

d = WritePrivateProfileString(SectionName, KeyWord, s, AppProFileName(iniFileName))

End If

End Function



'***************************************写入字符串值(Sub)**************************************************

Sub SetIniS(ByVal SectionName As String, ByVal KeyWord As String, ByVal ValStr As String)

Dim res%

res% = WritePrivateProfileString(SectionName, KeyWord, ValStr, AppProFileName(iniFileName))

End Sub

'****************************************写入数值(Sub)******************************************************

Sub SetIniN(ByVal SectionName As String, ByVal KeyWord As String, ByVal ValInt As Long)

Dim res%, s$

s$ = Str$(ValInt)

res% = WritePrivateProfileString(SectionName, KeyWord, s$, AppProFileName(iniFileName))

End Sub





''这是我自已不知道怎样清除一个键(keyword) 时

'写的一个清除字符串值的过程，是有write函数写入一个空的值实现的，

'Sub DelIniS(ByVal SectionName As String, ByVal KeyWord As String)

'Dim retval As Integer

'retval = WritePrivateProfileString(SectionName, KeyWord, "", AppProFileName(iniFileName))

'End Sub

'其实0&表示前面的一个被清除，我多写了一个“”，如果是清除section就少写一个Key多一个“”。



'***************************************清除KeyWord"键"(Sub)*************************************************

Sub DelIniKey(ByVal SectionName As String, ByVal KeyWord As String)

Dim RetVal As Integer

RetVal = WritePrivateProfileString(SectionName, KeyWord, 0&, AppProFileName(iniFileName))

End Sub



'如果是清除section就少写一个Key多一个“”。

'**************************************清除 Section"段"(Sub)***********************************************

Sub DelIniSec(ByVal SectionName As String) '清除section

Dim RetVal As Integer

RetVal = WritePrivateProfileString(SectionName, 0&, "", AppProFileName(iniFileName))

End Sub



'*************************************定义Ini文件名(Function)***************************************************

'定义ini文件名

Function AppProFileName(iniFileName)

AppProFileName = App.Path & "\" & iniFileName & ".ini"

End Function



'#######################################################################





'用法: 首先 定义iniFileName="文件名" 不需要 加ini后缀

'这就是说，你可以赋值给iniFileName就可以写入记录，而且你可以随时写入不同的ini文件(不管这个文件是否已存在），通过修改这个公用变量。



'然后   DelInikey（ByVal SectionName As String, ByVal KeyWord As String） 清除键

          'DelIniSec(ByVal SectionName As String)) 清除部

          'SetIniN(ByVal SectionName As String, ByVal KeyWord As String, ByVal ValInt As Long) 写入数

          'GetIniN(ByVal SectionName As String, ByVal KeyWord As String, ByVal DefValue As Long)读取数

          'SetIniS (ByVal SectionName As String, ByVal KeyWord As String, ByVal ValStr As String) 写入字符

          'GetIniS(ByVal SectionName As String, ByVal KeyWord As String, ByVal ValStr As String) 读取字符



'调用例子如下:

'

'Sub RiniN()

'Dim Initemp As String

'    Initemp = iniFileName '暂存原来的Ini文件名

'    iniFileName = App.EXEName '写入到另外一个Ini文件，App.EXEName是你的程序的名程

'    If GetIniN("lstBackup", "backupnumber", 0) < lstBackUp.ListCount Then

'        '这里的第三个参数“0”表示在没有找到指定的键值时返回的缺省值为“0”

'        SetIniN "lstBackup", "backupnumber", lstBackUp.ListCount

'        '......

'    End If

'    iniFileName = Initemp '继续使用原来的Ini文件

'End Sub

回复赞

shawls 2007-12-26





'文件名SourceDB.ini文件 

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 



'以下两个函数,读/写ini文件,固定节点setting,in_key为写入/读取的主键 

'仅仅针对是非值 

'Y：yes,N：no,E：error 

Public   Function   GetIniTF(ByVal   In_Key   As   String)   As   Boolean 

On   Error   GoTo   GetIniTFErr 

GetIniTF   =   True 

Dim   GetStr   As   String 

GetStr   =   VBA.String(128,   0) 

GetPrivateProfileString   "Setting",   In_Key,   "",   GetStr,   256,   App.Path   &   "\SourceDB.ini" 

GetStr   =   VBA.Replace(GetStr,   VBA.Chr(0),   "") 

If   GetStr   =   "1"   Then 

      GetIniTF   =   True 

      GetStr   =   "" 

Else 

      GoTo   GetIniTFErr 

End   If 

Exit   Function 

GetIniTFErr: 

      Err.Clear 

      GetIniTF   =   False 

      GetStr   =   "" 

End   Function 



Public   Function   WriteIniTF(ByVal   In_Key   As   String,   ByVal   In_Data   As   Boolean)   As   Boolean 

On   Error   GoTo   WriteIniTFErr 

WriteIniTF   =   True 

If   In_Data   =   True   Then 

  WritePrivateProfileString   "Setting",   In_Key,   "1",   App.Path   &   "\SourceDB.ini" 

Else 

  WritePrivateProfileString   "Setting",   In_Key,   "0",   App.Path   &   "\SourceDB.ini" 

End   If 

Exit   Function 

WriteIniTFErr: 

      Err.Clear 

      WriteIniTF   =   False 

End   Function 





'以下两个函数,读/写ini文件,不固定节点,in_key为写入/读取的主键 

'针对字符串值 

'空值表示出错 

Public   Function   GetIniStr(ByVal   AppName   As   String,   ByVal   In_Key   As   String)   As   String 

On   Error   GoTo   GetIniStrErr 

If   VBA.Trim(In_Key)   =   ""   Then 

      GoTo   GetIniStrErr 

End   If 

Dim   GetStr   As   String 

GetStr   =   VBA.String(128,   0) 

  GetPrivateProfileString   AppName,   In_Key,   "",   GetStr,   256,   App.Path   &   "\SourceDB.ini" 

    GetStr   =   VBA.Replace(GetStr,   VBA.Chr(0),   "") 

If   GetStr   =   ""   Then 

      GoTo   GetIniStrErr 

Else 

      GetIniStr   =   GetStr 

      GetStr   =   "" 

End   If 

Exit   Function 

GetIniStrErr: 

      Err.Clear 

      GetIniStr   =   "" 

      GetStr   =   "" 

End   Function 



Public   Function   WriteIniStr(ByVal   AppName   As   String,   ByVal   In_Key   As   String,   ByVal   In_Data   As   String)   As   Boolean 

On   Error   GoTo   WriteIniStrErr 

WriteIniStr   =   True 

If   VBA.Trim(In_Data)   =   ""   Or   VBA.Trim(In_Key)   =   ""   Or   VBA.Trim(AppName)   =   ""   Then 

      GoTo   WriteIniStrErr 

Else 

  WritePrivateProfileString   AppName,   In_Key,   In_Data,   App.Path   &   "\SourceDB.ini" 

End   If 

Exit   Function 

WriteIniStrErr: 

      Err.Clear 

      WriteIniStr   =   False 

End   Function

回复赞

shawls 2007-12-26

[名称] 读写INI文件的四个函数

[数据来源] 自己制作

[来源时间] 2002.01.04

[内容简介] 空

[源代码内容]

'文件名SourceDB.ini文件
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

'以下两个函数,读/写ini文件,固定节点setting,in_key为写入/读取的主键
'仅仅针对是非值
'Y：yes,N：no,E：error
Public Function GetIniTF(ByVal In_Key As String) As Boolean
On Error GoTo GetIniTFErr
GetIniTF = True
Dim GetStr As String
GetStr = VBA.String(128, 0)
GetPrivateProfileString "Setting", In_Key, "", GetStr, 256, App.Path & "\SourceDB.ini"
GetStr = VBA.Replace(GetStr, VBA.Chr(0), "")
If GetStr = "1" Then
GetIniTF = True
GetStr = ""
Else
GoTo GetIniTFErr
End If
Exit Function
GetIniTFErr:
Err.Clear
GetIniTF = False
GetStr = ""
End Function

Public Function WriteIniTF(ByVal In_Key As String, ByVal In_Data As Boolean) As Boolean
On Error GoTo WriteIniTFErr
WriteIniTF = True
If In_Data = True Then
WritePrivateProfileString "Setting", In_Key, "1", App.Path & "\SourceDB.ini"
Else
WritePrivateProfileString "Setting", In_Key, "0", App.Path & "\SourceDB.ini"
End If
Exit Function
WriteIniTFErr:
Err.Clear
WriteIniTF = False
End Function

'以下两个函数,读/写ini文件,不固定节点,in_key为写入/读取的主键
'针对字符串值
'空值表示出错
Public Function GetIniStr(ByVal AppName As String, ByVal In_Key As String) As String
On Error GoTo GetIniStrErr
If VBA.Trim(In_Key) = "" Then
GoTo GetIniStrErr
End If
Dim GetStr As String
GetStr = VBA.String(128, 0)
GetPrivateProfileString AppName, In_Key, "", GetStr, 256, App.Path & "\SourceDB.ini"
GetStr = VBA.Replace(GetStr, VBA.Chr(0), "")
If GetStr = "" Then
GoTo GetIniStrErr
Else
GetIniStr = GetStr
GetStr = ""
End If
Exit Function
GetIniStrErr:
Err.Clear
GetIniStr = ""
GetStr = ""
End Function

Public Function WriteIniStr(ByVal AppName As String, ByVal In_Key As String, ByVal In_Data As String) As Boolean
On Error GoTo WriteIniStrErr
WriteIniStr = True
If VBA.Trim(In_Data) = "" Or VBA.Trim(In_Key) = "" Or VBA.Trim(AppName) = "" Then
GoTo WriteIniStrErr
Else
WritePrivateProfileString AppName, In_Key, In_Data, App.Path & "\SourceDB.ini"
End If
Exit Function
WriteIniStrErr:
Err.Clear
WriteIniStr = False
End Function

以上代码保存于： SourceCode Explorer(源代码数据库)
复制时间： 2007.12.26 17:29:09
软件版本： 1.0.882
软件作者： Shawls
E-Mail： ShawFile@163.com
QQ： 9181729

回复赞

tk600158 2007-12-26

反正达到效果就行了
我都是用



open app.path & "\a.ini" input as #1

do while not eof(1)

line input #1,a

msgbox a

loop

close #1

这样代码简单呵呵就是程序要慢点

回复赞

VisualBUG 2007-12-19

看我博客模块代码.
http://hi.baidu.com/%D2%E4%C4%EA%BB%AA/blog/item/378eb6bf3c09840918d81f06.html

回复赞

jsnjtian 2007-12-19

其中 GetPrivateProfileString 是一個api 函數

回复赞

jsnjtian 2007-12-19

filepath是ini文件所在路徑

回复赞

jsnjtian 2007-12-19

Public Function Get_INI_String(ByVal Section As String, ByVal Key As String, ByVal Default As String, ByVal INI_FileName As String) As String
Dim X As Integer
Const BufferSize = 256
Dim tmp As String * BufferSize

Section = Section + Chr$(0)
Key = Key + Chr$(0)
INI_FileName = INI_FileName + Chr$(0)

X = GetPrivateProfileString(Section, Key, Default, tmp, BufferSize, INI_FileName)
Get_INI_String = Left$(tmp, X)
End Function
主程序調用時候
dim temp1,temp2 as string
temp1 = Get_INI_String("setting1", "keyword1", 1, filepath)的路徑
temp2 = Get_INI_String("setting2", "keyword1", 1, filepath)
filepath是ini文件所在

回复赞

cangwu_lee 2007-12-15

Private Function readStr(ByVal sapp As String, ByVal skey As String, Optional ByVal def As String = "") As String
Dim t As String
Dim r As Long
t = String(256, Chr(0))
r = GetPrivateProfileString(sapp, skey, def, t, 256, iniFileName)
If r > 0 Then
readStr = LeftB(t, r)
ElseIf InStr(1, t, Chr(0), 0) > 0 Then
readStr = Left(t, InStr(1, t, Chr(0), 0) - 1)
End If
End Function

僅僅提供參考！

回复赞

发动态

发帖子

VB基础类

创建于2007-09-28

加入

7451

社区成员

19.7w+

社区内容

VB 基础类

申请成为版主

社区公告

暂无公告