frmlicence.frm

OA编程 源代码

VERSION 5.00
Begin VB.Form FrmLicence 
   AutoRedraw      =   -1  'True
   BackColor       =   &H00E0E0E0&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "序列号"
   ClientHeight    =   2640
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5835
   Icon            =   "FrmLicence.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2640
   ScaleWidth      =   5835
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command2 
      Caption         =   "关 闭"
      Height          =   345
      Left            =   4695
      TabIndex        =   5
      Top             =   2205
      Width           =   1065
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确 定"
      Height          =   345
      Left            =   3480
      TabIndex        =   4
      Top             =   2205
      Width           =   1095
   End
   Begin VB.TextBox Text2 
      Appearance      =   0  'Flat
      Height          =   1020
      Left            =   1470
      MultiLine       =   -1  'True
      TabIndex        =   3
      Top             =   1080
      Width           =   4335
   End
   Begin VB.TextBox Text1 
      Appearance      =   0  'Flat
      Enabled         =   0   'False
      Height          =   330
      Left            =   1470
      TabIndex        =   1
      Top             =   390
      Width           =   4305
   End
   Begin VB.Image Image1 
      Height          =   2070
      Left            =   15
      Picture         =   "FrmLicence.frx":1042
      Stretch         =   -1  'True
      Top             =   75
      Width           =   1350
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackColor       =   &H00FFFFFF&
      BackStyle       =   0  'Transparent
      Caption         =   "反馈码"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   240
      Left            =   1500
      TabIndex        =   2
      Top             =   765
      Width           =   720
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackColor       =   &H00FFFFFF&
      BackStyle       =   0  'Transparent
      Caption         =   "基础码"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   240
      Left            =   1470
      TabIndex        =   0
      Top             =   45
      Width           =   720
   End
End
Attribute VB_Name = "FrmLicence"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private MI As Object
Private Fso As New FileSystemObject
Private Sub Command1_Click()
Dim Myary
Dim str As String
Dim str1 As String
Dim str2 As String
Dim str3 As String

Dim mystr As String

On Error GoTo err

If Text2.Text = "" Then
    MsgBox "请您输入有效的注册号!", 64
    Exit Sub
End If

Set MI = Nothing
Set MI = CreateObject("crypt.clscrypt")
MI.UserID = 99
MI.BaseCode = "moa" & Trim(Text1.Text)
str = MI.Decode(Text2.Text)

Myary = Split(str, "-")
If Myary(0) = "s" And Myary(1) = "moa" Then
    MsgBox "感谢您使用北科公司的网络办公平台!", 64
    str1 = "s-moa-" & Trim(Text1.Text) & "-000"
    str3 = Date
    
    MI.UserID = 99
    mystr = MI.Encode(str1) & "," & MI.Encode(str3)
    
    
    If Not Regcode(mystr) Then
        MsgBox "遇到意外错误,请与北科公司联系!(010-62525354)"
        Unload Me
        Exit Sub
    Else
        Call Mend(mystr)
        MsgBox "请重新启动本程序!", 64
        Unload Me
        Exit Sub
    End If

ElseIf Myary(0) = "p" And Myary(1) = "moa" Then
    MsgBox "感谢您使用北科公司的网络办公平台!您的使用期限为" & CInt(Myary(3)) & "天", 64
    str1 = "p-moa-" & Trim(Text1.Text) & "-" & Myary(3)
    str2 = Trim(Text1.Text)
    str3 = Date
    
    MI.UserID = 99
    mystr = MI.Encode(str1) & "," & MI.Encode(str3)
    
    If Not Regcode(mystr) Then
    MsgBox "遇到意外错误,请与北科公司联系!(010-62525354)"
    Unload Me
    Exit Sub
    Else
    Call Mend(mystr)
    MsgBox "请重新启动本程序!", 64
    Unload Me
    Exit Sub
    End If
ElseIf Myary(0) = "d" And Myary(1) = "moa" Then
    MsgBox "感谢您使用北科公司的网络办公平台!您使用的是演示版", 64
    str1 = "d-moa-" & Trim(Text1.Text) & "-" & Myary(3)
    str2 = Trim(Text1.Text)
    str3 = Date
    Set MI = Nothing
    Set MI = CreateObject("Crypt.clsCrypt")
    MI.UserID = 99
    mystr = MI.Encode(str1) & "," & MI.Encode(str3)
    
    If Not Regcode(mystr) Then
    MsgBox "遇到意外错误,请与北科公司联系!(010-62525354)"
    Unload Me
    Exit Sub
    Else
    Call Mend(mystr)
    MsgBox "请重新启动本程序!", 64
    Unload Me
    Exit Sub
    End If
    
End If
Exit Sub
err:
MsgBox "反馈码不匹配!", 64


End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Form_Load()
    Me.Left = Screen.Width / 2 - Me.Width / 2
    Me.Top = Screen.Height / 2 - Me.Height / 2
    SaveSetting "BKBT", "Server", "Ibasecode", ""
    SaveSetting "BKBT", "Server", "IDate", ""
    Set MI = CreateObject("crypt.clscrypt")
    MI.UserID = 99
    Text1.Text = MI.MRnd
    '换皮肤
    Call LoadSkin(Me)

End Sub
Private Function Regcode(str As String) As Boolean
On Error Resume Next
SaveSetting "bkbt", "server", "ibasecode", str
If err.Number <> 0 Then
    Regcode = False
Else
    Regcode = True
End If
err.Clear

End Function

Private Sub Mend(Mstr As String)
On Error Resume Next
Dim ndate As String
Dim Curdate As String

SaveString HKEY_LOCAL_MACHINE, "software\北科奔腾", "initval", ""
SaveString HKEY_LOCAL_MACHINE, "software\北科奔腾", "ibasecode", Mstr

Curdate = Format(Date & " " & Time, "yyyy/mm/dd HH:MM:SS")
MI.UserID = 99
ndate = MI.Encode(Curdate)
SaveString HKEY_LOCAL_MACHINE, "software\北科奔腾", "idate", ndate


Set Fso = Nothing
Set MI = Nothing

End Sub