其他数据库

开发平台：
Visual Basic

frmMDI.frm：源码内容
							VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.MDIForm frmMDI 
   BackColor       =   &H00808000&
   Caption         =   "考勤系统"
   ClientHeight    =   8310
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   11880
   Icon            =   "frmMDI.frx":0000
   LinkTopic       =   "MDIForm1"
   Picture         =   "frmMDI.frx":030A
   StartUpPosition =   2  '屏幕中心
   WindowState     =   2  'Maximized
   Begin ComctlLib.Toolbar tlbMain 
      Align           =   1  'Align Top
      Height          =   750
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   11880
      _ExtentX        =   20955
      _ExtentY        =   1323
      ButtonWidth     =   1455
      ButtonHeight    =   1164
      Appearance      =   1
      ImageList       =   "imlToolbarIcons"
      _Version        =   327682
      BeginProperty Buttons {0713E452-850A-101B-AFC0-4210102A8DA7} 
         NumButtons      =   5
         BeginProperty Button1 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Key             =   "tbCollection"
            Object.ToolTipText     =   "打卡数据采集"
            Object.Tag             =   ""
            ImageIndex      =   2
         EndProperty
         BeginProperty Button2 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Key             =   ""
            Object.Tag             =   ""
            Style           =   3
            MixedState      =   -1  'True
         EndProperty
         BeginProperty Button3 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Key             =   "tbLeave"
            Object.ToolTipText     =   "请假登记"
            Object.Tag             =   ""
            ImageIndex      =   3
         EndProperty
         BeginProperty Button4 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Key             =   ""
            Object.Tag             =   ""
            Style           =   3
            MixedState      =   -1  'True
         EndProperty
         BeginProperty Button5 {0713F354-850A-101B-AFC0-4210102A8DA7} 
            Key             =   "mClose"
            Object.Tag             =   ""
            ImageIndex      =   1
         EndProperty
      EndProperty
   End
   Begin ComctlLib.StatusBar stbMain 
      Align           =   2  'Align Bottom
      Height          =   360
      Left            =   0
      TabIndex        =   0
      Top             =   7950
      Width           =   11880
      _ExtentX        =   20955
      _ExtentY        =   635
      SimpleText      =   ""
      _Version        =   327682
      BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7} 
         NumPanels       =   5
         BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7} 
            AutoSize        =   2
            Key             =   ""
            Object.Tag             =   ""
            Object.ToolTipText     =   "日期"
         EndProperty
         BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7} 
            Style           =   5
            AutoSize        =   2
            TextSave        =   "16:36"
            Key             =   ""
            Object.Tag             =   ""
            Object.ToolTipText     =   "时间"
         EndProperty
         BeginProperty Panel3 {0713E89F-850A-101B-AFC0-4210102A8DA7} 
            AutoSize        =   2
            Text            =   "操作员"
            TextSave        =   "操作员"
            Key             =   "stbOperater"
            Object.Tag             =   ""
            Object.ToolTipText     =   "操作员"
         EndProperty
         BeginProperty Panel4 {0713E89F-850A-101B-AFC0-4210102A8DA7} 
            Text            =   "操作级别"
            TextSave        =   "操作级别"
            Key             =   "stbLevel"
            Object.Tag             =   ""
            Object.ToolTipText     =   "操作级别"
         EndProperty
         BeginProperty Panel5 {0713E89F-850A-101B-AFC0-4210102A8DA7} 
            AutoSize        =   1
            Object.Width           =   10134
            Text            =   "提示信息"
            TextSave        =   "提示信息"
            Key             =   "stbMsg"
            Object.Tag             =   ""
            Object.ToolTipText     =   "提示信息"
         EndProperty
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin ComctlLib.ImageList imlToolbarIcons 
      Left            =   2265
      Top             =   1740
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   42
      ImageHeight     =   38
      MaskColor       =   12632256
      _Version        =   327682
      BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} 
         NumListImages   =   3
         BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frmMDI.frx":E8C0
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frmMDI.frx":FC12
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frmMDI.frx":10F64
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu mnuFileReg 
         Caption         =   "登录(&L)..."
      End
      Begin VB.Menu mnuFileBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit 
         Caption         =   "退出(&X)"
      End
   End
   Begin VB.Menu mnuEdit 
      Caption         =   "编辑(&E)"
      Visible         =   0   'False
      Begin VB.Menu mnuEditCut 
         Caption         =   "剪切(&T)"
         Shortcut        =   ^X
      End
      Begin VB.Menu mnuEditCopy 
         Caption         =   "复制(&C)"
         Shortcut        =   ^C
      End
      Begin VB.Menu mnuEditPaste 
         Caption         =   "粘贴(&P)"
         Shortcut        =   ^V
      End
   End
   Begin VB.Menu mnuApp 
      Caption         =   "应用(&A)"
      Begin VB.Menu mnuAppCollection 
         Caption         =   "打卡数据采集(&C)..."
      End
      Begin VB.Menu mnuAppBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuAppDefine 
         Caption         =   "班次定义(&D)..."
      End
      Begin VB.Menu mnuAppPlan 
         Caption         =   "日常排班(&P)..."
      End
      Begin VB.Menu mnuAppChange 
         Caption         =   "调班换班(&H)..."
      End
      Begin VB.Menu mnuAppBar2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuAppLeave 
         Caption         =   "请假登记(&L)..."
      End
      Begin VB.Menu mnuAppAbsent 
         Caption         =   "其他缺席登记(B)..."
      End
   End
   Begin VB.Menu mnuGuard 
      Caption         =   "数据管理(&G)"
      Begin VB.Menu mnuGuardBase 
         Caption         =   "基本数据管理(&B)..."
      End
      Begin VB.Menu mnuGuardEmployee 
         Caption         =   "员工管理(&E)..."
      End
      Begin VB.Menu mnuGuardBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuGuardRight 
         Caption         =   "权限管理(&R)..."
      End
      Begin VB.Menu mnuGuardBar2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuGuardLib 
         Caption         =   "数据库管理..."
      End
   End
   Begin VB.Menu mnuRep 
      Caption         =   "报表中心(&R)"
      Begin VB.Menu mnuRepShift 
         Caption         =   "班次表(&S)..."
         Visible         =   0   'False
      End
      Begin VB.Menu mnuRepPlan 
         Caption         =   "排班表(&P)..."
         Visible         =   0   'False
      End
      Begin VB.Menu mnuRepDyn 
         Caption         =   "日动态考勤报表(&D)"
      End
      Begin VB.Menu mnuRepFlow 
         Caption         =   "打卡流水报表(&F)..."
      End
      Begin VB.Menu mnuRepBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuRepKQ 
         Caption         =   "考勤明细报表(&K)..."
      End
      Begin VB.Menu mnuRepMonth 
         Caption         =   "考勤月报表(&M)..."
      End
   End
   Begin VB.Menu mnuCard 
      Caption         =   "IC卡管理(&I)"
      Begin VB.Menu mnuCardNew 
         Caption         =   "发新卡(&N)..."
      End
      Begin VB.Menu mnuCardChange 
         Caption         =   "更换IC卡(&C)..."
      End
      Begin VB.Menu mnuCardBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuPowerOn 
         Caption         =   "上电"
      End
      Begin VB.Menu mnuPowerOff 
         Caption         =   "下电"
      End
      Begin VB.Menu mnuATR 
         Caption         =   "复位应答"
      End
      Begin VB.Menu mnuReadMain 
         Caption         =   "读主存储器"
      End
      Begin VB.Menu mnuReadProtect 
         Caption         =   "读保护存储器"
      End
      Begin VB.Menu mnuSecurity 
         Caption         =   "读保密存储器"
      End
      Begin VB.Menu mnuReadErrorCount 
         Caption         =   "读错误计数"
      End
      Begin VB.Menu mnuPSCCheck 
         Caption         =   "校对密码"
      End
      Begin VB.Menu mnuChangePSC 
         Caption         =   "更改密码"
      End
      Begin VB.Menu mnuWriteMain 
         Caption         =   "写主存储器"
      End
   End
   Begin VB.Menu mnuPos 
      Caption         =   "考勤机管理(&K)"
      Begin VB.Menu mnuPosSetDate 
         Caption         =   "考勤机时间设置(&S)..."
      End
      Begin VB.Menu mnuPosSetRecordCount 
         Caption         =   "考勤机记录总数设置"
      End
      Begin VB.Menu mnuPosSetPort 
         Caption         =   "通讯端口设置"
         Begin VB.Menu mnuPosSetComm 
            Caption         =   "串口1"
            Index           =   0
         End
         Begin VB.Menu mnuPosSetComm 
            Caption         =   "串口2"
            Index           =   1
         End
      End
   End
   Begin VB.Menu mnuSet 
      Caption         =   "设置(&S)"
      Begin VB.Menu mnuSetOption 
         Caption         =   "选项(&O)..."
      End
   End
