VB编PiView4注册机

以下为VB6源代码，欢迎转载

程序代码：

Begin VB.Form frmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "PiView4Keygen Code By 杨兴宇"
   ClientHeight    =   1530
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4695
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   1530
   ScaleWidth      =   4695
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdClear 
      Caption         =   "清空"
      Height          =   375
      Left            =   1680
      TabIndex        =   3
      Top             =   1080
      Width           =   1335
   End
   Begin VB.TextBox txtKey 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BeginProperty Font 
         Name            =   "黑体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   120
      Locked          =   -1  'True
      MaxLength       =   40
      TabIndex        =   2
      Top             =   600
      Width           =   4455
   End
   Begin VB.CommandButton cdmGetKey 
      Caption         =   "获取"
      Height          =   375
      Left            =   3240
      TabIndex        =   1
      Top             =   1080
      Width           =   1335
   End
   Begin VB.TextBox txtInput 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BeginProperty Font 
         Name            =   "黑体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   120
      MaxLength       =   20
      TabIndex        =   0
      Top             =   120
      Width           =   4455
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*************************************************************************
'**模 块 名：frmMain
'**说    明：PiView4注册机
'**创 建 人：杨兴宇

'**日    期：2010-01-20 15:20:09
'**版    本：V1.0.0
'*************************************************************************

Option Explicit

Private Function GetRegKey(ByVal m_Input As String) As String
    
    On Error GoTo ErrHandle
        
    Dim m_ConstData(3, 7) As Long
    Dim m_Temp1(3)        As Long
    Dim m_Temp2(7)        As Long
    
    Dim m_Temp3           As String
    Dim m_Str             As String
    
    Dim m_Index           As Long
    Dim i                 As Long
    Dim j                 As Long
    
    Dim m_Key(3)          As String
    
    GetRegKey = vbNullString
    
    m_ConstData(0, 0) = 32
    m_ConstData(0, 1) = 222
    m_ConstData(0, 2) = 43
    m_ConstData(0, 3) = 61
    m_ConstData(0, 4) = 65
    m_ConstData(0, 5) = 44
    m_ConstData(0, 6) = 217
    m_ConstData(0, 7) = 5
    
    m_ConstData(1, 0) = 30
    m_ConstData(1, 1) = 29
    m_ConstData(1, 2) = 48
    m_ConstData(1, 3) = 67
    m_ConstData(1, 4) = 223
    m_ConstData(1, 5) = 332
    m_ConstData(1, 6) = 212
    m_ConstData(1, 7) = 53
    
    m_ConstData(2, 0) = 31
    m_ConstData(2, 1) = 75
    m_ConstData(2, 2) = 323
    m_ConstData(2, 3) = 234
    m_ConstData(2, 4) = 22
    m_ConstData(2, 5) = 4
    m_ConstData(2, 6) = 234
    m_ConstData(2, 7) = 41
    
    m_ConstData(3, 0) = 31
    m_ConstData(3, 1) = 152
    m_ConstData(3, 2) = 24
    m_ConstData(3, 3) = 354
    m_ConstData(3, 4) = 10
    m_ConstData(3, 5) = 41
    m_ConstData(3, 6) = 12
    m_ConstData(3, 7) = 52
    
    m_Str = UCase$("0123456789abcdef")
    
    If Len(m_Input) > 8 Or Len(m_Input) = 0 Then
        
        MsgBox "请正确输入注册号或者您当前选择的PiView版本错误", vbCritical + vbOKOnly, "提醒"
        Exit Function
        
    End If
    
    For i = 0 To Len(m_Input) - 1
        
        m_Temp3 = Mid$(m_Input, i + 1, 1)
        m_Index = InStr(1, m_Str, m_Temp3) - 1
        
        If m_Index = -1 Then
        
            MsgBox "请正确输入注册号或者您当前选择的PiView版本错误", vbCritical + vbOKOnly, "提醒"
            Exit Function
            
        End If
        
        m_Temp2(i) = m_Index
        
    Next
    
    For i = 0 To 3
        
        m_Temp1(i) = 999
        
        For j = 0 To 7
            
            m_Temp1(i) = m_Temp1(i) + m_Temp2(j) * m_ConstData(i, j)
            
        Next
        
    Next
    
    m_Key(0) = CStr(Hex(m_Temp1(0) + m_Temp1(1)))
    m_Key(1) = CStr(Hex(m_Temp1(1) * m_Temp1(2)))
    m_Key(2) = CStr(Hex(m_Temp1(2)))
    m_Key(3) = CStr(Hex(m_Temp1(3)))
    
    For i = 0 To 3
        
        m_Index = Len(m_Key(i))
        
        If m_Index < 4 Then
            
            For j = 1 To 4 - m_Index
                
                m_Key(i) = "0" & m_Key(i)
                
            Next
            
        End If

    Next
    
    GetRegKey = Join(m_Key, "-")
    
ErrHandle:
    
    If Err.Number <> 0 Then
        
        MsgBox "错误描述：" & Err.Description & vbCrLf & vbCrLf & "提醒：请正确输入注册号或者您当前选择的PiView版本错误", vbCritical + vbOKOnly, "有错误发生，错误号：" & CStr(Err.Number)
        Err.Clear
        
    End If
    
End Function

Private Sub cdmGetKey_Click()
    
    txtKey.Text = GetRegKey(txtInput.Text)
    
    If Len(txtKey.Text) = 0 Then
        
        txtInput.SelStart = 0
        txtInput.SelLength = Len(txtInput.Text)
        txtInput.SetFocus
        
    End If
    
End Sub

Private Sub cmdClear_Click()
    
    txtInput.Text = vbNullString
    txtKey.Text = vbNullString
    
End Sub

 

---

文章来自：