frmlogin.frm

针对农资系统的管理模式而开发的业务部门与财务部门的转账模式和过程

VERSION 5.00
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmLogin 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "登录"
   ClientHeight    =   2475
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3105
   Icon            =   "frmLogin.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2475
   ScaleWidth      =   3105
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Height          =   1935
      Left            =   120
      TabIndex        =   6
      Top             =   0
      Width           =   2895
      Begin MSDataListLib.DataCombo dacDepart 
         Height          =   330
         Left            =   960
         TabIndex        =   0
         Top             =   240
         Width           =   1695
         _ExtentX        =   2990
         _ExtentY        =   582
         _Version        =   393216
         Style           =   2
         Text            =   ""
      End
      Begin VB.ComboBox cobOperator 
         Height          =   300
         Left            =   960
         Style           =   2  'Dropdown List
         TabIndex        =   1
         Top             =   660
         Width           =   1695
      End
      Begin VB.TextBox txtPassword 
         Height          =   300
         IMEMode         =   3  'DISABLE
         Left            =   960
         PasswordChar    =   "*"
         TabIndex        =   2
         Top             =   1050
         Width           =   1695
      End
      Begin MSComCtl2.DTPicker dtpDate 
         Height          =   300
         Left            =   960
         TabIndex        =   3
         Top             =   1440
         Width           =   1695
         _ExtentX        =   2990
         _ExtentY        =   529
         _Version        =   393216
         Format          =   24641536
         CurrentDate     =   36452
      End
      Begin VB.Label lblLabels 
         AutoSize        =   -1  'True
         Caption         =   "日  期"
         Height          =   180
         Index           =   3
         Left            =   240
         TabIndex        =   10
         Top             =   1485
         Width           =   540
      End
      Begin VB.Label lblLabels 
         AutoSize        =   -1  'True
         Caption         =   "部  门"
         Height          =   180
         Index           =   2
         Left            =   240
         TabIndex        =   9
         Top             =   315
         Width           =   540
      End
      Begin VB.Label lblLabels 
         AutoSize        =   -1  'True
         Caption         =   "姓  名"
         Height          =   180
         Index           =   0
         Left            =   240
         TabIndex        =   8
         Top             =   700
         Width           =   540
      End
      Begin VB.Label lblLabels 
         AutoSize        =   -1  'True
         Caption         =   "口  令"
         Height          =   180
         Index           =   1
         Left            =   240
         TabIndex        =   7
         Top             =   1105
         Width           =   540
      End
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消"
      CausesValidation=   0   'False
      Height          =   360
      Left            =   1800
      TabIndex        =   5
      Tag             =   "取消"
      Top             =   2040
      Width           =   1020
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Height          =   360
      Left            =   360
      TabIndex        =   4
      Tag             =   "确定"
      Top             =   2040
      Width           =   1020
   End
End
Attribute VB_Name = "frmLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public OK As Boolean
Dim m_SystemRs As ADODB.Recordset
Dim m_DepartRs As ADODB.Recordset
Dim m_OperatorRs As ADODB.Recordset
Dim m_sCaption As String
Dim m_LastDate As Date

Property Let SetMeCaption(sCaption As String)
    m_sCaption = sCaption
End Property

Private Function GetCurMonthLastDate(CloseAccDate As Date, CloseDay As Integer) As Date
    Dim LastDate As Date
    
    LastDate = CloseAccDate + 40
    LastDate = LastDate - Day(LastDate)     '月底结帐
    If CloseDay <> 0 Then   '25, 26, 27, 28日结帐
        If Month(LastDate) <> 12 Then
            LastDate = Year(LastDate) & "-" & Month(LastDate) & "-" & CloseDay
        End If
    End If
    
    GetCurMonthLastDate = LastDate
End Function

'///////////////////////////////////////////////////////////
'//
Private Function CheckValidatity() As Boolean
    CheckValidatity = False
    If dacDepart.Text = "" Then
        MsgBox "请选择部门!", vbOKOnly + vbInformation, "提示:"
        dacDepart.SetFocus
        Exit Function
    End If
    
    If cobOperator.Text = "" Then
        MsgBox "请选择操作员!", vbOKOnly + vbInformation, "提示:"
        cobOperator.SetFocus
        Exit Function
    End If
    
    If txtPassword.Text = "" Then
        MsgBox "请输入口令!", vbOKOnly + vbInformation, "提示:"
        txtPassword.SetFocus
        Exit Function
    End If
    
    If Not IsDate(dtpDate.Value) Then
        MsgBox "输入日期无效!", vbOKOnly + vbInformation, "提示:"
        dtpDate.SetFocus
        Exit Function
    ElseIf Not (dtpDate.Value > m_SystemRs![FCloseAccDate] And dtpDate.Value <= m_LastDate) Then
        MsgBox "登录日期有误!" & Chr(13) & "有效日期：" & Format(m_SystemRs![FCloseAccDate] + 1, "yyyy年mm月dd日") _
            & " 至 " & Format(m_LastDate, "yyyy年mm月dd日"), vbOKOnly + vbInformation, "提示："
        dtpDate.SetFocus
        Exit Function
    End If
    
    CheckValidatity = True