End
Attribute VB_Name = "frmMDI"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const MDIMsg1 = "您确定要退出本系统吗?"
Const mStrCollection = "打卡数据采集"
Const mStrLeave = "请假登记"
Const mstrAbsent = "其他缺席登记"
Const mMsg2 = "抱歉,您的权限不够操作该模块!!!"
'tlbMain
Const mClose = 5
'stbMain
Const mstbDate = 1
Const mstbTime = 2
Const mstbOperator = 3
Const mstbLevel = 4
Const mstbMsg = 5
Dim misStart As Boolean
Private Sub MDIForm_Activate()
    If misStart Then
        SetMenu gLoginGrade = 1
        misStart = False
    End If
End Sub
Private Sub MDIForm_Load()
    mnuPosSetComm(gCommPort).Checked = True
    Me.WindowState = 2
    misStart = True
End Sub
Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If UnloadMode = vbFormControlMenu Then
        If MsgBox(MDIMsg1, _
            vbQuestion + vbYesNo + vbDefaultButton2, _
            gTitle) = vbNo Then Cancel = True
    End If
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
    EndSystem
End Sub
Private Sub mnuAppAbsent_Click()
    IntofrmMain gMAINABSENT
End Sub
Private Sub mnuAppChange_Click()
    frmChange.Show vbModal
