Search Tools Links Login

Generate registration keys just like WinZip's :)


Visual Basic 6, or VB Classic

Generates registration key based on name.

Original Author: DarkMan

Inputs

Name

Assumptions

This could be used if you would like registered owners of WinZip to be able to also use your code.
Obviously you should not use it to generate keys for WinZip if you have not purchased it.

Returns

Licence Key

Code

'Thanks to R!SC for the assembler version which this is based on
Public Function GenerateKey(ByVal Name As String) As String
  Dim lPart1 As Long
  Dim lPart2 As Long
  Dim ch As Long
  Dim i As Long
  Dim n As Long
  
  'Name is trimmed and restricted to 40
  Name = Trim$(Name)
  Name = Mid$(Name, 1, 40)
  If Len(Name) = 0 Then
    Exit Function
  End If
  
  'The key is made up of two parts, both 4 digit hex values
  
  'Part1 is quite tricky
  For i = 1 To Len(Name)
    ch = Asc(Mid$(Name, i, 1)) * &H100
    'Run through the calculations 8 times for each character
    For n = 1 To 8
      'Do different things based on the result of this wierd if
      If (((ch Xor lPart1) Mod &H10000) And &H8000&) = 0 Then
        'Bit shift 1 bit left
        lPart1 = lPart1 And &HFFFFFFF
        lPart1 = lPart1 * 2
      Else
        'Bit shift 1 bit left
        lPart1 = lPart1 And &HFFFFFFF
        lPart1 = lPart1 * 2
        'Xor with the magic number
        lPart1 = lPart1 Xor &H1021&
      End If
      ch = ch * 2
    Next n
  Next i
  'Add a bit for luck
  lPart1 = lPart1 + &H63&
  'Only want 4 digits
  lPart1 = lPart1 Mod &H10000
  
  'Part2 is very simple
  For i = 1 To Len(Name)
    lPart2 = lPart2 + (Asc(Mid$(Name, i, 1)) * (i - 1))
  Next i
  'Build up from 2 parts (making sure each part is 4 digits)
  GenerateKey = String$(4 - Len(CStr(Hex(lPart1))), "0") _
        & CStr(Hex(lPart1)) _
        & String$(4 - Len(CStr(Hex(lPart2))), "0") _
        & CStr(Hex(lPart2))
End Function

About this post

Posted: 2002-06-01
By: ArchiveBot
Viewed: 89 times

Categories

Visual Basic 6

Attachments

No attachments for this post


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.