-

VB开发的ERP系统

            End If
            
            
            .MoveNext
        Loop
        sSql = "SELECT " & Mid(sSql, 2, Len(sSql) - 1) & " FROM Rs_ExtendInfo E,Rs_BasicInfo B"
    End With
    Item_Info = sSql

End Function

Public Function CFieldValueCopy(Source As CFieldValue, aim As CFieldValue)
    With Source
        aim.FieldIsShow = .FieldIsShow
        aim.FieldLengthFra = .FieldLengthFra
        aim.FieldLengthInt = .FieldLengthInt
        aim.FieldName = .FieldName
        aim.FieldNameC = .FieldNameC
        aim.FieldType = .FieldType
        aim.FieldValueName = .FieldValueName
        aim.FieldWidth = .FieldWidth
    End With
End Function


'******************************************************************
'*    模 块 名 称 :私有模块
'*    功 能 描 述 :
'*    程序员姓名  :苗鹏
'*    最后修改人  :苗鹏
'*    最后修改时间:2002/01/10
'*    备        注:
'******************************************************************

Public Function GetTableField(sExec As String, sTableName As String, sFieldName As String, s As String) As Integer '分离表名和字段名,s为分隔符
    On Error GoTo ErrCtrl
    
    Dim i As Integer
    
    For i = 1 To Len(sExec)
        If Mid(sExec, i, 1) = s Then
            sTableName = Left(sExec, i - 1)
            sFieldName = Right(sExec, Len(sExec) - i)
            Exit For
        End If
    Next i
    If i <= Len(sExec) Then
        GetTableField = 1
    Else
        GetTableField = 0
    End If
    Exit Function

ErrCtrl:
    GetTableField = -1
End Function

Public Function InitView(tv As TreeView, Optional sSql As String = " 1=1 ")    '初始化字段树
    On Error GoTo ErrCtrl
    
    Dim rs As New ADODB.Recordset
    Dim s As String
    Dim nodX As Node
    
    If sSql = "" Then
        sSql = " 1=1  "
    End If
    tv.Nodes.Clear
    tv.Enabled = False
    Set nodX = tv.Nodes.Add(, , "R", "备选项目")
    '读取表
    s = "SELECT DISTINCT TableName AS TableFrom FROM Rs_Items WHERE SID<10 AND " & sSql
    Set rs = Cw_DataEnvi.DataConnect.Execute(s)
    With rs
        If .EOF() Then
            Exit Function
        End If
        Do While Not .EOF()
            Set nodX = tv.Nodes.Add("R", tvwChild, UCase(Trim(!TableFrom)), GetTableNameC(Trim(!TableFrom)))
            nodX.EnsureVisible
            .MoveNext
        Loop
        .Close
    End With
    
    '读取字段
    s = "SELECT FieldName  AS FieldName,CHName AS FieldNameC,TableName AS TableFrom " & Chr(10) _
        & ",Correlation AS FieldRelation,CorTable AS CorTable ,IndexCode AS TCode,IndexName AS TName,AddMinusItem " & Chr(10) _
        & " FROM Rs_Items WHERE SID<10 AND " & sSql  'TableName is not Null "
    Set rs = Cw_DataEnvi.DataConnect.Execute(s)
    With rs
        If .EOF() Then
            Exit Function
        End If
        Do While Not .EOF()
            '末级节点的Tag值为此字段的英文全名
            If !AddMinusItem = 1 And Trim(sSql) = Trim("1=1") Then
                '如果是选入工资表的字段，添加工资表节点
                Set nodX = tv.Nodes.Add(UCase("PM_PayRoll"), tvwChild, UCase("PM_PayRoll") & "." & UCase(Trim(!FieldName)), UCase(Trim(!FieldNameC)))
                If Trim(!CorTable & "") <> "" And Trim(!TCode & "") <> "" And Trim(!TName & "") <> "" Then
                    nodX.Tag = Trim(!FieldRelation & "") & "@" & Trim(!CorTable & "") & "@" & Trim(!TCode & "") & "@" & Trim(!TName & "")
                End If
                
            End If
            Set nodX = tv.Nodes.Add(UCase(Trim(!TableFrom)), tvwChild, UCase(Trim(!TableFrom) & "." & Trim(!FieldName)), UCase(Trim(!FieldNameC)))
            If Trim(!CorTable & "") <> "" And Trim(!TCode & "") <> "" And Trim(!TName & "") <> "" Then
                nodX.Tag = Trim(!FieldRelation & "") & "@" & Trim(!CorTable & "") & "@" & Trim(!TCode & "") & "@" & Trim(!TName & "")
            End If
            .MoveNext
        Loop
        .Close
    End With
    
    '添加会计年，会计期间，工资类别到工资表节点
    If IsNodeExist("PM_PayRoll", tv) Then
        Set nodX = tv.Nodes.Add(UCase("PM_PayRoll"), tvwChild, UCase("PM_PayRoll.KjYear"), "会计年")
        Set nodX = tv.Nodes.Add(UCase("PM_PayRoll"), tvwChild, UCase("PM_PayRoll.Period"), "会计月")
        Set nodX = tv.Nodes.Add(UCase("PM_PayRoll"), tvwChild, UCase("PM_PayRoll.SortID"), "工资类别")
        nodX.Tag = "0@PM_Sort@SortID@SortName"
    End If
    
    '添加会计年，会计期间到考勤表节点
    If IsNodeExist("PM_AttendRecord", tv) Then
        Set nodX = tv.Nodes.Add(UCase("PM_AttendRecord"), tvwChild, UCase("PM_AttendRecord.KjYear"), "会计年")
        Set nodX = tv.Nodes.Add(UCase("PM_AttendRecord"), tvwChild, UCase("PM_AttendRecord.Period"), "会计月")
    End If
      
    Set rs = Nothing
    tv.Enabled = True
    Exit Function