End Sub
Private Sub mnuAppCollection_Click()
    IntofrmMain gMAINCOLLECT
End Sub
Private Sub IntofrmMain(intMainType As Integer)
    Dim MyfrmMain As frmMain
    Set MyfrmMain = New frmMain
    Dim Str As String
    With MyfrmMain
        .mMenuIndex = intMainType
        Select Case intMainType
            Case gMAINCOLLECT
                Str = mStrCollection
            Case gMAINLEAVE
                Str = mStrLeave
            Case gMAINABSENT
                Str = mstrAbsent
        End Select
        .Caption = Str
        .Show 0, Me
    End With
    'Unload MyfrmMain
End Sub
Private Sub mnuAppDefine_Click()
    frmShift.Show vbModal
End Sub
Private Sub mnuAppLeave_Click()
    IntofrmMain gMAINLEAVE
End Sub
Private Sub mnuAppPlan_Click()
    frmPlan.Show vbModal
End Sub
Private Sub mnuATR_Click()
    Dim strATR As String * 8
    Dim nRet As Integer
    nRet = OpenComm(0)
    nRet = CardExist
    If nRet = 0 Then
        MsgBox "No Card"
        Exit Sub
    End If
    nRet = IC_ATR(strATR)
    If nRet <> 0 Then
       MsgBox "Error Read ATR"
       Exit Sub
    End If
    frmReadWrite.txtData.Text = Mid(strATR, 1, 1) & Mid(strATR, 2, 1) & " " & _
                   Mid(strATR, 3, 1) & Mid(strATR, 4, 1) & " " & _
                   Mid(strATR, 5, 1) & Mid(strATR, 6, 1) & " " & _
                   Mid(strATR, 7, 1) & Mid(strATR, 8, 1)
    frmReadWrite.Show 1
