VERSION 5.00
Begin VB.Form Form5 
   Caption         =   "Key7-ID Editor"
   ClientHeight    =   1110
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3090
   Icon            =   "Form5.frx":0000
   LinkTopic       =   "Form5"
   ScaleHeight     =   1110
   ScaleWidth      =   3090
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton Command2 
      Caption         =   "Exit"
      Height          =   375
      Left            =   1740
      TabIndex        =   3
      ToolTipText     =   "Return to main"
      Top             =   660
      Width           =   1155
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Create"
      Height          =   375
      Left            =   120
      TabIndex        =   2
      ToolTipText     =   "Create a FULL set of LMGR DLL with the above ID"
      Top             =   660
      Width           =   1215
   End
   Begin VB.TextBox Text1 
      Height          =   315
      Left            =   900
      MaxLength       =   8
      TabIndex        =   1
      Text            =   "00000000"
      ToolTipText     =   "Enter Here the KEY7-ID You would like to obtain"
      Top             =   180
      Width           =   2055
   End
   Begin VB.Label Label1 
      Caption         =   "Key7-ID:"
      Height          =   195
      Left            =   120
      TabIndex        =   0
      Top             =   240
      Width           =   735
   End
End
Attribute VB_Name = "Form5"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
a = UCase(Text1.Text)
If Len(a) = 0 Then End Sub
For r = 1 To 8
    kk(r) = 0
Next r
For r = 1 To Len(a)
    If Mid(a, r, 1) = "0" Then kk(r) = 1
    If Mid(a, r, 1) = "1" Then kk(r) = 1
    If Mid(a, r, 1) = "2" Then kk(r) = 1
    If Mid(a, r, 1) = "3" Then kk(r) = 1
    If Mid(a, r, 1) = "4" Then kk(r) = 1
    If Mid(a, r, 1) = "5" Then kk(r) = 1
    If Mid(a, r, 1) = "6" Then kk(r) = 1
    If Mid(a, r, 1) = "7" Then kk(r) = 1
    If Mid(a, r, 1) = "8" Then kk(r) = 1
    If Mid(a, r, 1) = "9" Then kk(r) = 1
    If Mid(a, r, 1) = "A" Then kk(r) = 1
    If Mid(a, r, 1) = "B" Then kk(r) = 1
    If Mid(a, r, 1) = "C" Then kk(r) = 1
    If Mid(a, r, 1) = "D" Then kk(r) = 1
    If Mid(a, r, 1) = "E" Then kk(r) = 1
    If Mid(a, r, 1) = "F" Then kk(r) = 1
Next r

ll = 0
For r = 1 To Len(a)
    ll = ll + kk(r)
Next r

If ll <> Len(a) Then
    MsgBox "Icorrect Value, valid range is from 0 to FFFFFFFF", vbCritical, "Error"
    End Sub
End If

If Len(a) = 1 Then a = "0000000" + a
If Len(a) = 2 Then a = "000000" + a
If Len(a) = 3 Then a = "00000" + a
If Len(a) = 4 Then a = "0000" + a
If Len(a) = 5 Then a = "000" + a
If Len(a) = 6 Then a = "00" + a
If Len(a) = 7 Then a = "0" + a

frompath = App.Path + "\KEY7"
destpat = App.Path + "\KEY7-" + a

On Error GoTo donotpatch
MkDir (destpat)
FileCopy frompath + "\LMGR325A.DLL", destpat + "\LMGR325A.DLL"
FileCopy frompath + "\LMGR325C.DLL", destpat + "\LMGR325C.DLL"
FileCopy frompath + "\LMGR326A.DLL", destpat + "\LMGR326A.DLL"
FileCopy frompath + "\LMGR326B.DLL", destpat + "\LMGR326B.DLL"
On Error Resume Next

b = Val("&H" + a)
b = Hex(b Xor &H11223344)

BYTE1 = Val("&h" + Left(b, 2))
BYTE2 = Val("&h" + Mid(b, 3, 2))
BYTE3 = Val("&h" + Mid(b, 5, 2))
BYTE4 = Val("&h" + Right(b, 2))

filen1 = FreeFile
Open destpat + "\LMGR325A.DLL" For Binary Access Write As #filen1
Put #filen1, &H18D9B, Chr$(BYTE1)
Put #filen1, &H18D9A, Chr$(BYTE2)
Put #filen1, &H18D99, Chr$(BYTE3)
Put #filen1, &H18D98, Chr$(BYTE4)
Close #filen1
filen1 = FreeFile
Open destpat + "\LMGR325C.DLL" For Binary Access Write As #filen1
Put #filen1, &H3773, Chr$(BYTE1)
Put #filen1, &H3772, Chr$(BYTE2)
Put #filen1, &H3771, Chr$(BYTE3)
Put #filen1, &H3770, Chr$(BYTE4)
Close #filen1
filen1 = FreeFile
Open destpat + "\LMGR326A.DLL" For Binary Access Write As #filen1
Put #filen1, &H1C816, Chr$(BYTE1)
Put #filen1, &H1C815, Chr$(BYTE2)
Put #filen1, &H1C814, Chr$(BYTE3)
Put #filen1, &H1C813, Chr$(BYTE4)
Close #filen1
filen1 = FreeFile
Open destpat + "\LMGR326B.DLL" For Binary Access Write As #filen1
Put #filen1, &H1D97B, Chr$(BYTE1)
Put #filen1, &H1D97A, Chr$(BYTE2)
Put #filen1, &H1D979, Chr$(BYTE3)
Put #filen1, &H1D978, Chr$(BYTE4)
Close #filen1

donotpatch:
MsgBox "New set of KEY7 DLL was saved on dir " + destpat + ", use them for the " + a + " KEY7-ID", vbExclamation, "Success"
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Form_Load()
End Sub