ErrCtrl:
    If rs.State = 1 Then
        rs.Close
    End If
    Set rs = Nothing
    tv.Enabled = True
    Dim smsg As String
    Dim smsgSys As String
    smsg = GetError(Err.Number)
    smsgSys = Err.Number & Err.Description & "!"
    MsgBox IIf(smsg = "", smsgSys, smsg), vbOKOnly + vbCritical
End Function

Public Function GetFieldHelp(sExp As String, sID As String, sTable As String, sCode As String, sName As String) '读取字段帮助信息
    
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim s(3) As String
    
    If sExp = "" Then
        Exit Function
    End If
    j = 1
    k = 0
    '取ID,关联表,编码,名称
    Do While i <= Len(sExp)
        For i = j To Len(sExp)
            If Mid(sExp, i, 1) = "@" Then
                s(k) = Mid(sExp, j, i - j)
                j = i + 1
                k = k + 1
                Exit For
            End If
        Next i
        If i > Len(sExp) Then
            sName = Mid(sExp, j, i - j)
        End If
    Loop
    sID = s(0)
    sTable = s(1)
    sCode = s(2)
        
End Function

Public Function GetError(iNum As Long) As String '返回错误描述
    Dim msg As String
    Select Case iNum
        Case -2147217873
            msg = "违反唯一性或者编码已经使用!"
        Case -2147217913
            msg = "录入了错误的日期格式,正确格式为 2001-09-12" & Chr(10) _
                & "或者录入了错误的数字格式,正确格式为 123456789.12"
        Case -2147217900
            msg = "语法错误!"
        Case Else
            msg = ""
    End Select
    GetError = msg
End Function

Public Function ReplByPos(sExepress As String, sReplace As String, Optional iStart As Integer = 0, Optional iEnd As Integer = 0) As String '把sExepress的第iStart字起到iEnd结束的字符替换成sReplace
  
  Dim i As Integer
  Dim j As Integer
  Dim sLeft As String
  Dim sRight As String
  
  If iStart > Len(sExepress) Then
    MsgBox "开始位置超出字符长度", vbOKOnly + vbCritical
    Exit Function
  End If
  If iStart > iEnd Then
    MsgBox "开始位置超出结束位置", vbOKOnly + vbCritical
    Exit Function
  End If
  
  sLeft = Left(sExepress, iStart - 1)
  sRight = Right(sExepress, Len(sExepress) - iEnd + 1)
  
  ReplByPos = sLeft & sReplace & sRight
  