End Sub
Private Sub mnuCardNew_Click()
    frmNewCard.Show 1
End Sub
Private Sub mnuFileExit_Click()
    If MsgBox(MDIMsg1, _
        vbQuestion + vbYesNo + vbDefaultButton2, _
        gTitle) = vbNo Then Exit Sub
    EndSystem
End Sub
Private Sub mnuFileReg_Click()
    frmLogin.Show 1
    SetMenu gLoginGrade = 1
End Sub
Private Sub mnuGuardBase_Click()
    frmItem.Show 1
End Sub
Private Sub mnuGuardEmployee_Click()
    frmEmploy.Show vbModal
End Sub
Private Sub mnuGuardLib_Click()
    frmSys.Show 1
End Sub
Private Sub mnuPosSetComm_Click(Index As Integer)
    mnuPosSetComm(0).Checked = (Index = 0)
    mnuPosSetComm(1).Checked = (Index = 1)
    gCommPort = Index
End Sub
Private Sub mnuPosSetDate_Click()
    frmSetDate.Show 1
End Sub
Private Sub mnuPosSetRecordCount_Click()
    frmSetRecordCount.Show 1
End Sub
Private Sub mnuPowerOff_Click()
    Dim nRet As Integer
    nRet = OpenComm(0)
    nRet = PowerOff
End Sub
Private Sub mnuPowerOn_Click()
    Dim nRet As Integer
    nRet = OpenComm(0)
    nRet = PowerOn
End Sub
Private Sub mnuReadMain_Click()
    Dim strMain As String * 512
    Dim i As Integer, j As Integer, nRet As Integer
    nRet = OpenComm(0)
    nRet = IC_ReadMain(0, 256, strMain)
    If nRet <> 0 Then
       MsgBox "Error Read Main Memory"
       Exit Sub
    End If
    frmReadWrite.txtData.Text = ""
    For i = 0 To 15
        For j = 0 To 15
            frmReadWrite.txtData.Text = frmReadWrite.txtData.Text & Mid(strMain, 32 * i + 2 * j + 1, 1) & Mid(strMain, 32 * i + 2 * j + 2, 1) & " "
        Next j
        frmReadWrite.txtData.Text = frmReadWrite.txtData.Text & Chr(13) & Chr(10)
    Next i
    frmReadWrite.Show 1
End Sub
Private Sub mnuRepDyn_Click()
    frmDyn.Show 1
End Sub
Private Sub mnuRepFlow_Click()
    frmFlow.Show 1
End Sub
Private Sub mnuRepKQ_Click()
    frmPrn.Show 1
End Sub
Private Sub mnuRepMonth_Click()
    With frmMonth
        .Show '不能显示有模式,因当中有显示非模式的窗体
    End With
End Sub
Private Sub SetMenu(isEnable As Boolean)
    'mnuFile.Enabled = isEnable
    mnuApp.Enabled = isEnable
    mnuGuard.Enabled = isEnable
    mnuRep.Enabled = isEnable
    mnuCard.Enabled = isEnable
    mnuPos.Enabled = isEnable
    mnuSet.Enabled = isEnable
    SetstbMain mstbOperator, gLoginName
    
    Dim strTmp As String
    If isEnable Then
        strTmp = "管理员"
    Else
        strTmp = "客户级"
    End If
    SetstbMain mstbLevel, strTmp
    SetstbMain mstbDate, Format(Date, "yyyy-mm-dd")
    SetstbMain mstbMsg, gOwnName
End Sub
Private Sub SetstbMain(Index As Integer, strText As String)
    stbMain.Panels(Index).Text = strText
End Sub
Private Sub mnuSetOption_Click()
    frmOption.Show 1
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
    On Error Resume Next
    If Button.Index <> mClose Then
        If gLoginGrade = 0 Then
            MsgBox mMsg2, vbInformation, gTitle
            Exit Sub
        End If
    End If
    Select Case Button.Key
        Case "tbCollection"
            mnuAppCollection_Click
        Case "tbLeave"
            mnuAppLeave_Click
    End Select
End Sub

						