你可以用API函数,非常简单下次上网时给你一个完整的程序代码

解决方案 »

  1.   

    Attribute VB_Name = "ModuleIni"
    Option ExplicitPrivate 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 AppName As String, ByVal KeyName As String, ByVal keydefault As String, ByVal Filename As String) As LongPrivate sDefInitFileName As String'读取Ini文件
    Public Function GetInitEntry(ByVal sSection As String, ByVal sKeyName As String, Optional ByVal sDefault As String = "", Optional ByVal sInitFileName As String = "") As StringDim sBuffer As String
    Dim sInitFile As String    If Len(sInitFileName) = 0 Then
            If Len(sDefInitFileName) = 0 Then
                sDefInitFileName = App.Path
                If Right$(sDefInitFileName, 1) <> "\" Then
                    sDefInitFileName = sDefInitFileName & "\"
                End If
                sDefInitFileName = sDefInitFileName & App.EXEName & ".ini"
            End If
            sInitFile = sDefInitFileName
        Else
            sInitFile = sInitFileName
        End If
        
        sBuffer = String$(2048, " ")
        GetInitEntry = Left$(sBuffer, GetPrivateProfileString(sSection, ByVal sKeyName, sDefault, sBuffer, Len(sBuffer), sInitFile))End Function'写Ini文件
    Public Function SetInitEntry(ByVal sSection As String, Optional ByVal sKeyName As String, Optional ByVal sValue As String, Optional ByVal sInitFileName As String = "") As LongDim sInitFile As String    If Len(sInitFileName) = 0 Then
            If Len(sDefInitFileName) = 0 Then
                sDefInitFileName = App.Path
                If Right$(sDefInitFileName, 1) <> "\" Then
                    sDefInitFileName = sDefInitFileName & "\"
                End If
                sDefInitFileName = sDefInitFileName & App.EXEName & ".ini"
            End If
            sInitFile = sDefInitFileName
        Else
            sInitFile = sInitFileName
        End If
        
        If Len(sKeyName) > 0 And Len(sValue) > 0 Then
            SetInitEntry = WritePrivateProfileString(sSection, ByVal sKeyName, ByVal sValue, sInitFile)
        ElseIf Len(sKeyName) > 0 Then
            SetInitEntry = WritePrivateProfileString(sSection, ByVal sKeyName, vbNullString, sInitFile)
        Else
            SetInitEntry = WritePrivateProfileString(sSection, vbNullString, vbNullString, sInitFile)
        End IfEnd Function
    '加密/解密字符串
    Function Encrypt_String(OldStr As String) As String
        Dim MyEncrypt As New Encrypt
        
        MyEncrypt.KeyString = "SG"
        Encrypt_String = MyEncrypt.Encrypt(OldStr)
    End Function
      

  2.   

    Attribute VB_Name = "ModuleIni"
    Option ExplicitPrivate 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 AppName As String, ByVal KeyName As String, ByVal keydefault As String, ByVal Filename As String) As LongPrivate sDefInitFileName As String'读取Ini文件
    Public Function GetInitEntry(ByVal sSection As String, ByVal sKeyName As String, Optional ByVal sDefault As String = "", Optional ByVal sInitFileName As String = "") As StringDim sBuffer As String
    Dim sInitFile As String    If Len(sInitFileName) = 0 Then
            If Len(sDefInitFileName) = 0 Then
                sDefInitFileName = App.Path
                If Right$(sDefInitFileName, 1) <> "\" Then
                    sDefInitFileName = sDefInitFileName & "\"
                End If
                sDefInitFileName = sDefInitFileName & App.EXEName & ".ini"
            End If
            sInitFile = sDefInitFileName
        Else
            sInitFile = sInitFileName
        End If
        
        sBuffer = String$(2048, " ")
        GetInitEntry = Left$(sBuffer, GetPrivateProfileString(sSection, ByVal sKeyName, sDefault, sBuffer, Len(sBuffer), sInitFile))End Function'写Ini文件
    Public Function SetInitEntry(ByVal sSection As String, Optional ByVal sKeyName As String, Optional ByVal sValue As String, Optional ByVal sInitFileName As String = "") As LongDim sInitFile As String    If Len(sInitFileName) = 0 Then
            If Len(sDefInitFileName) = 0 Then
                sDefInitFileName = App.Path
                If Right$(sDefInitFileName, 1) <> "\" Then
                    sDefInitFileName = sDefInitFileName & "\"
                End If
                sDefInitFileName = sDefInitFileName & App.EXEName & ".ini"
            End If
            sInitFile = sDefInitFileName
        Else
            sInitFile = sInitFileName
        End If
        
        If Len(sKeyName) > 0 And Len(sValue) > 0 Then
            SetInitEntry = WritePrivateProfileString(sSection, ByVal sKeyName, ByVal sValue, sInitFile)
        ElseIf Len(sKeyName) > 0 Then
            SetInitEntry = WritePrivateProfileString(sSection, ByVal sKeyName, vbNullString, sInitFile)
        Else
            SetInitEntry = WritePrivateProfileString(sSection, vbNullString, vbNullString, sInitFile)
        End IfEnd Function
    '加密/解密字符串
    Function Encrypt_String(OldStr As String) As String
        Dim MyEncrypt As New Encrypt
        
        MyEncrypt.KeyString = "SG"
        Encrypt_String = MyEncrypt.Encrypt(OldStr)
    End Function
      

  3.   

    Private Sub cmdChg_Click()
        Dim oldpwd As String
        
        oldpwd = GetInitEntry("SYSTEM", "PASSWORD", "", App.Path & "\system.ini")
        'oldpwd = Encrypt_String(GetSetting("Test App", "SYSTEM", "Password", ""))
        
        If Text1.Text <> oldpwd Then
            MsgBox "Invalid Old Password!"
                    Text1.SetFocus
            SendKeys "{HOME}+{END}"
            Exit Sub
        End If
        
        SetInitEntry "SYSTEM", "PASSWORD", Text2.Text, App.Path & "\system.ini"
        'SaveSetting "Test App", "SYSTEM", "Password", Encrypt_String(Text2.Text)
        MsgBox "Password Changed!"
        Unload Me
        frmLogin.Show
    End Sub
      

  4.   

    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 AppName As String, ByVal KeyName As String, ByVal keydefault As String, ByVal Filename As String) As LongPrivate sDefInitFileName As String'读取Ini文件
    Public Function GetInitEntry(ByVal sSection As String, ByVal sKeyName As String, Optional ByVal sDefault As String = "", Optional ByVal sInitFileName As String = "") As StringDim sBuffer As String
    Dim sInitFile As String    If Len(sInitFileName) = 0 Then
            If Len(sDefInitFileName) = 0 Then
                sDefInitFileName = App.Path
                If Right$(sDefInitFileName, 1) <> "\" Then
                    sDefInitFileName = sDefInitFileName & "\"
                End If
                sDefInitFileName = sDefInitFileName & App.EXEName & ".ini"
            End If
            sInitFile = sDefInitFileName
        Else
            sInitFile = sInitFileName
        End If
        
        sBuffer = String$(2048, " ")
        GetInitEntry = Left$(sBuffer, GetPrivateProfileString(sSection, ByVal sKeyName, sDefault, sBuffer, Len(sBuffer), sInitFile))End Function'写Ini文件
    Public Function SetInitEntry(ByVal sSection As String, Optional ByVal sKeyName As String, Optional ByVal sValue As String, Optional ByVal sInitFileName As String = "") As LongDim sInitFile As String    If Len(sInitFileName) = 0 Then
            If Len(sDefInitFileName) = 0 Then
                sDefInitFileName = App.Path
                If Right$(sDefInitFileName, 1) <> "\" Then
                    sDefInitFileName = sDefInitFileName & "\"
                End If
                sDefInitFileName = sDefInitFileName & App.EXEName & ".ini"
            End If
            sInitFile = sDefInitFileName
        Else
            sInitFile = sInitFileName
        End If
        
        If Len(sKeyName) > 0 And Len(sValue) > 0 Then
            SetInitEntry = WritePrivateProfileString(sSection, ByVal sKeyName, ByVal sValue, sInitFile)
        ElseIf Len(sKeyName) > 0 Then
            SetInitEntry = WritePrivateProfileString(sSection, ByVal sKeyName, vbNullString, sInitFile)
        Else
            SetInitEntry = WritePrivateProfileString(sSection, vbNullString, vbNullString, sInitFile)
        End IfEnd Function破CSDN没有贴完就说不能回复超过三次!!!
    以上放到模块中'读
    oldpwd = GetInitEntry("SYSTEM", "PASSWORD", "", App.Path & "\system.ini")
    '写
    SetInitEntry "SYSTEM", "PASSWORD", Text2.Text, App.Path & "\system.ini"
      

  5.   

    读写INI文件的四个函数'文件名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 FunctionPublic 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 FunctionPublic 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(源代码数据库)
               复制时间: 2002-04-22 15:55:17
               当前版本: 1.0.598
                   作者: Shawls
               个人主页: Http://Shawls.Yeah.Net
                 E-Mail: [email protected]
                     QQ: 9181729
      

  6.   

    好麻烦呀
    写一个文本文件
    OPEN,INPUT,CLOSE,就搞定了,多简单呀,一样能完成任务。
      

  7.   

    都这么长啊?
    这是偶在vbgood上找到的很好用!虽然进入win95之後,一般读写ini文件被读写Registry所取代,但我们还是可以透过
    win31的传统方式读写ini文件,以存程式目前的相关设定,而於下一次程式执行时再
    读回来。目前建议使用GetSetting SaveSetting的方式存於Registry中,不用目前
    的方式。 储存程式的设定
    注释:请於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
      

  8.   

    好象以上都没有详细介绍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 cyminifile As Long
    cyminifile = WritePrivateProfileString("myinifile", "message1", Text1.Text, "c:\cym.ini")
    '在C盘CYM.INI文件建MYINIFILE小节将条目MESSAGE1内容设为TEXT1.TEXT的内容,如果没有CYM。INI文件将自动建立
    End SubPrivate Sub command2_click()
    Dim CYRINIFILE As Long
    Dim buff As String
    buff = String(255, 0)
    CYRINIFILE = GetPrivateProfileString("myinififle", "message1", "no", buff, 256, "c:\cym.ini")
    ’读C盘CYM.INI文件中MYINIFILE小节中MESSAGE1条目的内容放入BUFF中,如果没有MESSAGE1条目将NO标志返回给BUFF
    Text2.Text = BUFF‘显示内容
    End Sub