frm_first.frm

全站仪学习测量与自动测量程序,测量数据excel导出.

VERSION 5.00
Begin VB.Form frm_first 
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "用户登录"
   ClientHeight    =   3930
   ClientLeft      =   45
   ClientTop       =   315
   ClientWidth     =   5910
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3930
   ScaleWidth      =   5910
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.Frame Frame1 
      Height          =   3975
      Left            =   2670
      TabIndex        =   0
      Top             =   -60
      Width           =   3225
      Begin VB.CommandButton Command2 
         Caption         =   "退出"
         Height          =   405
         Left            =   1710
         TabIndex        =   4
         Top             =   2160
         Width           =   855
      End
      Begin VB.CommandButton Command1 
         Caption         =   "进入"
         Height          =   405
         Left            =   480
         TabIndex        =   3
         Top             =   2160
         Width           =   855
      End
      Begin VB.TextBox Text1 
         Height          =   405
         IMEMode         =   3  'DISABLE
         Left            =   540
         PasswordChar    =   "*"
         TabIndex        =   2
         Text            =   "D1XURR"
         Top             =   1080
         Width           =   2025
      End
      Begin VB.Label Label2 
         Alignment       =   2  'Center
         Caption         =   "注册码："
         BeginProperty Font 
            Name            =   "幼圆"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   -1  'True
            Strikethrough   =   0   'False
         EndProperty
         Height          =   405
         Left            =   90
         TabIndex        =   5
         Top             =   3510
         Width           =   3075
      End
      Begin VB.Label Label1 
         Caption         =   "密码"
         Height          =   285
         Left            =   1290
         TabIndex        =   1
         Top             =   810
         Width           =   615
      End
   End
   Begin VB.Image Image1 
      Height          =   3945
      Left            =   0
      Picture         =   "frm_first.frx":0000
      Top             =   0
      Width           =   2655
   End
End
Attribute VB_Name = "frm_first"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function GetVolumeInformation Lib "kernel32.dll" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Integer, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Private Sub Command1_Click()
  Dim inputpass As String
  Dim userstring As String
  Dim userpassword As String
     Unload Me
    MDIForm1.Show
  
  inputpass = Trim(Text1.Text) '用户输入密码
  userstring = getserialn() '注册码
  userpassword = getpassword(userstring) '系统用户密码
  If inputpass = userpassword Then
  
    Unload Me
    MDIForm1.Show
  Else
    'MsgBox "输入密码错误！"
    'Text1.SetFocus
    Exit Sub
  End If
End Sub

Private Sub Command2_Click()
  Unload Me
End Sub

Private Sub Form_Load()
Label2.Caption = "注册码：" + getserialn()
End Sub
 Function getserialn() As String
     Dim inputseial As String
     Dim n As String
     Dim n1 As String
     Dim n2 As String
     Dim p As Long
     Dim p1 As Long
     Dim p2 As Long
     p = 0
     p1 = 0
     p2 = 0
     n = ""
     n1 = ""
     n2 = ""
     n = GetSerialNumber("c:\")
    ' MsgBox numberc
     n1 = n
     n2 = n
     If Len(n) < 20 Then
     n = n + String(20 - Len(n), "Z")
     n1 = n1 + String(20 - Len(n1), "A")
     n2 = n2 + String(20 - Len(n2), "H")
     ElseIf Len(n) > 20 Then
     n = Left(n, 20)
     n1 = Left(n1, 20)
     n2 = Left(n2, 20)
     End If
        
     For i = 1 To 20
     p = p + Asc(Mid(n, i, 1)) * 199
     p1 = p1 + Asc(Mid(n1, i, 1)) * 179
     p2 = p2 + Asc(Mid(n2, i, 1)) * 109
     Next
     inputseial = Format(p) + "-" + Format(p1) + "-" + Format(p2)
     getserialn = inputseial
 End Function
 Function GetSerialNumber(strDrive As String) As Long
     Dim SerialNum As Long
     Dim Res As Long
     Dim Temp1 As String
     Dim Temp2 As String
     Temp1 = String$(255, Chr$(0))
     Temp2 = String$(255, Chr$(0))
     Res = GetVolumeInformation(strDrive, Temp1, _
     Len(Temp1), SerialNum, 0, 0, Temp2, Len(Temp2))
     GetSerialNumber = SerialNum
     End Function
Function getpassword(users As String) As String
   Dim a1, a2, a3, a4, a5 As Long
   Dim a As Long
   a = 0
   userpass = users
   If Len(userpass) < 20 Then
      userpass = userpass + String(20 - Len(userpass), "X")
      Else
      userpass = Left(userpass, 20)
      End If
   For i = 1 To 20
     a = a + Asc(Mid(userpass, i, 1))
   Next i
      a1 = Asc(Mid(userpass, 1, 1)) + Asc(Mid(userpass, 6, 1)) + Asc(Mid(userpass, 11, 1)) + Asc(Mid(userpass, 16, 1))
      a2 = Asc(Mid(userpass, 2, 1)) + Asc(Mid(userpass, 7, 1)) + Asc(Mid(userpass, 12, 1)) + Asc(Mid(userpass, 17, 1))
      a3 = Asc(Mid(userpass, 3, 1)) + Asc(Mid(userpass, 8, 1)) + Asc(Mid(userpass, 13, 1)) + Asc(Mid(userpass, 18, 1))
      a4 = Asc(Mid(userpass, 4, 1)) + Asc(Mid(userpass, 9, 1)) + Asc(Mid(userpass, 14, 1)) + Asc(Mid(userpass, 19, 1))
      a5 = Asc(Mid(userpass, 5, 1)) + Asc(Mid(userpass, 10, 1)) + Asc(Mid(userpass, 15, 1)) + Asc(Mid(userpass, 20, 1))
        a = (a Mod 42) + 48
       a1 = (a1 Mod 42) + 48
       a2 = (a2 Mod 42) + 48
       a3 = (a3 Mod 42) + 48
       a4 = (a4 Mod 42) + 48
       a5 = (a5 Mod 42) + 48
       getpassword = Chr(a) + Chr(a1) + Chr(a2) + Chr(a3) + Chr(a4) + Chr(a5)
End Function