End Function
Public Function IsItemExist(sName As String, coll As Collection, Optional iType As Integer = 0) As Integer 'coll中是否包涵sName的项目
    'itype=0 不区分大小写 1 区分大小写
    '返回sName的位置或-1
    Dim i As Integer
    With coll
        If .count = 0 Then
            IsItemExist = -1
            Exit Function
        End If
        If iType = 0 Then
            For i = 1 To .count
                If UCase(sName) = UCase(.Item(i)) Then
                    Exit For
                End If
            Next i
        Else
            For i = 1 To .count
                If sName = .Item(i) Then
                    Exit For
                End If
            Next i
        End If
        If i > .count Then
            IsItemExist = -1
        Else
            IsItemExist = i
        End If
    End With
End Function

Public Function GetSQLFrom(coll As Collection, sPriTableName As String) As String '根据所提供的表名,连接成From语句
    On Error GoTo ErrCtrl
    
    Dim s As String
    Dim st As String
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    
    If sPriTableName = "" Then
        MsgBox "请输入主表名!", vbOKOnly + vbInformation
        Exit Function
    End If
    
    s = ""
    With coll
        If .count = 0 Then
            s = " " & sPriTableName & Chr(10) & " "
            GetSQLFrom = s
            Exit Function
        End If
        '判断主表,因为每个表的连接字段不同,所以要分开处理
        Select Case UCase(sPriTableName)
            Case UCase("PM_PayRoll")    '工资表
                s = " PM_PayRoll left outer join  PM_AttendRecord  " & Chr(10) _
                    & " on  PM_PayRoll.EmpID=PM_AttendRecord.EmpID AND PM_PayRoll.Period=PM_AttendRecord.Period AND PM_PayRoll.KjYear=PM_AttendRecord.KjYear " & Chr(10) _
                    & " Left Outer Join PM_TaxData " & Chr(10) _
                    & " on PM_PayRoll.EmpID=PM_TaxData.EmpID AND PM_PayRoll.Period=PM_TaxData.Period AND PM_PayRoll.KjYear=PM_TaxData.KjYear AND PM_PayRoll.SortID=PM_TaxData.SortID " & Chr(10)
            Case UCase("PM_AttendRecord")   '考勤表
                i = IsItemExist("PM_PayRoll", coll)
                If i <> -1 Then
                    s = " PM_AttendRecord left outer join  PM_PayRoll  " & Chr(10) _
                        & " on  PM_PayRoll.EmpID=PM_AttendRecord.EmpID AND PM_PayRoll.Period=PM_AttendRecord.Period AND PM_PayRoll.KjYear=PM_AttendRecord.KjYear " & Chr(10) _
                        & " Left Outer Join PM_TaxData " & Chr(10) _
                        & " on PM_AttendRecord.EmpID=PM_TaxData.EmpID AND PM_AttendRecord.Period=PM_TaxData.Period AND PM_AttendRecord.KjYear=PM_TaxData.KjYear  " & Chr(10)
                Else
                    s = " PM_AttendRecord  " & Chr(10)
                End If
            Case UCase("PM_TaxData")    '所得税表
                i = IsItemExist("PM_PayRoll", coll)
                If i <> -1 Then
                    s = " PM_TaxData left outer join  PM_AttendRecord  " & Chr(10) _
                        & " on  PM_TaxData.EmpID=PM_AttendRecord.EmpID AND PM_TaxData.Period=PM_AttendRecord.Period AND PM_TaxData.KjYear=PM_AttendRecord.KjYear " & Chr(10) _
                        & " Left Outer Join PM_PayRoll " & Chr(10) _
                        & " on PM_PayRoll.EmpID=PM_TaxData.EmpID AND PM_PayRoll.Period=PM_TaxData.Period AND PM_PayRoll.KjYear=PM_TaxData.KjYear AND PM_PayRoll.SortID=PM_TaxData.SortID " & Chr(10)
                Else
                    s = "PM_TaxData"
                End If
            Case Else
                s = sPriTableName
        End Select
                
        '连接剩下的表
        For k = 1 To .count
            If UCase(sPriTableName) <> UCase(.Item(k)) And _
                Trim(UCase(.Item(k))) <> "" And _
                Trim(UCase(.Item(k))) <> UCase("PM_PayRoll") And _
                Trim(UCase(.Item(k))) <> UCase("PM_AttendRecord") And _
                Trim(UCase(.Item(k))) <> UCase("PM_TaxData") Then
                s = s & " left outer join " & Trim(.Item(k)) & " on " & Trim(.Item(k)) & ".EmpID=" & sPriTableName & ".EmpID " & Chr(10)