frmlogin.frm

金算盘软件代码

'                                If dteLogin.Visible Then dteLogin.SetFocus
'                                mblnLoginSuccessed = False
'                                Exit Sub
                        End If
                        recTemplete.Close
                    End If
                Else
                    If dteLogin.Visible Then
                        On Error Resume Next
                        dteLogin.SetFocus
                        On Error GoTo 0
                    End If
                    mblnLoginSuccessed = False
                    Exit Sub
                End If
                If gclsBase.VersionType = 1 Then
                    If CDate(Format(dteLogin.Text, "yyyy-mm-dd")) >= CDate(Format(DateAdd("m", 6, CDate(gclsBase.BeginDate)), "yyyy-mm-dd")) Then
                            ShowMsg 0, "教学版仅允许使用六个月！", vbExclamation + MB_TASKMODAL, Me.Caption
                            mblnLoginSuccessed = False
                            gclsBase.DemoVersion = False
                            Exit Sub
                    Else
                        gclsBase.DemoVersion = True
                    End If
                Else
                    If CDate(Format(dteLogin.Text, "yyyy-mm-dd")) >= CDate(Format(DateAdd("m", 3, CDate(gclsBase.BeginDate)), "yyyy-mm-dd")) Then
                            ShowMsg 0, "演示版仅允许使用三个月！", vbExclamation + MB_TASKMODAL, Me.Caption
                            mblnLoginSuccessed = False
                            gclsBase.DemoVersion = False
                            Exit Sub
                    Else
                        gclsBase.DemoVersion = True
                    End If
                End If
           Else
                If gAllInFormation Then '判定是否有全狗并且是否到期
                    If CDate(Format(dteLogin.Text, "yyyy-mm-dd")) > CDate(Format(gEndDate, "yyyy-mm-dd")) Then
                        ShowMsg 0, "加密狗到期了", vbExclamation + MB_TASKMODAL, Me.Caption
                        mblnLoginSuccessed = False
                        Exit Sub
                    End If
                End If
                gclsBase.DemoVersion = False
            End If
        #End If
            Dim strFile As String
            
            mblnLoginSuccessed = True
            gclsBase.OperatorID = mlngUserID
            gclsBase.OperatorName = cboUserName.Text
            gclsBase.BaseDate = dteLogin.Text
            
            strSql = "SELECT Business.* FROM Business  "
            Set recBusiness = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recBusiness.EOF Then
                gclsBase.BaseName = recBusiness!StrUserName
                If CInt(recBusiness!strAccountSystem) <> 1 Then
                    frmMain.mnuAccountProfitLoss.Caption = "收支结转(&T)"
                Else
                    frmMain.mnuAccountProfitLoss.Caption = "损益结转(&T)"
                End If
            End If
            'gclsBase.BaseName = Mid(gclsBase.BaseFile, Len(GetFilePath(gclsBase.BaseFile)) + 2)
            gclsBase.AccountYear = gclsBase.FYearOfDate(dteLogin.Text)
            gclsBase.Period = gclsBase.PeriodOfDate(dteLogin.Text)
            gclsBase.DateOfPeriod gclsBase.AccountYear, gclsBase.Period, BeginDate, EndDate
            InitOperatorAccount gclsBase.OperatorID
            gclsBase.PeriodEnd = EndDate
            gclsBase.PeriodBegin = BeginDate
            If gclsBase.BaseFile <> "" Then SaveSetting App.title, "LOGReg", gclsBase.BaseFile, cboUserName.Text
            'frmActiveSet.InitData
        End If
    ElseIf Index = 2 Then
        If Not CheckUser Then
            If mintCount >= 3 Then
                ShowMsg 0, "注册无效,谢绝使用!", vbCritical + MB_TASKMODAL, Me.Caption
                Unload Me
            Else
                Exit Sub
            End If
        Else
            Me.Height = 3855
            txtPassword(1).TabStop = True
            txtPassword(2).TabStop = True
            txtPassword(3).TabStop = True
            CmdOK(2).Enabled = False
            txtPassword(0).Enabled = False
            txtPassword(0).BackColor = &H80000005
            txtPassword(1).SetFocus
            Exit Sub
        End If
    End If
    Unload Me
