|
nbsp; Set FSOString = FSOFile.OpenAsTextStream(ForWriting, TristateFalse)
Else
Set FSOString = FSO.CreateTextFile(App.Path & "Value.dat", True, False)
End If
Else
If FSO.FileExists(App.Path & "\Value.dat") Then
Set FSOFile = FSO.GetFile(App.Path & "\Value.dat")
Set FSOString = FSOFile.OpenAsTextStream(ForWriting, TristateFalse)
Else
Set FSOString = FSO.CreateTextFile(App.Path & "\Value.dat", True, False)
End If
End If
For nCount = 1 To 1024
FSOString.Write (Mid(sTarget, Int(56 * Rnd + 1), 1))
Next
lReturn = RegCloseKey(hEditKey)
Erase baRandom
Set FSO = Nothing
Set FSOFile = Nothing
Set FSOString = Nothing
Close #hFileNumber
End Sub
Private Function KeyCheck(ForCheckName As String, ForCheckPassword As String) As Boolean
''''接收两个从注册表中读出的字符串Name和Password
''''如果注册表中没有Name和Password键值则此二值为空,以下检测该字符串第一个字符是否在sTarget中
If InStr(1, sTarget, Left(ForCheckName, 1), vbTextCompare) = 0 Or InStr(1, sTarget, Left(ForCheckPassword, 1), vbTextCompare) = 0 Then
KeyCheck = False
Exit Function
End If
''''调用CalculateNamePassword,返回合法的Name及Password
''''返回值的形式为Name%Password
Dim sTotal As String
sTotal = CalculateNamePassword
Dim sCalName As String
Dim sCalPassword As String
sCalName = Left(sTotal, 8)
sCalPassword = Right(sTotal, 25)
''''检测是否符合
For nCount = 1 To 8
If Mid(ForCheckName, nCount, 1) <> Mid(sCalName, nCount, 1) Then
KeyCheck = False
Exit Function
End If
Next
For nCount = 1 To 25
If Mid(ForCheckPassword, nCount, 1) <> Mid(sCalPassword, nCount, 1) Then
KeyCheck = False
Exit Function
End If
Next
KeyCheck = True
End Function
Public Property Get Regested() As Variant ''''是否注册的只读属性
Regested = m_Regested
End Property
Public Property Get RegestKey() As String ''''客户应用程序在注册表中的注册键
RegestKey = m_RegestKey
End Property
Public Property Let RegestKey(ByVal vNewValue As String)
m_RegestKey = vNewValue
End Property
Private Function CalculateNamePassword() As String ''''用来以Name%Password格式返回
''''合法用户名及密码的私有方法
''''如果Value.dat不存在,则立即退出
Set FSO = CreateObject("Scripting.FileSystemObject")
If Right(App.Path, 1) = "\" Then
If FSO.FileExists(App.Path & "Value.dat") = False Then
CalculateNamePassword = ""
Set FSO = Nothing
Exit Function
End If
Else
If FSO.FileExists(App.Path & "\Value.dat") = False Then
CalculateNamePassword = ""
Set FSO = Nothing
Exit Function
End If
End If
Dim sCalculateName As String ''''合法的用户名
Dim sCalculatePassword As String ''''合法的密码
sCalculateName = ""
sCalculatePassword = ""
Dim hFileNumberKey As Integer ''''打开两个文件Key.dat和Value.dat
hFileNumberKey = FreeFile
If Right(App.Path, 1) = "\" Then
Open App.Path & "Key.dat" For Binary As hFileNumberKey
Else
Open App.Path & "\Key.dat" For Binary As hFileNumberKey
End If
Dim hFileNumberValue As Integer
hFileNumberValue = FreeFile
If Right(App.Path, 1) = "\" Then
Open App.Path & "Value.dat" For Binary As hFileNumberValue
Else
Open App.Path & "\Value.dat" For Binary As hFileNumberValue
End If
Dim bFirst As Byte
Dim bSecond As Byte
Dim bLength As Byte
Dim bFF As Byte
Dim bCode As Byte
Dim iPasswordStart As Integer
Dim iLength As Integer
For nCount = 1 To 24 Step 3
Get #hFileNumberKey, nCount, bFF
If bFF <> &HFF Then
Get #hFileNumberKey, nCount, bFirst
Get #hFileNumberKey, nCount + 1, bSecond
Get #hFileNumberKey, nCount + 2, bLength
For iLength = 1 To CInt(bLength)
Get #hFileNumberValue, CInt(bFirst) ^ 2 + CInt(bSecond) + iLength - 1, bCode
sCalculateName = sCalculateName & Chr(bCode)
Next
Else
iPasswordStart = nCount
Exit For
End If
Next
For nCount = iPasswordStart + 1 To 100 Step 3
Get #hFileNumberKey, nCount, bFirst
Get #hFileNumberKey, nCount + 1, bSecond
Get #hFileNumberKey, nCount + 2, bLength
For iLength = 1 To CInt(bLength)
Get #hFileNumberValue, CInt(bFirst) ^ 2 + CInt(bSecond) + iLength - 1, bCode
sCalculatePassword = sCalculatePassword & Chr(bCode)
If Len(sCalculatePassword) = 25 Then
nCount = 100
Exit For
End If
Next
Next
CalculateNamePassword = sCalculateName & "%" & sCalculatePassword
Set FSO = Nothing
Close #hFileNumberKey
Close #hFileNumberValue
End Function
Public Property Get RegestName() As String ''''只读用户名属性
RegestName = m_Name
End Property
Public Property Get RegestPassword() As String ''''只读密码属性
上一页 [1] [2] [3] 下一页
没有相关教程
| 
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
