frmphlogin.frm

这是用Visual Basic6开发的大型喷绘业务管理系统,数据库采用Access数据库

VERSION 5.00
Begin VB.Form frmPHlogin 
   BorderStyle     =   0  'None
   ClientHeight    =   3675
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4590
   LinkTopic       =   "Form1"
   Picture         =   "frmPHlogin.frx":0000
   ScaleHeight     =   245
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   306
   StartUpPosition =   2  '屏幕中心
   Begin VB.TextBox Text1 
      Appearance      =   0  'Flat
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   11.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Left            =   2220
      TabIndex        =   0
      Top             =   1020
      Width           =   1185
   End
   Begin VB.TextBox Text2 
      Appearance      =   0  'Flat
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   11.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      IMEMode         =   3  'DISABLE
      Left            =   2220
      PasswordChar    =   "*"
      TabIndex        =   1
      Top             =   1440
      Width           =   1185
   End
   Begin VB.TextBox Text3 
      Appearance      =   0  'Flat
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Left            =   2220
      TabIndex        =   2
      Top             =   1860
      Width           =   1935
   End
   Begin VB.PictureBox Picture1 
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Enabled         =   0   'False
      Height          =   345
      Left            =   510
      Picture         =   "frmPHlogin.frx":38E6A
      ScaleHeight     =   23
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   80
      TabIndex        =   6
      Top             =   2850
      Width           =   1200
   End
   Begin VB.PictureBox Picture2 
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   345
      Left            =   3000
      Picture         =   "frmPHlogin.frx":3A43C
      ScaleHeight     =   23
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   80
      TabIndex        =   5
      Top             =   2850
      Width           =   1200
   End
   Begin VB.PictureBox Picture3 
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   360
      Left            =   1785
      Picture         =   "frmPHlogin.frx":3BA0E
      ScaleHeight     =   24
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   76
      TabIndex        =   4
      Top             =   2850
      Width           =   1140
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   5
      Left            =   2760
      TabIndex        =   11
      Top             =   2310
      Width           =   1305
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "您的序列码为："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   4
      Left            =   1410
      TabIndex        =   10
      Top             =   2340
      Width           =   1365
   End
   Begin VB.Image Image1 
      Height          =   585
      Left            =   540
      Picture         =   "frmPHlogin.frx":3CFB0
      Top             =   840
      Width           =   570
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "用 户 名"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   11.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   3
      Left            =   1260
      TabIndex        =   9
      Top             =   1020
      Width           =   1005
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "密    码"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   11.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   1
      Left            =   1260
      TabIndex        =   8
      Top             =   1440
      Width           =   1005
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "注 册 号"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   11.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   2
      Left            =   1260
      TabIndex        =   7
      Top             =   1890
      Width           =   1005
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "系统登录"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FFFF&
      Height          =   315
      Index           =   0
      Left            =   900
      TabIndex        =   3
      Top             =   300
      Width           =   945
   End
End
Attribute VB_Name = "frmPHlogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim n As Integer
Dim arrSBox(0 To 255) As Integer
Dim arrPW(0 To 255) As Integer
Dim Bi As Integer, Bj As Integer
Const serialCodeLen1 = 8
Const serialCodeLen2 = 15
Const keyCodeLen = 8
Dim mresult
Dim jframe As New dframe
Sub GetKeyCode()
    On Error Resume Next
     Dim tmp As String
     Dim i As Integer
     Dim strTmp As String
     Dim intTmp As Integer
     Dim lngTmp As Long
     Dim sumTmp As Integer
     Dim checkDigit As String
     Dim mSerial As Long
     
     If Len(SaveSerial) <> serialCodeLen2 Then
          MsgBox "No serial code/Invalid serial code"
          Exit Sub
     End If
          
     mSerial = CLng(Right(SaveSerial, 5))
        ' Shuffle a bit
     lngTmp = CLng(1234567 * Sqr(mSerial))
     
     strTmp = CStr(lngTmp)
        ' Make string to 7-digit long
     Do While Len(strTmp) < 7
        strTmp = "0" & strTmp
     Loop
     
        ' Apply Modular 7 to get a check digit
     sumTmp = 0
     For i = Len(strTmp) To 1 Step -1
          tmp = Mid$(strTmp, i, 1)
          intTmp = CInt(tmp) * i
          sumTmp = sumTmp + intTmp
     Next i
     i = sumTmp Mod 7
     checkDigit = CStr(i)
     SaveKeyCode = strTmp & checkDigit