End Sub

Private Sub dteLogin_Error(bCancel As Integer)
    bCancel = True
    dteLogin.Text = Format(Date, "yyyy-mm-dd")
End Sub



Private Sub dteLogin_KeyDown(KeyCode As Integer, Shift As Integer, bCancel As Long)
    If KeyCode = 13 Then
        dteLogin_LostFocus
        cboUserName.SetFocus
    End If
End Sub

Private Sub dteLogin_LostFocus()
    If CmdOK(1).Value Then
        CheckLoginDate
    End If
End Sub
'关闭MDI窗体
Public Function LoginCloseMdiForm() As Boolean
    Dim intCount As Integer

    'Close MDI Windows
    gblnCancel = False
    For intCount = 1 To gclsSys.MainControls.Count
       Unload gclsSys.MainControls(gclsSys.MainControls.Count).Form
       If gblnCancel Then Exit Function
    Next
    If gclsSys.MainControls.Count > 0 Then
         ShowMsg frmMain.hwnd, "请先关闭其它窗体，再进行系统登录。", vbInformation, frmMain.Caption
         Utility.ClearListRecordSet
         LoginCloseMdiForm = False
        Exit Function
    End If
    LoginCloseMdiForm = True
End Function
Public Function HideMdiForm() As Boolean
    Dim intCount As Integer

    'Hide MDI Windows
   ' gblnCancel = False
    For intCount = 1 To gclsSys.MainControls.Count
        ReDim Preserve mlPosition(intCount)
        mlPosition(intCount) = gclsSys.MainControls(gclsSys.MainControls.Count).Form.Left
       gclsSys.MainControls(gclsSys.MainControls.Count).Form.Left = -3000
    Next
    HideMdiForm = True
End Function
Public Function ShowMdiForm() As Boolean
    Dim intCount As Integer
    'Show MDI Windows
    For intCount = 1 To gclsSys.MainControls.Count
       gclsSys.MainControls(gclsSys.MainControls.Count).Form.Left = mlPosition(intCount)
    Next
End Function

Private Sub Form_KeyPress(KeyAscii As Integer)
On Error GoTo ErrHandle
        If KeyAscii = vbKeyReturn Then
            BKKEY Me.ActiveControl.hwnd, vbKeyTab
        End If
ErrHandle:
    If TypeOf Me.ActiveControl Is calendar Then
        If KeyAscii = vbKeyReturn Then BKKEY Me.ActiveControl.Window, vbKeyTab
    End If
End Sub

Private Sub Form_Load()
    Dim strName As String
    Dim blnTmp As Boolean
    'SetHelpID hwnd, 20013
    Me.HelpContextID = 20013
    SetHelpID Me.HelpContextID
    ReDim mlPosition(0)
    mstrOldFile = gclsBase.BaseFile
    Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
    mintCount = 0
    mblnLoginSuccessed = False
    Set CmdOK(0).Picture = GetFormResPicture(1001, vbResBitmap)
    Set CmdOK(1).Picture = GetFormResPicture(1002, vbResBitmap)
    Set CmdOK(2).Picture = GetFormResPicture(1028, vbResBitmap)
    dteLogin.Text = Format(Date$, "yyyy-mm-dd") 'LogInDate(StartDate)  'Date$
    Set mrecUser = gclsBase.BaseDB.OpenResultset("SELECT lngOperatorID,strOperatorName," _
        & "strPassword FROM Operator WHERE blnIsInActive=0", rdOpenStatic)
    Do Until mrecUser.EOF
        cboUserName.AddItem mrecUser!strOperatorName
        mrecUser.MoveNext
    Loop
    If gclsBase.BaseFile <> "" Then strName = GetSetting(App.title, "LOGReg", gclsBase.BaseFile, "")
    If Trim(strName) <> "" Then
        blnTmp = False
        mrecUser.MoveFirst
        Do Until mrecUser.EOF
            If mrecUser!strOperatorName = Trim(strName) Then
                blnTmp = True
                Exit Do
            End If
            mrecUser.MoveNext
        Loop
        If blnTmp Then
            cboUserName.Text = strName
        Else
            cboUserName.ListIndex = 0
        End If
    Else
        cboUserName.ListIndex = 0
    End If
    'cboUserName.Text = GetSetting(App.title, "LOGReg", gclsBase.BaseFile, "")
    lngFrmLonginCount = lngFrmLonginCount + 1
    If lngFrmLonginCount = 1 Then
        Me.Caption = "系统登录"
    Else
        Me.Caption = "重新注册"
    End If
    ''''''工资
    Salary.WriteSalaryLogRecordset
