modinsertdata.bas

一套简易的MIS系统。带SQLServer数据库。供参考。

        .Left = frmInfo.Width / 2 - .Width / 2 - uInfo.iLeft
    End With
    
End Function

'9、验证数据重复
Public Function tWhileCode(strTab As String, strFields As String, strInfo As String) As Boolean
        
    Dim rsTemp                 As New ADODB.Recordset
    Set rsTemp = DBCN.Execute("Select " & strFields & " From " & strTab & " Where " & strFields & "='" & strInfo & "'")
    If rsTemp.EOF = False Then
        Select Case rsTemp.RecordCount
            Case Is > 1
                tWhileCode = False
            Case Is = 1
                tWhileCode = False
            Case Is = 0
                tWhileCode = True
        End Select
    Else
        tWhileCode = True
    End If

End Function

'10、获取最大编码
Public Function tBigCode(strTab As String, strFields As String) As String

    Dim rsTemp                 As New ADODB.Recordset
    Set rsTemp = DBCN.Execute("Select max(" & strFields & ") as Code from " & strTab & "")
    If rsTemp.EOF = False Then
        If Trim(rsTemp.Fields(0)) = "" Or IsNull(rsTemp.Fields(0)) = True Then
            tBigCode = Format(1, "0000")
        Else
            tBigCode = Format(Val(rsTemp.Fields(0)) + 1, "0000")
        End If
    Else
        tBigCode = Format(1, "0000")
    End If

End Function

'11、获取服务器日期
Public Function tServerDate() As String
    
    Dim rsTemp                     As New ADODB.Recordset
    Set rsTemp = DBCN.Execute("Select GetDate() as iDate")
    If rsTemp.EOF = False Then
        tServerDate = Format(rsTemp.Fields("iDate"), "YYYY-MM-DD")
    Else
        tServerDate = Format(Date, "YYYY-MM-DD")
    End If
    
End Function

'12、截取字符串
Public Function tString(strInfo As String, strFlag1 As String, strFlag2 As String, iLong As Integer) As String
    
    Select Case iLong
        Case 0
            tString = Mid(strInfo, InStr(strInfo, strFlag1) + 1, InStr(strInfo, strFlag2) - InStr(strInfo, strFlag1) - 1)
        Case 1
            tString = Left(strInfo, InStr(strInfo, strFlag1) - 1)
    End Select
    
    
End Function

'13、客户号码产生8位编码
Public Function tKHBigCode(strTab As String, strFields As String) As String

    Dim rsTemp                 As New ADODB.Recordset
    Set rsTemp = DBCN.Execute("Select max(" & strFields & ") as Code from " & strTab & "")
    If rsTemp.EOF = False Then
        If Trim(rsTemp.Fields(0)) = "" Or IsNull(rsTemp.Fields(0)) = True Then
            tKHBigCode = Format(1, "00000000")
        Else
            tKHBigCode = Format(Val(rsTemp.Fields(0)) + 1, "00000000")
        End If
    Else
        tKHBigCode = Format(1, "00000000")
    End If

End Function

'14、写入操作员信息:添加和修改时均为可用
Public Function tOperator(uInfo As tShareInfo, iUP_ADD As Integer) As Boolean
    
    Dim iAff                 As Integer
    
    tOperator = False
    On Error GoTo ErrInfo
    DBCN.BeginTrans
    Select Case iUP_ADD
        Case 0
            DBCN.Execute "Insert Into tbCcOper(Oper_id,Oper_name,Oper_pwd,MainLimit,TwoLimit,Instate) " _
                        & " Select '" & uInfo.strCode & "','" & uInfo.strName & "','8888','00000000000000'," _
                        & " '00000000000000000000000000000000000',0", iAff
            If iAff <> 1 Then
                DBCN.RollbackTrans
                tOperator = False
                MsgBox "数据添加失败！", vbInformation, "提示："
                Exit Function
            End If
        Case 1
            DBCN.Execute "Update tbCcOper Set Oper_name='" & uInfo.strName & "' Where Oper_ID='" & uInfo.strCode & "'", iAff
            If iAff <> 1 Then
                DBCN.RollbackTrans
                tOperator = False
                MsgBox "数据修改失败！", vbInformation, "提示："
                Exit Function
            End If
    End Select
    DBCN.CommitTrans
    tOperator = True
    Exit Function
ErrInfo:
    tOperator = False
    DBCN.RollbackTrans
    MsgBox Err.Description, vbInformation, "提示："
    
End Function