End Function

'/////////////////////////////////////////////////
'//
Private Sub cmdCancel_Click()
    OK = False
    Me.Hide
End Sub

Private Sub cmdOk_Click()
    If Not CheckValidatity() Then Exit Sub
    Dim sDepartCode As String, sName As String, sPassword As String
    
    sDepartCode = dacDepart.BoundText
    sName = cobOperator.Text
    sPassword = txtPassword.Text
    
    If cobOperator.ListIndex = 0 Then           '主管登录
        If sName = m_DepartRs![FDepartMaster] And sPassword = m_DepartRs![FPassword] Then
            If sDepartCode = "" Then            '超级主管
                m_gnLevel = SUPPER_MANAGER
            Else                                '部门主管
                m_gnLevel = DEPART_MANAGER
            End If
            GoTo Login_Ok
        End If
        
        GoTo Login_Fail
    Else                                        '普通操作员登录
        With m_OperatorRs
            .Filter = "FDepartCode = '" & sDepartCode & "' And FOperatorName = '" & sName & "' And FPassword = '" & sPassword & "'"
            If Not (.EOF And .BOF) Then
                m_gnLevel = GENERAL_OPERATOR
                GoTo Login_Ok
            End If
            
            GoTo Login_Fail
        End With
    End If
    
Login_Ok:
    m_sUnitName = m_SystemRs![FUserUnitName]
    m_gLoginDate = dtpDate.Value
    m_gnYear = Year(m_LastDate)
    m_gbyMonth = Month(m_LastDate)
    
    m_gsDepartCode = sDepartCode
    m_gnDepartAttrib = m_DepartRs![FDepartAttrib]
    m_gsOperator = sName
    m_gsPassword = sPassword
    
    OK = True
    Me.Hide
    Exit Sub
    
Login_Fail:
    MsgBox "密码错误，再试一次！", vbOKOnly + vbCritical, "提示："
    txtPassword.SetFocus
    txtPassword.SelStart = 0
    txtPassword.SelLength = Len(txtPassword.Text)
End Sub

'/////////////////////////////////////////////
'//
Private Sub cobOperator_GotFocus()
    If dacDepart.Text = "" Then
        dacDepart.SetFocus
        Exit Sub
    End If
End Sub

Private Sub dacDepart_Change()
    m_DepartRs.Bookmark = dacDepart.SelectedItem
    cobOperator.Clear
    cobOperator.AddItem m_DepartRs![FDepartMaster]
    
    Set m_OperatorRs = New ADODB.Recordset
    m_OperatorRs.Open "Select FDepartCode, FOperatorName, FPassword From Operator Where FDepartCode = '" & dacDepart.BoundText & "' Order by FOperatorName", m_gDBCnn, adOpenStatic, adLockReadOnly, adCmdUnknown
    Do While Not m_OperatorRs.EOF
        cobOperator.AddItem m_OperatorRs![FOperatorName]
        m_OperatorRs.MoveNext
    Loop
End Sub

Private Sub DACDepart_Validate(Cancel As Boolean)
    If Not dacDepart.MatchedWithList Then
        Cancel = True
    End If
End Sub

Private Sub dtpDate_KeyDown(KeyCode As Integer, Shift As Integer)
    Form_KeyPress (KeyCode)
End Sub

'/////////////////////////////////////////////
'//
Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{Tab}"
    End If
End Sub

Private Sub Form_Load()
    Dim sSqlStr As String
    
    Me.Caption = m_sCaption
    SetForm Me, 9
    
    Set m_SystemRs = New ADODB.Recordset
    With m_SystemRs
        .Open "Select * From System", m_gDBCnn
        m_LastDate = GetCurMonthLastDate(![FCloseAccDate], ![FCloseDay])
    End With
    
    sSqlStr = "Select FDepartCode, FDepartName, FDepartMaster, FPassword, FDepartAttrib From Depart " & _
        " UNION Select '', '系统超级主管', FSupperManager, FPassword, -1 From System " & _
        " Order by FDepartCode"
    Set m_DepartRs = New ADODB.Recordset
    m_DepartRs.Open sSqlStr, m_gDBCnn, adOpenStatic, adLockReadOnly, adCmdUnknown
    With dacDepart
        Set .RowSource = m_DepartRs
        .ListField = "FDepartName"
        .BoundColumn = "FDepartCode"
    End With
    
    dtpDate.Value = Date
End Sub