可用分押宝游戏火热进行中...	专题改版：Java Web 专题

请问怎样用VB程序自动生成、添加、修改、保存、调用.INI文件？（就是在程序运行中调用，但不添加任何VB部件及OCX控件）能给个范例吗？谢

楼主xiaoxpyao（逍遥小妖）2003-11-02 14:55:55 在 VB / API 提问

请问怎样用VB程序自动生成、添加、修改、保存、调用.INI文件？（就是在程序运行中调用，但不添加任何VB部件及OCX控件）能给个范例吗？谢谢
问题点数：50、回复次数：13Top

1 楼kinlin（小林）回复于 2003-11-02 15:42:38 得分 5

http://outinn.myrice.com/tip/t002.htmTop

2 楼qivictor（）回复于 2003-11-03 13:42:53 得分 5

'module
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

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
''''''''''''''
'frmcode
'''''''''''''''
NC = WritePrivateProfileString("Save", "Flag", (StrTmp1), StrFile)
NC = WritePrivateProfileString("Time", "Open", (TxtOpen), StrFile)
NC = WritePrivateProfileString("Time", "Step", (TxtStep), StrFile)
NC = WritePrivateProfileString("Time", "Reg", (TxtReg), StrFile)
'

'''
NC = GetPrivateProfileString("Time", "Open", "", StrTmp, 50, StrFile)
TxtOpen.Text = (Left(StrTmp, NC))

Top

3 楼subzero（赘姆烂壳）回复于 2003-11-03 19:47:36 得分 10

给你一个操作ini的类

Option Explicit

Public File As String

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 Integer, ByVal lpFileName As String) As Integer
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal Appname As String, ByVal KeyName As Any, ByVal NewString As Any, ByVal FileName As String) As Integer

Sub DeleteSection(ByVal Section As String)
Dim retval As Integer
retval = WritePrivateProfileString(Section, 0&, "", File)
End Sub

Public Function SaveSetting(ByVal Section$, ByVal Key$, ByVal Value$)
Dim retval As Integer
SaveSetting = WritePrivateProfileString(Section$, Key$, Value$, File)
End Function

Public Function GetSetting(ByVal Section As String, ByVal KeyName As String) As String
Dim retval As Integer
Dim t As String * 255

retval = GetPrivateProfileString(Section, KeyName, "unknown value", t, Len(t), File)

If retval > 0 Then
GetSetting = Left$(t, retval)
Else
GetSetting = ""
End If
End Function

Public Function GetSection(ByVal Section As String, KeyArray() As String) As Integer
Dim retval As Integer
Dim t As String * 2500
Dim lastpointer As Integer
Dim nullpointer As Integer
Dim ArrayCount As Integer
Dim keystring As String

ReDim KeyArray(0)

retval = GetPrivateProfileString(Section, 0&, "", t, Len(t), File)

If retval > 0 Then
nullpointer = InStr(t, Chr$(0))
lastpointer = 1
Do While (nullpointer <> 0 And nullpointer > lastpointer + 1)
keystring = Mid$(t, lastpointer, nullpointer - lastpointer)
ArrayCount = ArrayCount + 1
ReDim Preserve KeyArray(ArrayCount)
KeyArray(ArrayCount) = keystring
lastpointer = nullpointer + 1
nullpointer = InStr(nullpointer + 1, t, Chr$(0))
Loop
End If
GetSection = ArrayCount
End Function
Top

4 楼hongsongboy（红松）回复于 2003-11-03 20:03:39 得分 10

Private Declare Function GetPrivateProfileString Lib "Kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, lpKeyName As Any, ByVal lpDefault As String, ByVal lpRetunedString 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 lplFileName As String) As Long
Private R As Long
Private entry As String
Private iniPath As String

Private Sub Form_Load()
iniPath$ = Qpath & "set.ini" 'Qpath 为当前程序路径

End Sub

