formregister.frm

来自「VB 编写的"华成POS管理系统",代码全,没有进行测试,数据库全,有兴趣的朋友」· FRM 代码 · 共 224 行

VERSION 5.00
Begin VB.Form FormRegister 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "注册"
   ClientHeight    =   2355
   ClientLeft      =   2040
   ClientTop       =   1935
   ClientWidth     =   5235
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   9
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "FormRegister.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2355
   ScaleWidth      =   5235
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.Frame Frame1 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   120
      TabIndex        =   3
      Top             =   540
      Width           =   4995
      Begin VB.Label LabelReg 
         Alignment       =   2  'Center
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   960
         TabIndex        =   4
         Top             =   180
         Width           =   3015
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "请输入销售商返回的注册号"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   675
      Left            =   120
      TabIndex        =   1
      Top             =   1140
      Width           =   4995
      Begin VB.TextBox TextReturn 
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   315
         IMEMode         =   3  'DISABLE
         Left            =   180
         TabIndex        =   2
         Top             =   240
         Width           =   4635
      End
   End
   Begin VB.CommandButton CommandRegister 
      Caption         =   "注册(&R)"
      Default         =   -1  'True
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1875
      TabIndex        =   0
      Top             =   1920
      Width           =   1515
   End
   Begin VB.Label Label1 
      Caption         =   "请与销售商联系，将下列号码告诉他们以获得正确的注册号。"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   180
      TabIndex        =   6
      Top             =   120
      Width           =   4995
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      Caption         =   "您只有输入了正确的注册号后才能继续使用本软件"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Left            =   120
      TabIndex        =   5
      Top             =   360
      Width           =   4995
   End
End
Attribute VB_Name = "FormRegister"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public RegFileName As String
Public VolDriveLetter As String
Private ReturnREG As String

Private Sub CommandRegister_Click()
    ReturnREG = TextReturn.Text
    Unload Me
End Sub

Private Sub Form_Load()
LabelReg.Caption = CorverSerialNo(DriveSerial(VolDriveLetter))
End Sub
Public Function IsRegister() As Boolean
On Error GoTo REGERR
#If DEBUGMode = 1 Then
    IsRegister = True
    Exit Function
#End If
'---------------------
'---- Stand Codes ----
'---------------------
Dim RegKey As String
Dim AppPath As String
If Right(App.Path, 1) = "\" Then
    AppPath = App.Path
Else
    AppPath = App.Path + "\"
End If
If Dir(AppPath + RegFileName) <> "" Then
    SetAttr AppPath + RegFileName, vbNormal
    Dim FreeIO As Integer
    FreeIO = FreeFile
    Open AppPath + RegFileName For Input As #FreeIO
        Line Input #FreeIO, RegKey
    Close #FreeIO
Else
    Me.Show 1
    RegKey = ReturnREG
End If
'-------------------------------
'--- Verfy if is a vaild key ---
'-------------------------------
Dim Source As Long
Dim Result As Long
Source = DriveSerial(VolDriveLetter)
Result = (Source And &HFF00) / 4 + Sqr(Source) * 2 + Sqr(Source) + 2000 + 5 + 27
If IsValidate(Result, RegKey) Then
    IsRegister = True
    FreeIO = FreeFile
    Open AppPath + RegFileName For Output As #FreeIO
        Print #FreeIO, RegKey
    Close #FreeIO
Else
    IsRegister = False
    If Dir(AppPath + RegFileName) <> "" Then Kill AppPath + RegFileName
End If

Exit Function
REGERR:
    IsRegister = False
    If Dir(AppPath + RegFileName) <> "" Then Kill AppPath + RegFileName
    Exit Function
    Resume Next
End Function
Private Function CorverSerialNo(ByVal Source As Long) As String
    Dim Result As Long
    Source = Abs(Source)
    Result = (Source And &HFF00) / 4 + Sqr(Source) * 2 + Sqr(Source) + 2000 + 5 + 27
    CorverSerialNo = Hex(Result)
End Function