frmlogin.frm

金算盘软件代码

VERSION 5.00
Object = "{D252F124-F62C-11D1-9ABD-444553540000}#1.0#0"; "GADATE.DLL"
Begin VB.Form frmLogin 
   BackColor       =   &H8000000A&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "重新注册"
   ClientHeight    =   1545
   ClientLeft      =   30
   ClientTop       =   330
   ClientWidth     =   4350
   Icon            =   "frmLogin.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1545
   ScaleWidth      =   4350
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin GACALENDARLibCtl.Calendar dteLogin 
      Height          =   276
      Left            =   1425
      OleObjectBlob   =   "frmLogin.frx":000C
      TabIndex        =   14
      Top             =   165
      Width           =   1320
   End
   Begin VB.CommandButton cmdOK 
      Height          =   350
      Index           =   2
      Left            =   3060
      Style           =   1  'Graphical
      TabIndex        =   6
      Top             =   1095
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Cancel          =   -1  'True
      Height          =   350
      Index           =   1
      Left            =   3060
      Style           =   1  'Graphical
      TabIndex        =   5
      Top             =   612
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Height          =   350
      Index           =   0
      Left            =   3060
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   165
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.TextBox txtPassword 
      Height          =   276
      IMEMode         =   3  'DISABLE
      Index           =   3
      Left            =   1425
      PasswordChar    =   "*"
      TabIndex        =   12
      TabStop         =   0   'False
      Top             =   2790
      Width           =   2625
   End
   Begin VB.TextBox txtPassword 
      Height          =   276
      IMEMode         =   3  'DISABLE
      Index           =   2
      Left            =   1425
      PasswordChar    =   "*"
      TabIndex        =   10
      TabStop         =   0   'False
      Top             =   2355
      Width           =   2625
   End
   Begin VB.TextBox txtPassword 
      Height          =   276
      IMEMode         =   3  'DISABLE
      Index           =   1
      Left            =   1425
      PasswordChar    =   "*"
      TabIndex        =   8
      TabStop         =   0   'False
      Top             =   1920
      Width           =   2625
   End
   Begin VB.TextBox txtPassword 
      Height          =   276
      IMEMode         =   3  'DISABLE
      Index           =   0
      Left            =   1425
      PasswordChar    =   "*"
      TabIndex        =   3
      Top             =   1095
      Width           =   1320
   End
   Begin VB.ComboBox cboUserName 
      Height          =   300
      Left            =   1425
      TabIndex        =   1
      Top             =   612
      Width           =   1320
   End
   Begin VB.Label Label1 
      Caption         =   "确认口令(&F)"
      Height          =   210
      Index           =   5
      Left            =   270
      TabIndex        =   11
      Top             =   2823
      Width           =   1020
   End
   Begin VB.Label Label1 
      Caption         =   "新 口 令(&N)"
      Height          =   210
      Index           =   4
      Left            =   270
      TabIndex        =   9
      Top             =   2388
      Width           =   1020
   End
   Begin VB.Label Label1 
      Caption         =   "旧 口 令(&O)"
      Height          =   210
      Index           =   3
      Left            =   270
      TabIndex        =   7
      Top             =   1953
      Width           =   1020
   End
   Begin VB.Label Label1 
      Caption         =   "操 作 员(&U)"
      Height          =   210
      Index           =   1
      Left            =   330
      TabIndex        =   0
      Top             =   657
      Width           =   1005
   End
   Begin VB.Label Label2 
      Caption         =   "口    令(&P)"
      Height          =   180
      Index           =   3
      Left            =   330
      TabIndex        =   2
      Top             =   1143
      Width           =   1005
   End
   Begin VB.Label Label1 
      Caption         =   "注册日期(&D)"
      Height          =   210
      Index           =   0
      Left            =   330
      TabIndex        =   13
      Top             =   198
      Width           =   1005
   End