End Sub

Private Sub Form_Paint()
    FrameBox hwnd, 75, 75, 2925, 1470
    FrameBox hwnd, 90, 1755, 90 + 4185, 1755 + 1560
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Utility.RemoveFormResPicture (139)
    Utility.RemoveFormResPicture (1001)
    Utility.RemoveFormResPicture (1002)
    Utility.RemoveFormResPicture (1028)
End Sub

Private Sub txtPassword_Change(Index As Integer)
    If Index <> 0 Then
        If StrLen(txtPassword(Index)) > 8 Or _
            ContainErrorChar(txtPassword(Index), "`~!@#$^&*=+'"";:,./?|\") Then
            'SendKeys "{BS}"
            BKKEY txtPassword(Index).hwnd
        End If
    End If
End Sub

'检测注册日期是否正确
Private Function CheckLoginDate() As Boolean
    Dim recBusiness As rdoResultset
    Dim recTemplete As rdoResultset
    Dim dteEnd As Date
    Dim DteTmp As Date
    Dim intCount As Integer
    Dim blnTmp  As Boolean
    Dim strStartDate As String
    Dim strEndDate As String
    Dim StartDate As Date
    Dim EndDate As Date
    If dteLogin.Text = "" Then
        ShowMsg 0, "注册日期不能为空。", vbExclamation + MB_TASKMODAL, Caption
        dteLogin.Text = Format(Date, "yyyy-mm-dd")
        CheckLoginDate = False
        Exit Function
    End If
    If Not IsDate(dteLogin.Text) Then
        ShowMsg 0, "注册日期非法。", vbExclamation + MB_TASKMODAL, Caption
        dteLogin.Text = Format(Date, "yyyy-mm-dd")
        CheckLoginDate = False
        Exit Function
    End If
    Set recBusiness = gclsBase.BaseDB.OpenResultset("SELECT * FROM Business", rdOpenStatic)
        
    With recBusiness
        If Not .EOF Then
            gclsBase.PeriodOfDate CDate(Format(recBusiness!strStartDate, "yyyy-mm-dd")), StartDate, EndDate
            If CDate(Format(dteLogin.Text, "yyyy-mm-dd")) < CDate(StartDate) Then
                ShowMsg 0, "注册日期不能小于帐套启用日期!", vbExclamation + MB_TASKMODAL, Caption
                dteLogin.Text = Format(Date, "yyyy-mm-dd")
                CheckLoginDate = False
                Exit Function
            End If
        Else
            ShowMsg 0, "帐套已被破坏，不能登录!", vbExclamation + MB_TASKMODAL, Caption
            CheckLoginDate = False
            Exit Function
        End If
    End With
    Set recTemplete = gclsBase.BaseDB.OpenResultset("Select * From AccountYear Order by AccountYear.intyear ", rdOpenStatic)
    With recTemplete
        If Not .EOF Then
            .MoveLast
            strEndDate = !strEndDate
            If CDate(Format(dteLogin.Text, "yyyy-mm-dd")) > CDate(Format(recTemplete!strEndDate, "yyyy-mm-dd")) Then
                ShowMsg 0, "注册日期不能大于帐套结束日期!", vbExclamation + MB_TASKMODAL, Caption
                dteLogin.Text = Format(Date, "yyyy-mm-dd")
                CheckLoginDate = False
                Exit Function
            End If
            .MoveFirst
            strStartDate = !strStartDate
            If CDate(Format(dteLogin.Text, "yyyy-mm-dd")) < CDate(Format(recTemplete!strStartDate, "yyyy-mm-dd")) Then
                ShowMsg 0, "注册日期不能小于帐套开始日期!", vbExclamation + MB_TASKMODAL, Caption
                dteLogin.Text = Format(Date, "yyyy-mm-dd")
                CheckLoginDate = False
                Exit Function
            End If
            blnTmp = False
'            If Format(dteLogin.Text, "yyyy-mm-dd") > Format(strEndDate, "yyyy-mm-dd") Then
'            For intCount = 0 To .rowcount - 1
'                If !intyear = Year(Format(dteLogin.Text, "yyyy-mm-dd")) Then
'                    blnTmp = True
'                End If
'                .MoveNext
'            Next
'            If Not blnTmp Then
'                ShowMsg 0, "注册日期不在会计年度内!", vbExclamation + MB_TASKMODAL, Caption
'                dteLogin.Text = Format(Date, "yyyy-mm-dd")
'                CheckLoginDate = False
'                Exit Function
'            End If
        Else
            ShowMsg 0, "帐套已被破坏，不能登录!", vbExclamation + MB_TASKMODAL, Caption
            CheckLoginDate = False
            Exit Function
        End If
    End With
    recBusiness.Close
    Set recBusiness = Nothing
    recTemplete.Close
    Set recTemplete = Nothing
    CheckLoginDate = True
'    On Error Resume Next
'    DteTmp = CDate(Format(dteLogin.Text, "yyyy-mm-dd"))
'    On Error GoTo 0
'    Set recTemplete = gclsBase.BaseDB.openresultset("Select * From AccountYear ", rdopenstatic)
'    If recBusiness.rowcount <> 0 Then
'            If Format(dteLogin.Text, "yyyy-mm-dd") < Format(recBusiness!strStartDate, "yyyy-mm-dd") Then
'                ShowMsg 0, "注册日期不能小于帐套启用日期!", vbExclamation + MB_TASKMODAL, Caption
'                dteLogin.Text = Format(Date, "yyyy-mm-dd")
'                CheckLoginDate = False
'                Exit Function
'            ElseIf recTemplete.rowcount = 0 Then
'                ShowMsg 0, "注册日期帐套不在会计年度内!", vbExclamation + MB_TASKMODAL, Caption
'                dteLogin.Text = Format(Date, "yyyy-mm-dd")
'                CheckLoginDate = False
'                Exit Function
'            ElseIf Format(dteLogin.Text, "yyyy-mm-dd") > Format(recTemplete!strEndDate, "yyyy-mm-dd") Then
'                ShowMsg 0, "注册日期不能大于帐套结束日期!", vbExclamation + MB_TASKMODAL, Caption
'                dteLogin.Text = Format(Date, "yyyy-mm-dd")
'                CheckLoginDate = False
'                Exit Function
'            End If
'        End If
'    End If
'    recBusiness.Close
'    Set recBusiness = Nothing
'    CheckLoginDate = True
End Function

Private Function StartDate() As String
    Dim recTemplate As rdoResultset
    Dim strSql As String
    strSql = "select * from Business"
    Set recTemplate = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recTemplate.EOF Then
        StartDate = recTemplate!strStartDate
    Else
        'ShowMsg 0, "帐套已被破坏，不能登录!", vbExclamation + MB_TASKMODAL, Caption
        StartDate = ""
        Exit Function
    End If
End Function