程序代码：

Public 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
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
Private Function encode(ByVal s As String) As String '加密
    If Len(s) = 0 Then Exit Function
    Dim buff() As Byte
    buff = StrConv(s, vbFromUnicode)
    Dim i As Long
    Dim j As Byte
    Dim K As Byte, m As Byte
    Dim mstr As String
    mstr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyz"
    Dim outs As String
    i = UBound(buff) + 1
    outs = Space(2 * i)
    Dim temps As String
    For i = 0 To UBound(buff)
        Randomize Time
        j = CByte(5 * (Math.Rnd()) + 0) '最大产生的随机数只能是5，不能再大了,再大的话，就要多用一个字节
        buff(i) = buff(i) Xor j
        K = buff(i) Mod Len(mstr)
        m = buff(i) \ Len(mstr)
        m = m * 2 ^ 3 + j
        temps = Mid(mstr, K + 1, 1) + Mid(mstr, m + 1, 1)
        Mid(outs, 2 * i + 1, 2) = temps
    Next
    encode = outs
End Function
Private Function decode(ByVal s As String) As String '解密
    On Error GoTo myERR
    Dim i As Long
    Dim j As Byte
    Dim K As Byte
    Dim m As Byte
    Dim mstr As String
    mstr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyz"
    Dim t1 As String, t2 As String
    Dim buff() As Byte
    Dim n As Long
    n = 0
    For i = 1 To Len(s) Step 2
        t1 = Mid(s, i, 1)
        t2 = Mid(s, i + 1, 1)
        K = InStr(1, mstr, t1) - 1
        m = InStr(1, mstr, t2) - 1
        j = m \ 2 ^ 3
        m = m - j * 2 ^ 3
        ReDim Preserve buff(n)
        buff(n) = j * Len(mstr) + K
        buff(n) = buff(n) Xor m
        n = n + 1
    Next
    decode = StrConv(buff, vbUnicode)
    Exit Function
myERR:
    decode = ""
End Function

Public Function ReadInIPwd(ByVal SectionName, ByVal KeyWord, FileName, pwd) As String
    Dim ResultString As String * 1024, Temp As Integer, DefString As String
    Dim s As String, i As Integer
    If Left(FileName, 1) = "\" Then FileName = Right(FileName, Len(FileName) - 1)
    If InStr(FileName, ":") = 0 Then FileName = sPath & FileName
    
    '    SectionName = decode(CStr(SectionName))
    '    KeyWord = decode(CStr(KeyWord))
  
    
    Temp% = GetPrivateProfileString(SectionName, KeyWord, "", ResultString, 1024, FileName)
    '检索关键词的值
    
    If Temp% > 0 Then '关键词的值不为空
        s = ""
        ResultString = decode(CStr(ResultString))
        Debug.Print "ResultString=" + ResultString, Temp%
        For i = 1 To 1024
            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, FileName)
        '将缺省值写入INI文件
        s = DefString
    End If
    ReadInIPwd = s
End Function
Public Function WriteIniPwd(ByVal SectionName, ByVal KeyWord, ValInt, ByVal FileName, pwd) As Integer
    If Left(FileName, 1) = "\" Then FileName = Right(FileName, Len(FileName) - 1)
    If InStr(FileName, ":") = 0 Then FileName = sPath & FileName
    '    SectionName = encode(CStr(SectionName))
    '    KeyWord = encode(CStr(KeyWord))
    ValInt = encode(CStr(ValInt))
    WriteIniPwd = IIf(WritePrivateProfileString(SectionName, KeyWord, ValInt, FileName), 1, 0)
End Function