End
Attribute VB_Name = "frmLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''
'用户登录窗体
'
'作者:苏涛
'
'日期:1998.6.23
'
'''''''''''''''''''''''''''''''''''''''''
Option Explicit

Private mblnLoginSuccessed As Boolean  '登录是否成功
Private mintCount As Integer           '试注册次数
Private mlngUserID As Long
Private mrecUser As rdoResultset
Private mstrPassword As String          '用户口令
Public lngFrmLonginCount As Long
Private mstrOldFile As String
Private mlPosition() As Long

'登陆接口
Public Function LogIn() As Boolean
   ' If Not HideMdiForm Then Exit Function
    If Not LoginCloseMdiForm Then Exit Function
    Me.Show vbModal
'    If Not mblnLoginSuccessed Then
'        ShowMdiForm
'    Else
'        If Not LoginCloseMdiForm Then Exit Function
'    End If
    If mblnLoginSuccessed Then
        If Not SetVersionInFoInRight(gclsBase.AccountSys) Then mblnLoginSuccessed = False
    End If
    LogIn = mblnLoginSuccessed
    If mblnLoginSuccessed Then
        Utility.ClearListRecordSet
        'frmActiveSet.RefreshSetting
    End If
    
'    If mblnLoginSuccessed Then UserRight.ShowWarnList
     'If mblnLoginSuccessed Then SetMenuRight
End Function
'检查登录用户
Private Function CheckUser() As Boolean
    CheckUser = False
    If mrecUser Is Nothing Then Exit Function
    If Not mrecUser.BOF Then mrecUser.MoveFirst
    Do Until mrecUser.EOF
        If Trim$(cboUserName) = Trim$(mrecUser!strOperatorName) Then Exit Do
        mrecUser.MoveNext
    Loop
    If mrecUser.EOF Then
        mintCount = mintCount + 1
        If mintCount < 3 Then
            ShowMsg 0, "操作员" & Trim$(cboUserName) _
                & "不存在,请重新录入或选择操作员!", vbCritical + MB_TASKMODAL, Me.Caption
            cboUserName.SetFocus
        End If
    Else
        mstrPassword = Format$(mrecUser!strPassWord, "@;;;")
        mlngUserID = mrecUser!lngOperatorID
        CheckUser = True
    End If
End Function

'检查口令
Private Function CheckPassword() As Boolean
    CheckPassword = False
    If txtPassword(0).Enabled Then
        If mstrPassword <> txtPassword(0) Then
            mintCount = mintCount + 1
            Exit Function
        End If
    Else
        If mstrPassword <> txtPassword(1) Then
            mintCount = mintCount + 1
            Exit Function
        End If
    End If
    CheckPassword = True
End Function

Private Sub cboUserName_Click()
    txtPassword(0).Enabled = True
    txtPassword(0).BackColor = &H80000005
    CmdOK(2).Enabled = True
End Sub

Private Sub cmdOK_Click(Index As Integer)
    Dim recTemplete  As rdoResultset
    Dim recBusiness As rdoResultset
    Dim strSql As String
    Dim BeginDate As Date
    Dim EndDate As Date
    If Index = 0 Then
        If Not CheckLoginDate Then
            On Error Resume Next
            If dteLogin.Visible Then dteLogin.SetFocus
            On Error GoTo 0
            Exit Sub
        End If
        If Not CheckUser Then
            If mintCount < 3 Then Exit Sub
            ShowMsg 0, "注册无效,谢绝使用!", vbCritical + MB_TASKMODAL, Me.Caption
        ElseIf 1 = 2 And Not CheckPassword Then
            If mintCount < 3 Then
                ShowMsg 0, "口令有误,请重新录入!", vbCritical + MB_SYSTEMMODAL, Me.Caption
                If txtPassword(0).Enabled Then
                    On Error Resume Next
                    txtPassword(0).SetFocus
                    On Error GoTo 0
                Else
                    txtPassword(1).SetFocus
                End If
                SendKeys "{HOME}" & "+{END}"
                Exit Sub
            Else
                ShowMsg 0, "注册无效,谢绝使用!", vbCritical + MB_TASKMODAL, Me.Caption
            End If
        Else
            If Not txtPassword(0).Enabled Then
                If Trim$(txtPassword(2)) <> Trim$(txtPassword(3)) Then
                    ShowMsg 0, "<新口令>与<确认口令>不一致!", vbCritical + MB_TASKMODAL, Me.Caption
                    txtPassword(2).SetFocus
                    Exit Sub
                Else
                    If gclsBase.ExecSQL("UPDATE Operator SET strPassword='" _
                        & txtPassword(2) & "' WHERE lngOperatorID=" _
                        & mlngUserID) Then _
                        ShowMsg 0, "口令设置成功!", vbInformation + MB_TASKMODAL, Me.Caption
                End If
            End If
            #If conVersionType = 4 Then
                If IsDate(dteLogin.Text) Then
                    If CDate(Format(dteLogin.Text, "yyyy-mm-dd")) > CDate(Format("1998-12-31", "yyyy-mm-dd")) Then
                        ShowMsg 0, "实达专用版注册日期不能大于1998年12月31日。", vbExclamation + MB_TASKMODAL, Me.Caption
                        On Error Resume Next
                        If dteLogin.Visible Then dteLogin.SetFocus
                        On Error GoTo 0
                        Exit Sub
                    End If
                Else
                    On Error Resume Next
                   If dteLogin.Visible Then dteLogin.SetFocus
                   On Error GoTo 0
                    mblnLoginSuccessed = False
                    Exit Sub
                End If
            #End If
'            Set recTemplete = gclsBase.BaseDB.openresultset("Select * From AccountYear Where intYear=" & gclsBase.FYearOfDate(Format(dteLogin.Text, "yyyy-mm-dd")), rdopenstatic)
'            If recTemplete.rowcount <> 0 Then
'                If IsDate(dteLogin.Text) Then
'                    If CDate(dteLogin.Text) < CDate(recTemplete!strStartDate) Or CDate(dteLogin.Text) > CDate(recTemplete!strEndDate) Then
'                        ShowMsg 0, "注册日期不在会计年度期间", vbExclamation + MB_TASKMODAL, Me.Caption
'                        dteLogin.SetFocus
'                        mblnLoginSuccessed = False
'                        Exit Sub
'                    End If
'                Else
'                    dteLogin.SetFocus
'                    mblnLoginSuccessed = False
'                    Exit Sub
'                End If
'            Else
'                ShowMsg 0, "注册日期不在会计年度期间", vbExclamation + MB_TASKMODAL, Me.Caption
'                dteLogin.SetFocus
'                mblnLoginSuccessed = False
'                Exit Sub
'            End If
'            Set recTemplete = gclsBase.BaseDB.openresultset("Select  bytperiod,  format(strStartDate,'yyyy-mm-dd') as EndDate From AccountPeriod Where intYear>=1999 order by intyear, bytperiod  ", rdopenstatic)
            Set recTemplete = gclsBase.BaseDB.OpenResultset("Select strStartDate as EndDate From AccountYear  Where intYear>=1999 order by intyear  ", rdOpenStatic)
            gclsBase.DemoVersion = False
            
        #If conDebug = 0 Then
            If Not ExistInDog Then
                If IsDate(dteLogin.Text) Then
                    If CDate(Format(dteLogin.Text, "yyyy-mm-dd")) > CDate(Format("1999-12-31", "yyyy-mm-dd")) Then
'                            ShowMsg 0, "演示版不能打开1999年12月31日后的帐套。", vbExclamation + MB_TASKMODAL, Me.Caption
'                            On Error Resume Next
'                            If dteLogin.Visible Then dteLogin.SetFocus
'                            On Error GoTo 0
'                            Exit Sub
                    Else
                        If recTemplete.RowCount <> 0 Then
                            If Not recTemplete.EOF Then recTemplete.MoveLast
                            If CDate(recTemplete!EndDate) > CDate(Format("1999-12-31", "yyyy-mm-dd")) Then
                                ShowMsg 0, "学习版软件不能打开正式版，请使用正式版。", vbExclamation + MB_TASKMODAL, Me.Caption
                                
                                If dteLogin.Visible Then
                                On Error Resume Next
                                dteLogin.SetFocus
                                On Error GoTo 0
                                End If
                                Exit Sub
                            End If
'                        Else
'                                ShowMsg 0, "没有会计年度期间结束日期。", vbExclamation + MB_TASKMODAL, Me.Caption