reg.frm

本系统特为行业报价、订单、产品管理与客户关系管理所订制

VERSION 5.00
Object = "{74848F95-A02A-4286-AF0C-A3C755E4A5B3}#1.0#0"; "actskn43.ocx"
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "注 册"
   ClientHeight    =   2055
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   4455
   Icon            =   "Reg.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2055
   ScaleWidth      =   4455
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton Command3 
      Caption         =   "查看帮助"
      Height          =   375
      Left            =   1680
      TabIndex        =   6
      Top             =   1440
      Width           =   1095
   End
   Begin VB.CommandButton Command2 
      Caption         =   "以后在说"
      Height          =   375
      Left            =   3000
      TabIndex        =   5
      Top             =   1440
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "注 册"
      Height          =   375
      Left            =   360
      TabIndex        =   4
      Top             =   1440
      Width           =   1095
   End
   Begin ACTIVESKINLibCtl.SkinLabel SkinLabel1 
      Height          =   255
      Left            =   240
      OleObjectBlob   =   "Reg.frx":000C
      TabIndex        =   2
      Top             =   360
      Width           =   735
   End
   Begin ACTIVESKINLibCtl.Skin PKSkn 
      Left            =   240
      OleObjectBlob   =   "Reg.frx":0072
      Top             =   2040
   End
   Begin VB.TextBox Text2 
      Height          =   300
      Left            =   1080
      TabIndex        =   1
      Top             =   817
      Width           =   2895
   End
   Begin VB.TextBox Text1 
      Height          =   300
      Left            =   1080
      Locked          =   -1  'True
      TabIndex        =   0
      Top             =   337
      Width           =   2415
   End
   Begin ACTIVESKINLibCtl.SkinLabel SkinLabel2 
      Height          =   255
      Left            =   240
      OleObjectBlob   =   "Reg.frx":02A6
      TabIndex        =   3
      Top             =   840
      Width           =   735
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2008/05/10
'描    述：商品综合管理系统 Sql2000版
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Private Declare Function GetVolumeInformation& Lib "kernel32" _
    Alias "GetVolumeInformationA" (ByVal lpRootPathName _
    As String, ByVal pVolumeNameBuffer As String, ByVal _
    nVolumeNameSize As Long, lpVolumeSerialNumber As Long, _
    lpMaximumComponentLength As Long, lpFileSystemFlags As _
    Long, ByVal lpFileSystemNameBuffer As String, ByVal _
    nFileSystemNameSize As Long)
        Const MAX_FILENAME_LEN = 256

Private Sub Command1_Click()
If Len(Text2.Text) < 20 Then
 MsgBox "请重新输入注册码! 格式(*****-*****-*****-*****-*****)", vbInformation, "注册码格式错误"
 Text2.Text = ""
 Exit Sub
End If
KeyStr = Text2.Text
KEY_YZ
End Sub

Private Sub Command2_Click()
UKeyStr = "Y5473-RR337-KGJJN-N4AFR-3REBB"
Unload Me
End Sub

Private Sub Command3_Click()
Shell "Explorer /s , " & App.Path & "\help.htm"
End Sub

Private Sub Form_Load()
PKSkn.LoadSkin App.Path & sknPname
PKSkn.ApplySkinByName hWnd, "窗体"
PKSkn.ApplySkin hWnd
Text1.Text = SerNum("C") * -1
If Mid(Text1.Text, 1, 1) = "-" Then
 Text1.Text = Mid(Text1.Text, 2, Len(Text1.Text) - 1)
End If
End Sub
Public Function SerNum(Drive$) As Long '获取硬盘序列号
    Dim No&, s As String * MAX_FILENAME_LEN
    Call GetVolumeInformation(Drive + ":\", s, MAX_FILENAME_LEN, _
    No, 0&, 0&, s, MAX_FILENAME_LEN)
    SerNum = No
End Function


Private Sub KEY_YZ()
Dim str3 As String
str3 = SerNum("C") * -1
If Mid(str3, 1, 1) = "-" Then
 str3 = Mid(str3, 2, Len(str3) - 1)
End If
Dim idu As Variant
Dim KEY As Integer
For KEY = 0 To 2
Select Case KEY
 Case 0
idu = StringToBinary("U9I7MKJZ9CY25NBG783EFPG492BGD6")
Case 1
idu = StringToBinary("T4IV2Y9XANX16NVBKCG174CE33PV6E")
Case 2
idu = StringToBinary("YR3NR98FFAK222HW5CQQYK9Q7BNFS8")
End Select
Dim str As Variant
str = ""
For i = 1 To Len(str3)
str = str & StringToBinary(BinaryToString(Mid(idu, (Mid(str3, i, 1) * 3) + 1, 3)))
Next
Dim str1 As Variant
str1 = ""
For i = 1 To Len(BinaryToString(str)) Step 2
str1 = str1 & StringToBinary(Mid(BinaryToString(str), i, 1))
Next
For i = 2 To Len(BinaryToString(str)) Step 2
str1 = str1 & StringToBinary(Mid(BinaryToString(str), i, 1))
Next
Dim str2 As Variant
str2 = ""
For i = 1 To Len(BinaryToString(str1)) Step 5
str2 = str2 & StringToBinary(Mid(BinaryToString(str1), i, 5) & "-")
Next
If Len(BinaryToString(str2)) < 29 Then
 For i = 1 To 29 - Len(BinaryToString(str2))
  str2 = StringToBinary(BinaryToString(str2) & "0")
 Next
Else
str2 = StringToBinary(BinaryToString(str2))
End If
If Mid(BinaryToString(str2), 1, 29) = KeyStr Then
Exit For
End If
Next
str = "Y5473-RR337-KGJJN-N4AFR-3REBB"
If str = KeyStr Then
 MsgBox "请重新启动程序以验证序列号!"
 Unload Me
End If
If Mid(BinaryToString(str2), 1, 29) = KeyStr Then
 UKeyStr = BinaryToString(str2)
 strtargetfile = App.Path & "\key.k"
 If Dir(strtargetfile, vbNormal) <> "" Then
 Kill strtargetfile
 End If
 Open strtargetfile For Append As #1
 Print #1, KeyStr
 Close #1
 MsgBox "请重新启动程序以验证序列号!"
 Unload Me
Else
 MsgBox "请重新启动程序以验证序列号!"
 Unload Me
End If
End Sub


Private Sub Form_Unload(Cancel As Integer)
UKeyStr = "Y5473-RR337-KGJJN-N4AFR-3REBB"
End Sub