vb怎样读写*.ini配置文件

建立与读取.ini文件
'请於form中放3个TextBox，一个CommandBox
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 LongPrivate Sub Command1_Click()
Dim success As Long
success = WritePrivateProfileString("MyApp", "text1", Text1.Text, "c:\aa.ini")
'叁数一 Section Name
'叁数二於.ini中的项目
'叁数三项目的内容
'叁数四 .ini文件的名称
success = WritePrivateProfileString("MyApp", "text2", Text2.Text, "c:\aa.ini")
success = WritePrivateProfileString("MyApp2", "text3", Text3.Text, "c:\aa.ini")
End SubPrivate Sub Form_load()
Dim ret As Long
Dim buff As String
buff = String(255, 0)
ret = GetPrivateProfileString("Myapp", "text1", "text1", buff, 256, "c:\aa.ini")
'若.ini MyApp中无text1，则采用叁数三的值
Text1.Text = buff
buff = String(255, 0)
ret = GetPrivateProfileString("Myapp", "text2", "text2", buff, 256, "c:\aa.ini")
Text2.Text = buff
buff = String(255, 0)
ret = GetPrivateProfileString("Myapp2", "text3", "text3", buff, 256, "c:\aa.ini")
Text3.Text = buff
End Sub

给你一个模块
Option Explicit'INI文件读取操作APIDeclare Function WritePrivateProfileString _
Lib "kernel32" Alias "WritePrivateProfileStringA" _
(ByVal lpApplicationname As String, ByVal _
lpKeyName As Any, ByVal lsString As Any, _
ByVal lplFilename As String) As LongDeclare 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 LongPublic Function GetIniStr(ByVal AppName As String, ByVal In_Key As String, ByVal sFileName As String) As String
'*******************************************
'读ini文件,不固定节点,in_key为读取的主键
'针对字符串值,空值表示出错
'*******************************************
    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, sFileName
      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, ByVal sFileName As String) As Boolean
'*******************************************
'写ini文件,不固定节点,in_key为写入的主键
'针对字符串值,False表示出错
'*******************************************
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, sFileName
    End If
    Exit Function

WriteIniStrErr:
       Err.Clear
       WriteIniStr = False
End Function

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) 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
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'写INI文件
Private Sub Command1_Click()
    Dim Counter As Long    For Counter = 1 To 4
        Call WriteToIni(App.Path & "\Options.ini", "Test", "Name" & Counter, "Value" & Counter)
    Next Counter
End Sub'读INI文件
Private Sub Command2_Click()
    Dim Counter As Long
    Dim Value(3) As String    For Counter = 1 To 4
        Value(Counter - 1) = ReadFromIni(App.Path & "\Options.ini", "Test", "Name" & Counter)
    Next Counter
End Sub

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
Private Sub Form_Load()    Dim Ret As String, NC As Long
    'Write the setting to the file (c:\test.ini) under
    '   Project1 -> Keyname
    WritePrivateProfileString App.Title, "KeyName", "This is the value", "c:\test.ini"
    'Create a buffer
    Ret = String(255, 0)
    'Retrieve the string
    NC = GetPrivateProfileString(App.Title, "KeyName", "Default", Ret, 255, "C:\test.ini")
    'NC is the number of characters copied to the buffer
    If NC <> 0 Then Ret = Left$(Ret, NC)
    'Show our string
    MsgBox Ret
    'Delete the file
    Kill "c:\test.ini"
End Sub

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

以前学习邹建的，我一直在用
方法：首先再模组里面写入：
1,'在d盤根目錄新建 aaa.ini文件'模擬程序
'模組中
Option Explicit'-------------------------
'聲明
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
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 Function MyGetSetting(Section As String, KeyName As String, DefaultValue As String) As String    Dim X As Long
    Dim Holder As String * 255    X = GetPrivateProfileString(Section, KeyName, DefaultValue, Holder, 254, "d:\aaa.ini")
    MyGetSetting = Left$(Holder, InStr(Holder, Chr$(0)) - 1)End Function'保存設置Public Sub MySetSetting(Section As String, KeyName As String, KeyValue As String)    Dim X As Long    X = WritePrivateProfileString(Section, KeyName, KeyValue, "d:\aaa.ini")End Sub
2,Form界面上：Private Sub Form_Load()    Dim strServer As String
    Dim strUID As String
    Dim strPWD As String
    Dim strDBName As String
    Dim strConString As String

    strServer = MyGetSetting("服務器名", "服務器名", "")
    strUID = MyGetSetting("用戶名", "用戶名", "")
    strPWD = MyGetSetting("密碼", "密碼", "")
    strDBName = MyGetSetting("數據庫名", "數據庫名", "")
    strConString = "Driver={SQL Server};Network Library=TCP/IP Sockets;SERVER=" & strServer & ";UID=" & strUID & ";PWD=" & strPWD & ";DATABASE=" & strDBName & ""

    conn.myconn.CommandTimeout = 30
    conn.myconn.Open strConString
End Sub调用MyGetSetting函数，在From_load从ini档里面读出信息，然后把服务器名，用户名，密码，数据库名串到字符串里面，然后打开3,执行SQL语句：
Private Sub Command1_Click()
   Dim rs As ADODB.Recordset
   Dim sql As String
   sql = "select * from student"
   Set rs = conn.myconn.Execute(sql)
   If rs.RecordCount > 0 Then
      Set TDBGrid2.DataSource = rs
   End If
End Sub4，验证代码：
写入ini 档
Private Sub Command3_Click()
  '保存變量
    MySetSetting "服務器名", "服務器名", "mis25"
    MySetSetting "用戶名", "用戶名", ""
    MySetSetting "密碼", "密碼", ""
    MySetSetting "數據庫名", "數據庫名", "hh"
    MsgBox "保存成功"End Sub
5，读出ini档里面的内容
Private Sub Command4_Click()
  '取出變量
    MsgBox MyGetSetting("服務器名", "服務器名", "")
    MsgBox MyGetSetting("用戶名", "用戶名", "")
    MsgBox MyGetSetting("密碼", "密碼", "")
    MsgBox MyGetSetting("數據庫名", "數據庫名", "")

End Sub6，如果想保存在当前路径下：则把上面的代码改为：
'獲得設置
Public Function MyGetSetting(Section As String, KeyName As String, DefaultValue As String) As String    Dim X As Long
    Dim Holder As String * 255  '  X = GetPrivateProfileString(Section, KeyName, DefaultValue, Holder, 254, "d:\aaa.ini")
   X = GetPrivateProfileString(Section, KeyName, DefaultValue, Holder, 254, App.Path & "\aaa.ini")

    MyGetSetting = Left$(Holder, InStr(Holder, Chr$(0)) - 1)End Function同样读出当前路径下的内容时，也把上面的代码改为'保存設置Public Sub MySetSetting(Section As String, KeyName As String, KeyValue As String)    Dim X As Long  '  X = WritePrivateProfileString(Section, KeyName, KeyValue, "d:\aaa.ini")
   X = WritePrivateProfileString(Section, KeyName, KeyValue, App.Path & "\aaa.ini")
End Sub1，在SQLServer数据库里面设置访问数据库的用户名和密码：
打开sqlserver------选择数据库下的User ----右键----New Database User---new
输入用户名和密码（2次）
2，写ini档，在ini档里面纪录用户名和密码：
3，用户使用时候只要copy 和 ini档文件就Ok,因为，程序里面设置读的是当前路径下的ini文档

调试易

vb怎样读写*.ini配置文件

解决方案 »