module1.bas

企业工资管理系统的具体实现

Attribute VB_Name = "Module1"
Public constr As String
Dim path As String
Public yhm1 As String
Public flag As Integer, fcancle As Integer
Public Const FO_MOVE As Long = &H1
Public Const FO_COPY As Long = &H2
Public Const FO_DELETE As Long = &H3
Public Const FO_RENAME As Long = &H4
Public Const FOF_MULTIDESTFILES As Long = &H1
Public Const FOF_CONFIRMMOUSE As Long = &H2
Public Const FOF_SILENT As Long = &H4
Public Const FOF_RENAMEONCOLLISION As Long = &H8
Public Const FOF_NOCONFIRMATION As Long = &H10
Public Const FOF_WANTMAPPINGHANDLE As Long = &H20
Public Const FOF_CREATEPROGRESSDLG As Long = &H0
Public Const FOF_ALLOWUNDO As Long = &H40
Public Const FOF_FILESONLY As Long = &H80
Public Const FOF_SIMPLEPROGRESS As Long = &H100
Public Const FOF_NOCONFIRMMKDIR As Long = &H200

Type SHFILEOPSTRUCT
     hwnd As Long
     wFunc As Long
     pFrom As String
     pTo As String
     fFlags As Long
     fAnyOperationsAborted As Long
     hNameMappings As Long
     lpszProgressTitle As String
End Type

Declare Function SHFileOperation Lib "Shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long


Sub Main()
path = App.path & "\data\manager.mdb"
constr = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & path
frmSplash.Show
frmSplash.Refresh
Load frmyhmm
Load frmmain
'For i = 0 To 10000
'    For j = 0 To 5000
'    Next j
'Next i
Unload frmSplash
frmyhmm.Show 1
If Not frmyhmm.ok Then
        '登录失败，退出应用程序
        End
Else
    Call frmuser
End If

Unload frmyhmm
frmmain.Show
End Sub
Public Function textchange(frm As Form, err1 As Integer)
        If frm.Option1.Value = True Then
            If IsNumeric(frm.Text5.Text) = False And frm.Text5.Text <> "" Then
                MsgBox "产品单价输入非数字，请重新输入！", vbInformation, "提示"
                frm.Text5.Text = ""
                frm.Text5.SetFocus
                err1 = 1
                Exit Function
            ElseIf frm.Text5.Text = "" Then
                MsgBox "产品单价不能为空，请输入数字！", vbInformation, "提示"
                frm.Text5.SetFocus
                err1 = 1
                Exit Function
            ElseIf Len(Trim(frm.Text5.Text)) > 5 Then
                MsgBox "产品单价输入数字过长，不符合实际，请重输！", vbInformation, "提示"
                frm.Text5.SetFocus
                frm.Text5.Text = ""
                err1 = 1
                Exit Function
            End If
        ElseIf frm.Option2.Value = True Then
            If IsNumeric(frm.Text6.Text) = False And frm.Text6.Text <> "" Then
                MsgBox "工时单价输入非数字，请重新输入！", vbInformation, "提示"
                frm.Text6.Text = ""
                frm.Text6.SetFocus
                err1 = 1
                Exit Function
            ElseIf frm.Text6.Text = "" Then
                MsgBox "工时单价不能为空，请输入数字！", vbInformation, "提示"
                frm.Text6.SetFocus
                err1 = 1
                Exit Function
            ElseIf Len(Trim(frm.Text6.Text)) > 5 Then
                MsgBox "工时单价输入数字过长，不符合实际，请重输！", vbInformation, "提示"
                frm.Text6.SetFocus
                frm.Text6.Text = ""
                err1 = 1
                Exit Function
            End If
        End If
        If IsNumeric(frm.Text3.Text) = False And frm.Text3.Text <> "" Then
            MsgBox "迟到扣单价中输入非数字，请重新输入！", vbInformation, "提示"
            frm.Text3.Text = ""
            frm.Text3.SetFocus
            err1 = 1
            Exit Function
        ElseIf frm.Text3.Text = "" Then
                MsgBox "迟到扣单价不能为空，请输入数字！", vbInformation, "提示"
                frm.Text3.SetFocus
                err1 = 1
                Exit Function
        ElseIf Len(Trim(frm.Text3.Text)) > 5 Then
            MsgBox "迟到扣单价中输入数字过长，不符合实际，请重输！", vbInformation, "提示"
            frm.Text3.Text = ""
            frm.Text3.SetFocus
            err1 = 1
            Exit Function
        End If
        If IsNumeric(frm.Text4.Text) = False And frm.Text4.Text <> "" Then
            MsgBox "津贴费中输入非数字，请重新输入！", vbInformation, "提示"
            frm.Text4.Text = ""
            frm.Text4.SetFocus
            err1 = 1
            Exit Function
        ElseIf Len(Trim(frm.Text4.Text)) > 5 Then
            MsgBox "津贴费中输入数字过长，不符合实际，请重输！", vbInformation, "提示"
            frm.Text4.Text = ""
            frm.Text4.SetFocus
            err1 = 1
            Exit Function
        End If
