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]  下一页