dotNETportal.cz

Dobrý den, našel jsem tenhle kod pro vb6 na generovani licencniho cisla na zakladne kodu aplikace a jména:

Private Const VALID_CHARACTERS = "0123456789ABCDEFGHJKLMNPQRSTUVWXYZ"
Private Const DEFAULT_FORMAT = "&&&&-&&&&-&&&&-&&&&"

Public Function CreateKey(ApplicationKey As String, UserName As String, Optional sFormat As String = DEFAULT_FORMAT, Optional ValidCharacters As String = VALID_CHARACTERS) As String
    ' for use in sFormat; use '&' to represent alpha-numeric characters
    Dim intTemp As Integer
    Dim strTextChar As String
    Dim strKeyChar As String
    Dim intEncryptedChar As String
    Dim strKey As String
    Dim i As Integer,0
    Dim strUserName As String
    
    
    strUserName = LCase(Trim(UserName))
    
    If Len(strUserName) = 0 Then
        Err.Raise vbError + 1001, , "Invalid Username"
        Exit Function
    End If
    
    'This is an altered simple encryption algorithm
    For i = 1 To CountAmpersands(sFormat)
        strTextChar = Mid(strUserName, (i Mod Len(strUserName)) + 1, 1)
        strKeyChar = Mid(ApplicationKey, (i Mod Len(ApplicationKey)) + 1, 1)
        intTemp = (((Asc(strKeyChar) * i) * Len(ApplicationKey) + 1) Mod Len(ValidCharacters) + 1)
        strTextChar = Chr(Asc(strTextChar) Xor intTemp)
        intTemp = (((Asc(strKeyChar) * i) * Len(UserName) + 1) Mod Len(ValidCharacters) + 1)
        strTextChar = Chr(Asc(strTextChar) Xor intTemp)
        intEncryptedChar = ((Asc(strTextChar) Xor Asc(strKeyChar)) Mod Len(ValidCharacters)) + 1
        strKey = strKey & Mid(ValidCharacters, intEncryptedChar, 1)
    Next i
    
    CreateKey = Format(strKey, sFormat)
End Function

Private Function CountAmpersands(ByVal Format As String) As Integer
    'Counts the number of characters that need to be returned
    
    Dim i As Integer
    Dim intCount As Integer
    
    intCount = 0
    For i = 1 To Len(Format)
        If Mid(Format, i, 1) = "&" Then
            intCount = intCount + 1
        End If
    Next i
    
    CountAmpersands = intCount
End Function

Public Function IsGoodKey(ApplicationKey As String, UserName As String, Key As String, Optional sFormat As String = DEFAULT_FORMAT, Optional ValidCharacters As String = VALID_CHARACTERS) As Boolean
    'This function does not need to exist
    'It is here to make testing the key just a little simpler
    
    If LCase(Trim(Key)) = LCase(Me.CreateKey(ApplicationKey, UserName, sFormat, ValidCharacters)) Then
        IsGoodKey = True
    Else
        IsGoodKey = False
    End If
End Function

Vevb.net mi to hodí několik opravitelných errorů, ale výsledek createkey je vždy "&&&&-&&&&-&&&&-&&&&". Prosím o pomoc s převodem.

Hned vedle tlačítka na podtržení je takové kouzelné tlačítko VB code

Můžete ho použít i když sem vkládáte kód z VB6, bude se to mnohem lépe číst a spíš Vám někdo poradí.

Označeno ručně.

Tak si tam hoďte breakpoint (F9 na příslušném řádku) a krokujte. Tak bych to řešil i ve VB6, kdyby něco nefungovalo.