mainmodule.bas

本公司开发得大请油田人事管理系统c/s结构

            Exit Sub
        End If
    Else
        If KeyAscii = 8 Then Exit Sub
        If (KeyAscii < 48) Or (KeyAscii > 57) Then
            KeyAscii = 0
            Exit Sub
        End If
    End If
End Sub
'插入系统日志
Public Sub InsertSysLog()
    Dim int4SysLogNo As Long
    Dim strSQL As String
    
    If g_lOprroleNo = 0 Then Exit Sub
    int4SysLogNo = GetMaxNo("T_SYSTEMLOG", "SYSTEM_LOG_NO")
    strSQL = "insert into T_SYSTEMLOG(SYSTEM_LOG_NO,ORGAN_NO,EMP_NO,SYSTEM_LOG_IN_TIME,SYSTEM_LOG_OUT_TIME) values (" _
         & int4SysLogNo & ",'" & g_str4EmpLoginUnit & "'," & g_lEmpNo & ",'" & g_strDateTime4Start & "','" & Now & "')"
    ExcuteSQL strSQL
End Sub

Public Sub CheckReg()
    If G_iIsRegistered <> 1 Then
        If CDate(#4/1/2001#) < Now Then
            Dim i As Long
            Dim strTitle As String
            Randomize
            For i = 0 To Rnd * 10
                strTitle = strTitle & vbTab
            Next
            strTitle = strTitle & "警告"
            For i = 0 To Rnd * 100 + 1
                strTitle = strTitle & vbTab
            Next
            MsgBox "本软件的测试期已过，请使用正式版。", vbQuestion, strTitle
        End If
    End If
End Sub

Public Function HaveOrganNo(ByVal SSComboBoxEx4Small As SSComboBoxEx, ByVal SSComboBoxEx4Large As SSComboBoxEx, ByVal SSComboBoxEx4Company As SSComboBoxEx, ByVal SSComboBoxEx4Organ As SSComboBoxEx) As String
    SSComboBoxEx4Small.CheckList = True
    SSComboBoxEx4Large.CheckList = True
    SSComboBoxEx4Company.CheckList = True
    SSComboBoxEx4Organ.CheckList = True
    If Trim(SSComboBoxEx4Small.text) <> "" Then
        SSComboBoxEx4Small.CheckList = True
        HaveOrganNo = SSComboBoxEx4Small.ItemData(SSComboBoxEx4Small.ListIndex)
    Else
        If Trim(SSComboBoxEx4Large.text) <> "" Then
            SSComboBoxEx4Large.CheckList = True
            HaveOrganNo = SSComboBoxEx4Large.ItemData(SSComboBoxEx4Large.ListIndex)
        Else
            If Trim(SSComboBoxEx4Company.text) <> "" Then
                SSComboBoxEx4Company.CheckList = True
                HaveOrganNo = SSComboBoxEx4Company.ItemData(SSComboBoxEx4Company.ListIndex)
            Else
                If Trim(SSComboBoxEx4Organ.text) <> "" Then
                    SSComboBoxEx4Organ.CheckList = True
                    HaveOrganNo = SSComboBoxEx4Organ.ItemData(SSComboBoxEx4Organ.ListIndex)
                Else
                    MsgBox "请选择工作单位", vbOKOnly, "警告"
                    HaveOrganNo = ""
                End If
            End If
        End If
    End If
End Function

Public Function GetAfterPointTowData(ByVal TotalData As Double) As Double
    Dim i As Long
    Dim DataLen As Long
    DataLen = Len(TotalData)
    For i = 1 To DataLen
        If Mid(TotalData, i, 1) = "." Then
            GetAfterPointTowData = left(TotalData, i + 2)
            Exit For
        End If
        If i = DataLen Then GetAfterPointTowData = TotalData
    Next
End Function

Public Function GetToolTipText(ByVal EmpNo As Long, ByVal organNo As String) As String
    Dim strSQL As String
    Dim oRs4This As New ADODB.Recordset
    strSQL = "select NATIVE_PLACE,(cast(BIRTHDAY/10000 as varchar(4))+'-'+cast(BIRTHDAY%10000/100 as varchar(2))+'-'+cast(BIRTHDAY%100 as varchar(2))),ID_CODE from t_emp_basic where emp_no=" & EmpNo & " and organ_no='" & organNo & "'"
    If oRs4This.State = adStateOpen Then oRs4This.Close
    oRs4This.Open strSQL, g_oConnection4This
    If oRs4This.EOF = False Then GetToolTipText = CheckVariant(oRs4This.Fields(0).Value) & vbCr & CheckVariant(oRs4This.Fields(1).Value) & vbCr & CheckVariant(oRs4This.Fields(2).Value)
    oRs4This.Close
    Set oRs4This = Nothing
End Function

Public Function ExportExcel(Optional ByVal strSQL As String, Optional ByVal VSFlexGrid4Result As VSFlexGrid, Optional ByVal CurrentExcelName As String = "", Optional ByVal CurrentPath As String = "") As Boolean
    Dim ors4temp As New ADODB.Recordset
    ExportExcel = False
On Error GoTo HaveError
    Dim i As Long, j As Long
    Dim Array4Record()
    
    If CurrentPath <> "" Then
        If right(CurrentPath, 1) <> "\" Then CurrentPath = CurrentPath & "\"
    End If
    If g_bHaveExcel Then
        If g_oApp4Export.Windows.Count = 0 Then
            Set g_oApp4Export = CreateObject("excel.application")
        End If
        
        If CurrentExcelName = "" And g_oApp4Export.Workbooks.Count = 0 Then
            Set g_oBook4Export = g_oApp4Export.Workbooks.Add
        End If
        If CurrentExcelName <> "" Then
            If g_FSO.FileExists(App.Path & "\report\" & CurrentExcelName & ".xls") = True Then
                If g_FSO.FileExists(CurrentPath & CurrentExcelName & ".xls") = True Then
                    If vbYes = MsgBox("在" & CurrentPath & "下发现" & CurrentExcelName & ".xls,此操作将覆盖此文件，确认继续吗", vbYesNo + vbDefaultButton2, "警告") Then
                        Kill CurrentPath & CurrentExcelName & ".xls"
                    Else
                        Exit Function
                    End If
                End If
                FileCopy App.Path & "\report\" & CurrentExcelName & ".xls", CurrentPath & CurrentExcelName & ".xls"
            Else
                MsgBox "模版丢失", vbOKOnly, "警告"
                Exit Function
            End If
            Set g_oBook4Export = g_oApp4Export.Workbooks.Open(CurrentPath & CurrentExcelName & ".xls")
            Set g_oSheet4Export = g_oBook4Export.Worksheets("sheet1")
        Else
            Set g_oSheet4Export = g_oBook4Export.Worksheets.Add
        End If
    Else
        Set g_oApp4Export = CreateObject("Excel.Application")
        If CurrentExcelName <> "" Then
            If g_FSO.FileExists(App.Path & "\report\" & CurrentExcelName & ".xls") = True Then
                If g_FSO.FileExists(CurrentPath & CurrentExcelName & ".xls") = True Then
                    If vbYes = MsgBox("在" & CurrentPath & "下发现" & CurrentExcelName & ".xls,此操作将覆盖此文件，确认继续吗", vbYesNo + vbDefaultButton2, "警告") Then
                        Kill CurrentPath & CurrentExcelName & ".xls"
                    Else
                        Exit Function
                    End If
                End If
                FileCopy App.Path & "\report\" & CurrentExcelName & ".xls", CurrentPath & CurrentExcelName & ".xls"
            Else
                MsgBox "模版丢失", vbOKOnly, "警告"
                Exit Function
            End If
            Set g_oBook4Export = g_oApp4Export.Workbooks.Open(CurrentPath & CurrentExcelName & ".xls")
            Set g_oSheet4Export = g_oBook4Export.Worksheets("sheet1")
        Else
            Set g_oBook4Export = g_oApp4Export.Workbooks.Add
            Set g_oSheet4Export = g_oBook4Export.Worksheets.Add
        End If
    End If
    If CurrentExcelName = "" Then
        If strSQL = "" Then Exit Function
        If ors4temp.State = adStateOpen Then ors4temp.Close
        ors4temp.CursorLocation = adUseClient
        ors4temp.Open strSQL, g_oConnection4This, adOpenKeyset, adLockOptimistic
        
        For i = 1 To ors4temp.Fields.Count
            If VSFlexGrid4Result.ColHidden(i) = False Then g_oSheet4Export.Cells(1, i) = VSFlexGrid4Result.TextMatrix(0, i)
        Next
        
        If VSFlexGrid4Result.Rows < 2 Then MsgBox "没有信息可导入.", vbOKOnly, "提示": Exit Function
        ReDim Array4Record(VSFlexGrid4Result.Cols - 2, VSFlexGrid4Result.Rows - 2)
        
        For i = 1 To VSFlexGrid4Result.Rows - 1
            For j = 1 To VSFlexGrid4Result.Cols - 1
                If VSFlexGrid4Result.ColHidden(j) = False Then Array4Record(j - 1, i - 1) = VSFlexGrid4Result.Cell(flexcpTextDisplay, i, j)
            Next
        Next
        
        g_oSheet4Export.Cells(2, 1).Resize(ors4temp.RecordCount, ors4temp.Fields.Count).Value = TransposeDim(Array4Record)
        g_oApp4Export.Visible = True
        g_bHaveExcel = True
    
    End If
    ExportExcel = True
    Exit Function
HaveError:
    MsgBox "意外错误,请检查此文件是否处于打开状态或重新选择生成报表结果存储路径!", vbOKOnly, "警告"
    g_oBook4Export.Close 1
    g_oApp4Export.Visible = True
End Function

Public Function TransposeDim(v As Variant) As Variant
' Custom Function to Transpose a 0-based array (v)
    Dim X As Long, Y As Long, Xupper As Long, Yupper As Long
    Dim tempArray As Variant
    
    Xupper = UBound(v, 2)
    Yupper = UBound(v, 1)
    
    ReDim tempArray(Xupper, Yupper)
    For X = 0 To Xupper
        For Y = 0 To Yupper
            tempArray(X, Y) = v(Y, X)
        Next Y
    Next X
    
    TransposeDim = tempArray
End Function

Public Sub PrcessSSComboxExFormLoad(ByVal SSComboBoxEx4Factory As SSComboBoxEx, ByVal SSComboBoxEx4Company As SSComboBoxEx, ByVal SSComboBoxEx4Large As SSComboBoxEx, ByVal SSComboBoxEx4Small As SSComboBoxEx, ByVal str4Organ As String, ByVal strOrganLevel As String)
    If strOrganLevel = C_BUREAUE_LEVEL Then
        FillComboBox SSComboBoxEx4Factory, "T_ORGAN", "ORGAN_NO", "ORGAN_NAME", , " where Len(ORGAN_NO)=" & C_FACTORY_LENGTH & HaveOrganMark
    ElseIf strOrganLevel = C_FACTORY_LEVEL Then
        FillComboBox SSComboBoxEx4Factory, "T_ORGAN", "ORGAN_NO", "ORGAN_NAME", , " where ORGAN_NO like '" & str4Organ & "' " & HaveOrganMark
        SSComboBoxEx4Factory.ListIndex = 0
        SSComboBoxEx4Factory.Enabled = False
    ElseIf strOrganLevel = C_COMPANY_LEVEL Then
        FillComboBox SSComboBoxEx4Factory, "T_ORGAN", "ORGAN_NO", "ORGAN_NAME", , " where ORGAN_NO like '" & left(str4Organ, C_FACTORY_LENGTH) & "'" & HaveOrganMark
        SSComboBoxEx4Factory.ListIndex = 0
        SSComboBoxEx4Factory.Enabled = False
        FillComboBox SSComboBoxEx4Company, "T_ORGAN", "ORGAN_NO", "ORGAN_NAME", , " where ORGAN_NO like '" & str4Organ & "'" & HaveOrganMark
        SSComboBoxEx4Company.ListIndex = 0
        SSComboBoxEx4Company.Enabled = False
    ElseIf strOrganLevel = C_LARGE_LEVEL Then
        FillComboBox SSComboBoxEx4Factory, "T_ORGAN", "ORGAN_NO", "ORGAN_NAME", , " where ORGAN_NO like '" & left(str4Organ, C_FACTORY_LENGTH) & "'" & HaveOrganMark
        SSComboBoxEx4Factory.ListIndex = 0
        If Len(str4Organ) = C_LARGE_LENGTH Then
            FillComboBox SSComboBoxEx4Company, "T_ORGAN", "ORGAN_NO", "ORGAN_NAME", , " where ORGAN_NO like '" & left(str4Organ, C_COMPANY_LENGTH) & "'" & HaveOrganMark
            SSComboBoxEx4Company.ListIndex = 0
        End If
        FillComboBox SSComboBoxEx4Large, "T_ORGAN", "ORGAN_NO", "ORGAN_NAME", , " where ORGAN_NO like '" & str4Organ & "'" & HaveOrganMark
        SSComboBoxEx4Large.ListIndex = 0
        SSComboBoxEx4Factory.Enabled = False
        SSComboBoxEx4Company.Enabled = False
        SSComboBoxEx4Large.Enabled = False
    Else
        FillComboBox SSComboBoxEx4Factory, "T_ORGAN", "ORGAN_NO", "ORGAN_NAME", , " where ORGAN_NO like '" & left(str4Organ, C_FACTORY_LENGTH) & "'" & HaveOrganMark
        SSComboBoxEx4Factory.ListIndex = 0
        If Len(str4Organ) = C_LARGE_LENGTH Then
            FillComboBox SSComboBoxEx4Company, "T_ORGAN", "ORGAN_NO", "ORGAN_NAME", , " where ORGAN_NO like '" & left(str4Organ, C_COMPANY_LENGTH) & "' and organ_level=" & C_COMPANY_LEVEL & HaveOrganMark
            SSComboBoxEx4Company.ListIndex = 0
            FillComboBox SSComboBoxEx4Large, "T_ORGAN", "ORGAN_NO", "ORGAN_NAME", , " where ORGAN_NO like '" & left(str4Organ, C_COMPANY_LENGTH) & "' and organ_level=" & C_LARGE_LEVEL & HaveOrganMark
            SSComboBoxEx4Large.ListIndex = 0
        ElseIf Len(str4Organ) = C_SMALL_LENGTH Then
            FillComboBox SSComboBoxEx4Company, "T_ORGAN", "ORGAN_NO", "ORGAN_NAME", , " where ORGAN_NO like '" & left(str4Organ, C_COMPANY_LENGTH) & "'" & HaveOrganMark
            SSComboBoxEx4Company.ListIndex = 0
            FillComboBox SSComboBoxEx4Large, "T_ORGAN", "ORGAN_NO", "ORGAN_NAME", , " where ORGAN_NO like '" & left(str4Organ, C_LARGE_LENGTH) & "'" & HaveOrganMark
            SSComboBoxEx4Large.ListIndex = 0
        End If
        FillComboBox SSComboBoxEx4Small, "T_ORGAN", "ORGAN_NO", "ORGAN_NAME", , " where ORGAN_NO like '" & str4Organ & "' " & HaveOrganMark
        SSComboBoxEx4Small.ListIndex = 0
        SSComboBoxEx4Factory.Enabled = False
        SSComboBoxEx4Company.Enabled = False
        SSComboBoxEx4Large.Enabled = False
        SSComboBoxEx4Small.Enabled = False
    End If
End Sub

Public Function GetOrganLevel(ByVal LoginUnit As String) As String
    Dim strSQL As String
    Dim oRs4This As New ADODB.Recordset
    strSQL = "select ORGAN_LEVEL from t_organ where ORGAN_NO='" & LoginUnit & "'"
    If oRs4This.State = adStateOpen Then oRs4This.Close
    oRs4This.Open strSQL, g_oConnection4This, adOpenKeyset, adLockOptimistic
    GetOrganLevel = oRs4This.Fields("ORGAN_LEVEL").Value
End Function

Public Function GetRecordEmpInfo(ByVal organNo As String, ByVal EmpNo As Long, ByVal InsertOrgan As String, Optional ByVal bIsEmpRemove As Boolean = False) As Boolean
    Dim strSQL As String
    Dim l4EmpNo As String
    Dim strTableName() As String
    Dim lfor As Long
    l4EmpNo = GetMaxNo("t_emp_basic", "emp_no", " and organ_no='" & InsertOrgan & "'", bIsEmpRemove)
    strSQL = "insert into t_emp_basic (emp_no,organ_no,useworke_type_no,emp_sort_no,seniority_name_no,technical_aptitude_no,OPRROLE_NO,area_no,nation_no, " _
            & "health_no,foreign_language_no,master_degree_no,past_education_level,past_degree,now_education_level,now_degree,SENIORITY_SPECIALTY_NO,politics_no," _
            & "worker_sort_no,emp_type_no,SPECIALTY_SORT_NO,worker_source_no,brigade_type_no,id_code,emp_name,sex,native_place," _
            & "birthday,born_place,PAST_GRADUCATED_TIME,now_GRADUCATED_TIME,GRADUATE_School,GRADUATE_SPECIALTY,OBTAIN_SENIORITY_TIME,join_time,enroll_time,work_time," _
            & "in_units_time,file_code,in_oilfield_time,on_station_time,from_unit,delete_mark,station_name) " _
            & " select  " & l4EmpNo & " as emp_no,'" & InsertOrgan & "' as  new_factory_organ " _
            & ",useworke_type_no,emp_sort_no,seniority_name_no,technical_aptitude_no,OPRROLE_NO,area_no,nation_no, " _
            & "health_no,foreign_language_no,master_degree_no,past_education_level,past_degree,now_education_level,now_degree,SENIORITY_SPECIALTY_NO,politics_no," _
            & "worker_sort_no,emp_type_no,SPECIALTY_SORT_NO,worker_source_no,brigade_type_no,id_code,emp_name,sex,native_place," _
            & "birthday,born_place,PAST_GRADUCATED_TIME,now_GRADUCATED_TIME,GRADUATE_School,GRADUATE_SPECIALTY,OBTAIN_SENIORITY_TIME,join_time,enroll_time,work_time," _
            & "in_units_time,file_code,in_oilfield_time,on_station_time,from_unit,"
    If bIsEmpRemove = False Then
        strSQL = strSQL & C_Emp_Have
    Else
        strSQL = strSQL & C_Emp_Delete_Have_Used_Remove
    End If
    strSQL = strSQL & " as delete_mark,station_name from t_emp_basic where emp_no=" & EmpNo & " and organ_no='" & organNo & "'"
    If ExcuteSQL(strSQL) <> 0 Then Exit Function
    '记录教育简历,记录社会关系,记录培训信息,记录工作简历,记录行政奖励,记录出国信息,记录论文、论著信息,记录干部年度考核信息
    '记录考试信息,记录后备干部,记录科研成果,记录行政奖罚,记录学术带头人,记录干部信息,记录工人工种,记录合同,工资,工资演变
    strSQL = "delete from t_systemlog where emp_no=" & EmpNo & " and organ_no='" & organNo & "'"
    If ExcuteSQL(strSQL) <> 0 Then Exit Function
    If bIsEmpRemove = False Then
        strTableName = Split("t_education_vita,T_SOCIETY_RELATION,T_TRAIN,T_work_vita,T_reward,T_abroad,T_article,T_CADRE_CHECK_YEAR,T_EXAMINATION,T_PREPARE_CADRE,T_SCIENTIFIC_SEARCH,T_PUNISH,T_TECHNICAL_LEAD,T_CADRE,T_WORKER_SORT_MESSAGE,T_COMPACT,T_WAGE_STANDARD,T_OLD_WAGE_EVOLVEMENT,T_EMP_REMOVE", ",")
        For lfor = 0 To UBound(strTableName)
            If strTableName(lfor) <> "T_COMPACT" Then
                strSQL = "update " & strTableName(lfor) & " set emp_no=" & l4EmpNo & ",organ_no='" & InsertOrgan & "' from " & strTableName(lfor) & " where emp_no=" & EmpNo & " and organ_no='" & organNo & "'"
            Else
                strSQL = "update " & strTableName(lfor) & " set SIGN_EMP=" & l4EmpNo & ",work_station='" & InsertOrgan & "',COMPACT_UNDERWRITE_ORGAN='" & InsertOrgan & "' from " & strTableName(lfor) & " where SIGN_EMP=" & EmpNo & " and COMPACT_UNDERWRITE_ORGAN='" & organNo & "'"
            End If
            If ExcuteSQL(strSQL) <> 0 Then Exit Function
        Next
        strSQL = "delete from t_emp_basic where emp_no=" & EmpNo & " and organ_no='" & organNo & "'"
        If ExcuteSQL(strSQL) <> 0 Then Exit Function
    Else
        strTableName = Split("t_education_vita,T_SOCIETY_RELATION,T_TRAIN,T_work_vita,T_reward,T_abroad,T_article,T_CADRE_CHECK_YEAR,T_EXAMINATION,T_PREPARE_CADRE,T_SCIENTIFIC_SEARCH,T_PUNISH,T_TECHNICAL_LEAD,T_CADRE,T_WORKER_SORT_MESSAGE,T_COMPACT,T_WAGE_STANDARD,T_OLD_WAGE_EVOLVEMENT", ",")
        For lfor = 0 To UBound(strTableName)
            If strTableName(lfor) <> "T_COMPACT" Then
                strSQL = "update " & strTableName(lfor) & " set emp_no=" & l4EmpNo & ",organ_no='" & InsertOrgan & "' from " & strTableName(lfor) & " where emp_no=" & EmpNo & " and organ_no='" & organNo & "'"
            Else
                strSQL = "update " & strTableName(lfor) & " set SIGN_EMP=" & l4EmpNo & ",work_station='" & InsertOrgan & "',COMPACT_UNDERWRITE_ORGAN='" & InsertOrgan & "' from " & strTableName(lfor) & " where SIGN_EMP=" & EmpNo & " and COMPACT_UNDERWRITE_ORGAN='" & organNo & "'"
            End If
            If ExcuteSQL(strSQL) <> 0 Then Exit Function
        Next
    End If
    GetRecordEmpInfo = True
End Function

Public Function HaveOrganMark() As String
    HaveOrganMark = " and ORGAN_DELETE_MARK =" & C_Organ_Have & " "
End Function

Public Function HaveEmpMark() As String
    HaveEmpMark = " and DELETE_MARK =" & C_Emp_Have & " "
End Function