
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