系统私有模块.bas

新世纪ERP系统管理源代码

Attribute VB_Name = "XtsyModule"
'系统私有模块用来放置一些子系统独有的过程与函数
'Public connParaSet As Connection  '指定数据库的连接对象

'列表框项目设置变量
Public str_ComboCode As String    '列表框编码
Public str_ComboName As String    '列表框名称
Public str_SysCode As String      '系统模块编码
'编码定位用
Public str_Code As String         '编码名称


Public FormStr As String          '图形中判断界面

Public Sub Drxtztcs()                                   '读入系统帐套参数
    Dim Ztcsbrec As New ADODB.Recordset
    Dim RecTemp As New ADODB.Recordset
    Dim SqlStr As String
    
    With Ztcsbrec
        '金额总位数
        .Open "Select * From Gy_AccInformation Where SystemCode='cwzz'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        If .EOF Then Exit Sub
        
        .MoveFirst
        .Find "itemcode='cwjezws'"
        If Not Ztcsbrec.EOF Then
            Xtjezws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        '数量总位数
        .MoveFirst
        .Find "itemcode='cwslzws'"
        If Not Ztcsbrec.EOF Then
            Xtslzws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        '单价总位数
        .MoveFirst
        .Find "itemcode='cwdjzws'"
        If Not Ztcsbrec.EOF Then
            Xtdjzws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        '金额小数位数
        .MoveFirst
        .Find "itemcode='cwjexsws'"
        If Not Ztcsbrec.EOF Then
            Xtjexsws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        '数量小数位数
        .MoveFirst
        .Find "itemcode='cwslxsws'"
        If Not Ztcsbrec.EOF Then
            Xtslxsws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        '单价小数位数
        .MoveFirst
        .Find "itemcode='cwdjxsws'"
        If Not Ztcsbrec.EOF Then
            Xtdjxsws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        .Close
    End With
End Sub

'---------------------------------------
'编写人员：奚俊峰
'函数功能：网格记录定位
'输入参数：obj_Grid    网格对象
'          int_Column  要搜索的列号
'  返回值：
'---------------------------------------
Public Function Fun_GridLocate(obj_Grid As Object, int_Column As Integer)
    Dim int_Count As Integer
    
    If obj_Grid.Row < obj_Grid.FixedRows Then Exit Function
    str_Code = ""
    CSH_FrmGridSearch.Show 1
    If str_Code = "" Then Exit Function
    
    With obj_Grid
        For int_Count = .FixedRows To .Rows - 1
            If UCase(Mid(.TextMatrix(int_Count, int_Column), 1, Len(str_Code))) = UCase(str_Code) Then
                .Select int_Count, int_Column
                .TopRow = int_Count
                Exit For
            End If
        Next int_Count
    End With
End Function

'---------------------------------------
'编写人员：奚俊峰
'函数功能：取出操作人员的子系统使用权限并填充列表框
'输入参数：obj_Combo     列表框对象
'          str_UserCode  操作人员编号
'  返回值：
'---------------------------------------
Public Function Fun_FillUserSystem(obj_Combo As Object, str_UserCode As String)
    Dim str_Sql As String
    Dim tRs As Recordset
    Dim str_Auth As String
    
    On Error GoTo ErrHandle
    
    '取出该用户的子系统使用权限
 '   str_Sql = "select isnull(AuthorityID,'') from Gy_Czygl where czybm='" & str_UserCode & "'"
 '   Set tRs = Cw_DataEnvi.DataConnect.Execute(str_Sql)
 '   str_Auth = Left(Trim(tRs(0)), 200)
    
    '取出该帐套的子系统ID
   str_Sql = "select * from gy_syscode order by sysnumb"
    Set tRs = Cw_DataEnvi.DataConnect.Execute(str_Sql)
    
    obj_Combo.ComboItems.Clear
    
    Do While Not tRs.EOF
     '   If Mid(str_Auth, tRs("ID"), 1) = "1" Then
            obj_Combo.ComboItems.Add , "@" + Trim(tRs.Fields("syscode")), Trim(tRs.Fields("sysnumb")) & " " & Trim(tRs.Fields("sysname"))
     '   End If
        
        tRs.MoveNext
    Loop
    obj_Combo.Locked = True
ErrHandle:
    
End Function

'---------------------------------------
'编写人员：奚俊峰
'函数功能：
'输入参数：str_Function     功能编码
'          str_UserCode     操作人员编号
'  返回值：Boolean
'                 True   :  有权限
'                 False  :  无权限
'---------------------------------------
Public Function IsPermission(str_Function As String, str_UserCode As String) As Boolean
    Dim aDo_userGroup As New Recordset  '存取功能索引ID
    Dim aDo_gnbm As New Recordset       '存取用户权限
    Dim str_Auth As String
    
    On Error GoTo ErrHandle
    
    Set aDo_gnbm = Cw_DataEnvi.DataConnect.Execute("select * from Xt_xtgnb where gnsy='" & Trim(str_Function) & "'")
    Set aDo_userGroup = Cw_DataEnvi.DataConnect.Execute("select * from Gy_Czygl where czybm='" & Trim(str_UserCode) & "'")
    str_Auth = Mid(Trim(aDo_userGroup("AuthorityID") & ""), 201)
    
    If Mid(str_Auth, aDo_gnbm!Id, 1) = "1" Then
        IsPermission = True
    Else
        IsPermission = False
    End If
    Set aDo_gnbm = Nothing
    Set aDo_userGroup = Nothing
    
ErrHandle:
    
End Function

'---------------------------------------
'编写人员：奚俊峰
'函数功能：校验输入的编码是否符合规范
'输入参数：str_SystemCode     功能编码
'          str_Code           操作人员编号
'  返回值：String
'                 =""   :  校验正确
'                 <>""  :  返回错误信息
'---------------------------------------

Public Function ConfirmCode(str_SystemCode As String, str_Code As String) As String
    Dim str_tInfo As String
    
    str_SystemCode = Trim(str_SystemCode)
    str_Code = Trim(str_Code)
    
    '长度不对提示
    If Len(str_Code) <= Len(str_SystemCode) + 1 Then
        ConfirmCode = "编码输入错误,应该为：" & vbCrLf & vbCrLf & str_SystemCode & "_名称"
        Exit Function
    End If
    
    '前缀不对提示
    If UCase(Left(str_Code, Len(str_SystemCode) + 1)) <> UCase(str_SystemCode & "_") Then
        ConfirmCode = "编码输入错误,应该为：" & vbCrLf & vbCrLf & str_SystemCode & "_名称"
        Exit Function
    End If
    
    ConfirmCode = ""
End Function