Function GetFromINI(AppName As String, KeyName As String, FileName As String) As String
Dim RetStr As String
RetStr = String(255, Chr(0))
GetFromINI = Left(RetStr, GetPrivateProfileString(AppName, ByVal KeyName, "", RetStr, Len(RetStr), FileName))
End Function
'''''
Text2 = GetFromINI("dwbm", "1J", iniPath)'取出ini文件中字段的内容
R = WritePrivateProfileString("dwbm", "1J", Text2.Text, iniPath)'保存到ini文件中相应字段的内容
Top

5 楼boyzhang（张郎)(爱你爱到Windows没BUG的那天）回复于 2003-11-03 20:29:22 得分 10

'Copy到Module
Option Explicit

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 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

Public Function ReadString(cSection As String, cKey As String, cPath As String) As String
Dim cStrNum As Integer, cString As String * 128

GetPrivateProfileString cSection, cKey, "", cString, 128, cPath
cStrNum = InStr(cString, Chr(0))
ReadString = Trim(Left(cString, cStrNum - 1))
End Function

Public Function WriteString(cSection As String, cKey As String, cString As String, cPath As String) As Boolean
cString = cString & Chr(0)
If LenB(StrConv(cString, vbUnicode)) <= 128 Then
WritePrivateProfileString cSection, cKey, cString, cPath
WriteString = True
Else
MsgBox "对不起，字符串超出范围！", vbExclamation
WriteString = False
End If
End Function

'调用

'......................
'读取键值
'iniValue变量储存健值
Dim IniValue As String
IniValue = ReadString("字段", "属性", "路径")
'.....................

'.....................
'写入键值
'变量CheckWrite判断写入是否成功
Dim CheckWrite As Boolean
CheckWrite = WriteString("字段", "属性", "键值", "路径")
'CheckWrite=True则表示写入成功,False表示写入失败
'.....................
Top

6 楼xiaoxpyao（逍遥小妖）回复于 2003-11-08 23:23:28 得分 0

UP！UP!!Top

7 楼Gelim（Gelim）回复于 2003-11-09 00:43:43 得分 10

以下程序希望能对你有用。

Private Sub Command1_Click() 'write ini file
Dim myini As New Cls_INI

myini.File = "c:\1.ini"

myini.SaveSetting "我的电脑信息", "电脑名称", "联想电脑"
myini.SaveSetting "我的电脑信息", "操作系统", "WindowsXP"
myini.SaveSetting "我的电脑信息", "价钱", "7500元"

myini.SaveSetting "我的打印机信息", "打印机名称", "联想打印机"
myini.SaveSetting "我的打印机信息", "型号", "lenovo"
myini.SaveSetting "我的打印机信息", "价钱", "500元"

Set myini = Nothing
End Sub

Private Sub Command2_Click() 'read ini file

Dim myini As New Cls_INI

myini.File = "c:\1.ini"

Dim a As Integer
Dim b() As String
Dim c As String

a = myini.GetSection("我的电脑信息", b)
'b里保存的就是在[我的电脑信息]中的各主键名称
'这里为b(1)="电脑名称",b(1)="操作系统",b(1)="价钱"

c = myini.GetSetting("我的电脑信息", "操作系统")
'c得到的是[我的电脑信息]中主键为操作系统的设定值
'c在这里为WindowsXP

Set myini = Nothing
End Sub

另外，我给你发了源代码了！如果收到就给个消息！有问题继续联系！Top

8 楼DIPDARK（滴哒）回复于 2003-11-09 11:19:09 得分 0

fn=freefile
open "d:\x.ini" for binary
get fn,datanumber,data '读
put fn,datanumber,data '写
close

vb的二进制文件读写语句Top

9 楼xiaoxpyao（逍遥小妖）回复于 2003-11-23 12:04:49 得分 0

我还是不太明白怎样读取~~~
麻烦了~~~~Top

10 楼planetike（胜哥哥）回复于 2003-11-23 18:28:41 得分 0

'两个函数 , 先在一个模快中定义API函数
Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationname As String, ByVal LpKeyName As Any, ByVal lsString As Any, ByVal lplFilename As String) As Long
'如果是读INT值可以用字符串转化，所以没有另外定义函数
'Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPriviteProfileIntA" (ByVal lpApplicationname As String, ByVal LpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
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 Long, ByVal lpFileName As String) As Long

'定义读与写INI文件的函数
'＊＊＊＊读INI文件＊＊＊＊
'文件名 lpFileName 如果不存在会自己创建,如果只有文件名，默认在Windows\system目录下
'[lpAppName]
'lpKeyName=取回的设置值
'lpDefault 当键值不存在时的默认值
Public Function ReadINI(lpFileName As String, lpAppName As String, LpKeyName As String) As String
Dim Temp As String * 20
Dim lpDefault As String
lpDefault = ""
If GetPrivateProfileString(lpAppName, LpKeyName, lpDefault, Temp, Len(Temp), lpFileName) <= 0 Then
ReadINI = ""
Else
ReadINI = MyTrim(Temp) 'MyTrim函数见下
End If
End Function
'＊＊＊＊写INI文件＊＊＊＊
'[lpAppName]
'lpKeyName=lpString
Public Function WriteINI(lpFileName As String, lpAppName As String, LpKeyName As String, lpString As String) As Boolean
If WritePrivateProfileString(lpAppName, LpKeyName, lpString, lpFileName) = 0 Then
WriteINI = False
Else
WriteINI = True
End If
End Function

'包含三个函数，分别取Rtrim,Ltrim,Trim
'可以去字符串中如ASC码为0,10,13,32的字符
Public Function MyRtrim(Tmpstr As String)
Dim i, s As Integer
i = Len(Tmpstr)
If i = 0 Then
MyRtrim = ""
Exit Function
End If
s = Asc(Right(Tmpstr, 1))
While (s = 0 Or s = 13 Or s = 10 Or s = 32) And i > 0
i = i - 1
Tmpstr = Left(Tmpstr, i)
If Len(Tmpstr) = 0 Then
MyRtrim = ""
Exit Function
End If
s = Asc(Right(Tmpstr, 1))
Wend
MyRtrim = Tmpstr
End Function

Public Function MyLtrim(Tmpstr As String)
Dim i, s As Integer
i = Len(Tmpstr)
If i = 0 Then
MyLtrim = ""
Exit Function
End If
s = Asc(Left(Tmpstr, 1))
While (s = 0 Or s = 13 Or s = 10 Or s = 32) And i > 0
i = i - 1
Tmpstr = Right(Tmpstr, i)
If Len(Tmpstr) = 0 Then
MyLtrim = Tmpstr
Exit Function
End If
s = Asc(Left(Tmpstr, 1))
Wend
MyLtrim = Tmpstr
End Function

Public Function MyTrim(Tmpstr As String)
Tmpstr = MyLtrim(Tmpstr)
Tmpstr = MyRtrim(Tmpstr)
MyTrim = Tmpstr
End Function

例子：writeINI("c:\a.ini","test","kkk","这是一个例子")
msgbox readINI("c:\a.ini","test","kkk")Top

11 楼Huaraco（孤星之旅）回复于 2003-12-07 08:21:25 得分 0

我想问一下，ini文件和普通的文本文件有什么不同？Top

12 楼eastbug（东方小虫）回复于 2003-12-07 09:18:28 得分 0

大多ini文件根本就是文本文件，只是这个文件里的字符很有规律而已。
至于ini文件的读写，建立等等楼上各位已经说的很清楚了，我就不罗嗦了。Top

13 楼gameexp（）回复于 2003-12-09 10:32:41 得分 0

WritePrivateProfileString在98下写ini文件时效率很底，很多情况下打不开刚写入的应有的数据。在2k下也问题。比如说经常有这样的应用，在做报表打印预览后台处理时需要写一些临时文件，在生成每条记录的时候要写这样的ini文件。但该API在写入几条数据后就后面的信息就会不可见或成乱码。对于报表的Grid字段分栏、换行、分割等处理来说该函数的性能成为了瓶颈。Top