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

Question

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

Answer 1

'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 LongPublic 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))

Answer 2

给你一个操作ini的类Option ExplicitPublic File As StringPrivate 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 IntegerSub DeleteSection(ByVal Section As String)
Dim retval As Integer
   retval = WritePrivateProfileString(Section, 0&, "", File)
End SubPublic Function SaveSetting(ByVal Section$, ByVal Key$, ByVal Value$)
Dim retval As Integer
   SaveSetting = WritePrivateProfileString(Section$, Key$, Value$, File)
End FunctionPublic 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 FunctionPublic 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

Answer 3

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 StringPrivate Sub Form_Load()
iniPath$ = Qpath & "set.ini"  'Qpath 为当前程序路径End SubFunction 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文件中相应字段的内容

Answer 4

'Copy到Module
Option ExplicitPrivate 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 LongPublic 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 FunctionPublic 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表示写入失败
'.....................

Answer 5

以下程序希望能对你有用。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 SubPrivate 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另外，我给你发了源代码了！如果收到就给个消息！有问题继续联系！

Answer 6

fn=freefile
open "d:\x.ini" for binary
get fn,datanumber,data  '读 
put fn,datanumber,data  '写
closevb的二进制文件读写语句

Answer 7

'两个函数 , 先在一个模快中定义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 FunctionPublic 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 FunctionPublic 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")

Answer 8

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

Answer 9

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

Answer 10

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