'15、写入系统设置信息
Public Function tSystem(uInfo As tShareInfo, iUP_ADD As Integer) As Boolean
    
    Dim iAff                  As Integer
    
    tSystem = False
    On Error GoTo ErrInfo
    
    DBCN.BeginTrans
    Select Case iUP_ADD
        Case 0
            DBCN.Execute "Insert Into tbSysset(Sys_para,Sys_value,Sys_Remark) Select '" & uInfo.strName & "', " _
                        & " '" & uInfo.strShare & "','" & uInfo.strType & "'", iAff
            If iAff <> 1 Then
                DBCN.RollbackTrans
                tSystem = False
                MsgBox "数据添加失败！", vbInformation, "提示："
                Exit Function
            End If
        Case 1
            DBCN.Execute "Update tbSysset Set Sys_para='" & uInfo.strName & "',Sys_value='" & uInfo.strShare & "',Sys_Remark='" & uInfo.strType & "' " _
                            & " Where Sys_ID='" & uInfo.strCode & "'", iAff
            If iAff <> 1 Then
                DBCN.RollbackTrans
                tSystem = False
                MsgBox "数据修改失败！", vbInformation, "提示："
                Exit Function
            End If
    End Select
    DBCN.CommitTrans
    tSystem = True
    Exit Function
ErrInfo:
    tSystem = False
End Function

'16、将权限表重新生成
Public Function tLimitTab(iCount As Integer)
    
    Dim strSQL                   As String
    Dim iIndex                   As Integer
    Dim rsTemp                   As New ADODB.Recordset
    Dim rsTab                    As New ADODB.Recordset
    Set rsTab = DBCN.Execute("Select * from sysObjects Where Name Like 'tbCcRight%'")
    If rsTab.EOF = False Then
        Set rsTemp = DBCN.Execute("Select * from tbCcRight ")
            If rsTemp.Fields.Count - 1 = iCount + 1 Then
                Exit Function
            End If
    End If
    DBCN.Execute "if Exists(Select * from sysObjects Where Name='tbCcRight') Drop table tbCcRight "
    strSQL = ""
    For iIndex = 0 To iCount
        strSQL = strSQL & " ,Mode_" & iIndex & " Int"
    Next
    DBCN.Execute "Create table tbCcRight(Oper_ID Varchar(10)" & strSQL & " , " _
                & " CONSTRAINT [PK_tbCcRight] PRIMARY KEY  CLUSTERED     (" _
                & " [Oper_id] )  ON [PRIMARY] )"
    
End Function

'17、添加操作员权限
Public Function tOprLimited(strOpr As String, iLimited() As Integer, iCount As Integer) As Boolean
    
    Dim iIndex                 As Integer
    Dim strSQL                 As String
    Dim iAff                   As Integer
    Dim rsTemp                 As New ADODB.Recordset
    strSQL = ""
    tOprLimited = False
    On Error GoTo ErrInfo
    Set rsTemp = DBCN.Execute("Select * from tbCcRight Where Oper_ID='" & strOpr & "' Order By Oper_ID")
    If rsTemp.EOF = False Then
        If IsNull(rsTemp.Fields(0)) = False Then
            For iIndex = 0 To iCount
                strSQL = strSQL & " Mode_" & iIndex & "=" & iLimited(iIndex) & " , "
            Next
            DBCN.BeginTrans
            DBCN.Execute " Update tbCcRight set " & Left(strSQL, Len(strSQL) - 2) & " Where Oper_ID='" & strOpr & "'", iAff
            If iAff <> 1 Then
                DBCN.RollbackTrans
                tOprLimited = False
                MsgBox "权限处理失败！！", vbInformation, "提示："
                Exit Function
            End If
            DBCN.CommitTrans
            tOprLimited = True
        Else
            For iIndex = 0 To iCount
                strSQL = strSQL & " ," & iLimited(iIndex) & " "
            Next
            DBCN.BeginTrans
            DBCN.Execute " Insert Int tbCcRight values('" & strOpr & "'," & strSQL & " )", iAff
            If iAff <> 1 Then
                DBCN.RollbackTrans
                tOprLimited = False
                MsgBox "权限处理失败！！", vbInformation, "提示："
                Exit Function
            End If
            DBCN.CommitTrans
            tOprLimited = True
        End If
    Else
            For iIndex = 0 To iCount
                strSQL = strSQL & " ," & iLimited(iIndex) & " "
            Next
            DBCN.BeginTrans
            DBCN.Execute " Insert Into tbCcRight values('" & strOpr & "'" & strSQL & " )", iAff
            If iAff <> 1 Then
                DBCN.RollbackTrans
                tOprLimited = False
                MsgBox "权限处理失败！！", vbInformation, "提示："
                Exit Function
            End If
            DBCN.CommitTrans
            tOprLimited = True
    End If
    Exit Function
ErrInfo:
    DBCN.RollbackTrans
    tOprLimited = False
    MsgBox Err.Description, vbInformation, "提示："
End Function

'18、读取权限
Public Function tReadLimit(strOpr As String, iLimited As Integer) As Integer
    
    Dim rsTemp             As New ADODB.Recordset
    
    Set rsTemp = DBCN.Execute("Select Mode_" & iLimited & " From tbCcRight Where Oper_ID='" & strOpr & "'")
    If rsTemp.EOF = False Then
        If IsNull(rsTemp.Fields(0)) = False Then
            tReadLimit = rsTemp.Fields(0)
        Else
            tReadLimit = 0
        End If
    Else
        tReadLimit = 0
    End If
    
End Function