End Sub
Sub GetSerial()
     On Error Resume Next
     
     Dim alphas As String
     Dim startingPos As Integer
     Dim primary As String
     Dim serials As String
     Dim char As String
     Dim i As Integer, j As Integer
     
     Dim mKey As Integer
     Dim X As Integer, Y As Integer
     Dim mCode As Integer
     Dim alphaCode As Integer
     Dim SeriesUserName As String
     Dim SeriesKeyCode As String
     Dim strSerial As String
     
        ' Form a string of 26 letters' long; every alpha is possible to be included
     alphas = ""
     For i = 1 To 26
          'Randomize
          'MsgBox Rnd()
          'MsgBox CInt(25 * Rnd), vbOKCancel
          alphas = alphas + Chr(CInt(25 * Rnd) + 65)
           'MsgBox alphas
     Next i
     
        ' As we are to take a length of serialCodeLen1, we start from a certain
        ' position of the strAlphas and taking the said length
     Randomize
     startingPos = Rnd * (25 - serialCodeLen1) + 1
     primary = Mid(alphas, startingPos, serialCodeLen1)
     
        ' Generate a serial no. of 5-digit, say from 3 to 7 positions of alphas
     serials = ""
     For i = 3 To 7
          char = Mid(alphas, i, 1)
          j = CInt(Asc(char) Mod 10)
          serials = serials & CStr(j)
     Next i

        ' Key code = primary & serials, separated by "-"
     SaveSerial = Left(primary, 4) & "-" & Right(primary, 4) & "-" & serials
End Sub
Private Sub Form_Load()
   rgn1 = 0
   n = 0
   Dim Ma As Dat
   Show
   Open App.Path & "\login.dat" For Random As #1 Len = Len(Ma)
   Do While Not EOF(1)
      n = n + 1
      Get #1, n, Ma
      If rgn1 = 0 Then rgn1 = CreateRectRgn(Ma.sx, Ma.sy, Ma.ex, Ma.ey)
      If rgn1 <> 0 Then
            rgn2 = CreateRectRgn(Ma.sx, Ma.sy, Ma.ex, Ma.ey)
            CombineRgn rgn1, rgn1, rgn2, 2
                  '释放系统资源
            DeleteObject rgn2
      End If
  Loop
'关闭文件
    Close #1
    SetWindowRgn hwnd, rgn1, True
    DeleteObject rgn1
    ''''''''
    GetSerial
    GetKeyCode
    Text3.Text = SaveKeyCode
    'Text3.Text = SaveSerial
    Label1(5).Caption = Right(SaveSerial, 5)
     
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Picture1.Cls
    Picture2.Cls
    Picture3.Cls
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Picture2.Cls
    Picture3.Cls
    jframe.danum = 6
    jframe.rtop = 5
    jframe.rleft = 1
    jframe.rright = 75
    jframe.rbottom = 23
    jframe.ddrawc Picture1
End Sub

Private Sub Picture2_Click()
    Unload Me
    End
End Sub

Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Picture1.Cls
    Picture3.Cls
    jframe.danum = 6
    jframe.rtop = 5
    jframe.rleft = 1
    jframe.rright = 75
    jframe.rbottom = 23
    jframe.ddrawc Picture2
End Sub

Private Sub Picture3_Click()
    If Text3.Text <> SaveKeyCode Then
       MsgBox "注册号错误..."
       Exit Sub
       End
    Else
       MsgBox "注册成功..."
       End
    End If
End Sub

Private Sub Picture3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Picture1.Cls
    Picture2.Cls
    jframe.danum = 6
    jframe.rtop = 1
    jframe.rleft = 1
    jframe.rright = 70
    jframe.rbottom = 23
    jframe.ddrawc Picture3
End Sub