End Function
Function frmwork(frm As Form)
Dim cnn As New ADODB.Recordset
With cnn
    .ActiveConnection = constr
    .CursorLocation = adUseClient
    .CursorType = adOpenDynamic
    .LockType = adLockPessimistic
    .Open "select * from cjb order by cjdh"
    If Not (.EOF And .BOF) Then .MoveFirst
    Do While Not .EOF
        frm.Combo1.AddItem .Fields("cjdh").Value
        .MoveNext
    Loop
    .Close
End With
Set cnn = Nothing
frm.Combo1.Text = frm.Combo1.List(0)
End Function
Sub frmuser()
If yhm1 <> "administrator" Then
    With frmmain
        .recorddj.Enabled = False
        .workerwh.Enabled = False
        .workfp.Enabled = False
        .yeargzdy.Enabled = False
        .recomddj.Enabled = False
        .recorddj.Enabled = False
        .otherdj.Enabled = False
        .monthgzdy.Enabled = False
        .monthgztj.Enabled = False
        .yeargztj.Enabled = False
        .factorysz.Enabled = False
        .databf.Enabled = False
        .datacsh.Enabled = False
        .usersz.Enabled = False
        .datagzdj.Enabled = False
        With .Toolbar1
            .Buttons(1).Enabled = False
            .Buttons(2).Enabled = False
            .Buttons(3).Enabled = False
            .Buttons(9).Enabled = False
            .Buttons(5).Enabled = False
            .Buttons(6).Enabled = False
            .Buttons(7).Enabled = False
            .Buttons(10).Enabled = False
        End With
    End With
Else
    With frmmain
'        .recorddj.Enabled = True
        .workerwh.Enabled = True
        .workfp.Enabled = True
        .yeargzdy.Enabled = True
'        .recomddj.Enabled = False
        .recorddj.Enabled = True
'        .otherdj.Enabled = False
        .monthgzdy.Enabled = True
        .monthgztj.Enabled = True
        .yeargztj.Enabled = True
        .factorysz.Enabled = True
        .databf.Enabled = True
        .datacsh.Enabled = True
        .usersz.Enabled = True
'        .datagzdj.Enabled = False
        With .Toolbar1
'            .Buttons(1).Enabled = True
            .Buttons(2).Enabled = True
            .Buttons(3).Enabled = True
            .Buttons(9).Enabled = True
'            .Buttons(5).Enabled = False
'            .Buttons(6).Enabled = False
'            .Buttons(7).Enabled = False
            .Buttons(10).Enabled = True
        End With
    End With
End If
End Sub
Sub frmgzyesno()
Dim cnn As New ADODB.Recordset
If yhm1 = "administrator" Then
    With cnn
        .ActiveConnection = constr
        .CursorLocation = adUseClient
        .CursorType = adOpenDynamic
        .LockType = adLockBatchOptimistic
        .Open "select * from sbqkb01"
        If Not (.EOF And .BOF) Then
            With frmmain
                .Toolbar1.Buttons(5).Enabled = True
                .Toolbar1.Buttons(6).Enabled = True
                .Toolbar1.Buttons(7).Enabled = True
                .datagzdj.Enabled = True
                .otherdj.Enabled = True
                .recomddj.Enabled = True
                .Toolbar1.Buttons(1).Enabled = False
                .recorddj.Enabled = False
            End With
    '        frmbmb.cmddelete.Enabled = False
        End If
        .Close
    End With
    Set cnn = Nothing
End If
End Sub