modcondb.bas

办公流程定制

Attribute VB_Name = "modcondb"
Public g_CONN As New ADODB.Connection
Public mvarLine() As New clsLine    '保存线
Public mvarRect() As New clsRect   '保存矩形
Public mLineCount As Long       '记录所有连线数
Public mRectCount As Long       '记录所有矩形数

Public g_WFID As Integer  '保存流程ID
Public g_WFType As Integer '保存流程类型
Public g_WFTemp As String '保存流程模板名称

Public g_ConnDBString As String '连接数据库的字符串

Public g_RectRs As New ADODB.Recordset
Public g_RectUserRs As New ADODB.Recordset
Public g_LineRs As New ADODB.Recordset
Public g_LinePointRs As New ADODB.Recordset
Public g_TableFieldRs As New ADODB.Recordset
Public g_ActCondRs As New ADODB.Recordset
Public g_AllUserRs As New ADODB.Recordset


Public Function ConDB() As Boolean
Dim strSQL As String
Dim strDBName As String
    On Error Resume Next
'    '---连接Access数据库:::不要删除下面被注释的代码
'    strDBName = App.Path & "\db\BuildM.mdb"
'    g_Con.ConnectionTimeout = 30
'    g_Con.CursorLocation = adUseClient
'    g_Con.Provider = "Microsoft.Jet.OLEDB.4.0"
'    g_Con.Open strDBName ', "admin", ""
    
    '---连接sql数据库:::不要删除下面被注释的代码
    If g_CONN.State Then g_CONN.Close
    g_CONN.Provider = "sqloledb"
    g_CONN.CursorLocation = adUseClient
'    If Trim$(g_ConnDBString) = "" Then
        g_CONN.Properties("Data Source").Value = "10.13.107.27"
        g_CONN.Properties("Initial Catalog").Value = "pkpmoa"
        g_CONN.Properties("User ID") = "sa"
        g_CONN.Properties("Password") = "84272233"
'    Else
'        g_CONN.ConnectionString = Pdecode(g_ConnDBString)
'    End If
    g_CONN.Open
    ReadBaseTable '读取基础数据
    
    If Err.Number = 0 Then
        ConDB = True
    Else
        'Err.Clear
        MsgBox Err.Description
        MsgBox "数据库连接出现问题或在读取数据中发生意外错误。", vbCritical + vbOKOnly, "错误提示"
        ConDB = False
    End If
End Function
Private Sub ReadBaseTable()
Dim strSQL As String
Dim RS As New ADODB.Recordset
Dim DD As New ADODB.Recordset
Dim b As ADODB.Stream


    '==========================================
    If g_AllUserRs.State Then g_AllUserRs.Close
    If g_ActCondRs.State Then g_ActCondRs.Close
    If g_TableFieldRs.State Then g_TableFieldRs.Close
    If g_LinePointRs.State Then g_LinePointRs.Close
    If g_LineRs.State Then g_LineRs.Close
    If g_RectUserRs.State Then g_RectUserRs.Close
    If g_RectRs.State Then g_RectRs.Close

    strSQL = "select distinct username,deparment_c,username_c from groupuser Order By Deparment_c,userName_c"
    g_AllUserRs.Open strSQL, g_CONN
'    Set b = New ADODB.Stream
'    g_AllUserRs.Save b, adPersistXML
'    'b.Type = adTypeBinary
'    'Debug.Print b.ReadText(-1)
'    b.Position = 0
'    DD.Open b
'    DD.Close
'    Set DD = Nothing
'    g_AllUserRs.Open "http://localhost/Alluser.asp"
    strSQL = "Select WFType,TempName From tbwf_define Where WFID=" & g_WFID
    RS.Open strSQL, g_CONN
    If RS.EOF = False Then
        g_WFType = RS.Fields("WFType")
        g_WFTemp = RS.Fields("TempName")
    End If
    RS.Close
    RS.Open
    Set RS = Nothing
    
    If Trim$(g_WFTemp) <> "" Then
        If g_WFType = 1 Then
            strSQL = "select TmpltId,FieldName From tbwf_tmpltdefine Where TmpltId=" & g_WFTemp
            strSQL = strSQL & " order by FieldName"
            g_TableFieldRs.Open strSQL, g_CONN
        ElseIf g_WFType = 2 Then
            strSQL = "select TableName,FieldName From FieldInfo Where TableName in (" & "'" & Replace(g_WFTemp, ",", "', '") & "'" & ")"
            strSQL = strSQL & " order by tablename,fieldname"
            g_TableFieldRs.Open strSQL, g_CONN
        End If
    End If
    
End Sub
Private Sub ReadTable()
Dim strSQL As String
    strSQL = "Select * From tbwf_node Where WFID=" & g_WFID & " Order By NodeId"
    g_RectRs.Open strSQL, g_CONN
    strSQL = "Select * From tbwf_act Where WFID=" & g_WFID
    g_LineRs.Open strSQL, g_CONN
    strSQL = "Select OperUser,Username_C,NodeId From tbwf_nodeusedman,groupuser Where UserName=OperUser and wfid=" & g_WFID & " Order By NodeId,OperUser"
    g_RectUserRs.Open strSQL, g_CONN
    strSQL = "Select * From tbwf_actpoint Where WFID=" & g_WFID & " order by ActId,PointId"
    g_LinePointRs.Open strSQL, g_CONN
    strSQL = "Select * From tbwf_Condition Where WFID=" & g_WFID & " order by ActId,CondID"
    g_ActCondRs.Open strSQL, g_CONN
End Sub
Public Function ReadData(vData As PictureBox, vData2 As PictureBox, vData3 As ImageList)
Dim strSQL As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim NodeID As Integer
Dim UserName() As String
Dim tmpCond As ConditionStruct
Dim tmpSql As String
Dim WFID As Integer
Dim RS As New ADODB.Recordset
Dim RSMan As New ADODB.Recordset
Dim tmpPoint As POINTAPI
    WFID = g_WFID
    '读取数据库中的数据
    ReadTable
    '读节点
    Set RS = g_RectRs.Clone(adLockReadOnly)
    i = 0
    Do Until RS.EOF
        i = i + 1
        mRectCount = i
        ReDim Preserve mvarRect(i)
        With mvarRect(i)
            .ClsName = "RECT"
            .AddAdvice = RS.Fields("IsAddAdvice")
            .AddAttach = RS.Fields("IsAddAttach")
            .AgreeNum = RS.Fields("AgreeNum")
            Set .DrawFrm = vData
            Set .Cache = vData2
            Set .SetImageList = vData3
            .NodeName = RS.Fields("NodeName")
            .NodeType = RS.Fields("NodeType")
            .RectNo = RS.Fields("NodeId")
            .RefAppTable = RS.Fields("RefApp")
            .SeeAdvice = RS.Fields("IsSeeAdvice")
            .SeeAttach = RS.Fields("IsSeeAttach")
            tmpPoint.X = RS.Fields("NodeX")
            tmpPoint.Y = RS.Fields("NodeY")
            .EndPoint = tmpPoint
            Set RSMan = g_RectUserRs.Clone(adLockReadOnly)
            RSMan.Filter = "NodeId=" & RS.Fields("NodeId")
            Set RSMan = RSMan
            .UserName = ""
            .UserName_C = ""
            Do Until RSMan.EOF
                .UserName = .UserName & RSMan.Fields("OperUser") & ","
                .UserName_C = .UserName_C & RSMan.Fields("UserName_C") & ","
                RSMan.MoveNext
            Loop
            RSMan.Close
            Set RSMan = Nothing
            If Trim$(.UserName) <> "" Then
                .UserName = Left(.UserName, Len(.UserName) - 1)
                .UserName_C = Left(.UserName_C, Len(.UserName_C) - 1)
            End If
        End With
        RS.MoveNext
    Loop
    RS.Close
    Set RS = Nothing
    '读动作
    Set RS = g_LineRs.Clone(adLockReadOnly)
    i = 0
    Do Until RS.EOF
        i = i + 1
        mLineCount = i
        ReDim Preserve mvarLine(i)
        With mvarLine(i)
            .ClsName = "LINE"
            Set .DrawFrm = vData
            .BeginRect = RS.Fields("NodeId")
            .EndRect = RS.Fields("NextNodeId")
            .LineNo = RS.Fields("ActId")
            .LineType = RS.Fields("ActType")
            .LineName = RS.Fields("ActName")
            Set RSMan = g_LinePointRs.Clone(adLockReadOnly)
            RSMan.Filter = "ActId=" & RS.Fields("ActId")
            j = 0
            Do Until RSMan.EOF
                j = j + 1
                .MidPointCount = j
                tmpPoint.X = RSMan.Fields("pointx")
                tmpPoint.Y = RSMan.Fields("pointy")
                .SetPoint tmpPoint, j
                RSMan.MoveNext
            Loop
            RSMan.Close
            Set RSMan = Nothing
            .BeginPoint = .ReturnPoint(1)
            
            Set RSMan = g_ActCondRs.Clone(adLockReadOnly)
            RSMan.Filter = "ActId=" & RS.Fields("ActId")
            j = 0
            Do Until RSMan.EOF
                j = j + 1
                .SetCondNum (j)
                tmpCond.CDS_SubCondId = j
                tmpCond.CDS_CondName = RSMan.Fields("CondName")
                tmpCond.CDS_AppName = RSMan.Fields("AppName")
                tmpCond.CDS_AppField = RSMan.Fields("AppField")
                tmpCond.CDS_OperSignal = RSMan.Fields("OperSignal")
                tmpCond.CDS_CondValue = RSMan.Fields("CondValue")
                tmpCond.CDS_LogicSignal = RSMan.Fields("LogicSignal")
                .SetCondition tmpCond, j
                RSMan.MoveNext
            Loop
            RSMan.Close
            Set RSMan = Nothing
        End With
        RS.MoveNext
    Loop
    RS.Close
    Set RS = Nothing
End Function
Public Function SaveDB() As Boolean
Dim strSQL As String
Dim i, j, k As Integer
Dim NodeID As Integer
Dim UserName() As String
Dim tmpCond As ConditionStruct
Dim tmpSql As String
Dim WFID As Integer
    'On Error Resume Next
'    g_CONN.BeginTrans
'    保存流程定义表
'    With frmWFClass
'    strSQL = "Insert Into tbwf_define(CID,WFType,WFName,TempName,Memo,DefMan) values('"
'    strSQL = strSQL & "aa'," & .cbowf_Type.ListIndex & ",'" & .txtwf_Name.Text & "','"
'    strSQL = strSQL & .Text1.Text & "','" & .Text2.Text & "','zwd')"
'    End With
'    g_CONN.Execute strSQL
    WFID = g_WFID
    If CheckRect = True Then
        'MsgBox "保存失败。", vbCritical + vbOKOnly, "错误提示"
        SaveDB = False
        Exit Function
    End If
    g_CONN.BeginTrans
    '删除表
    strSQL = "delete from tbwf_nodeusedman where WFId=" & WFID
    g_CONN.Execute strSQL
    strSQL = "delete from tbwf_node where WFId=" & WFID
    g_CONN.Execute strSQL
    strSQL = "delete from tbwf_condsql where WFId=" & WFID
    g_CONN.Execute strSQL
    strSQL = "delete from tbwf_Condition where WFId=" & WFID
    g_CONN.Execute strSQL
    strSQL = "delete from tbwf_actpoint where WFId=" & WFID
    g_CONN.Execute strSQL
    strSQL = "delete from tbwf_act where WFId=" & WFID
    g_CONN.Execute strSQL
    '保存流程节点表
    For i = 1 To mRectCount
        strSQL = "Insert Into tbwf_node(NodeId,WFId,NodeName,NodeType,RefApp,IsAddAttach,IsSeeAttach,IsAddAdvice,IsSeeAdvice,AgreeNum,NodeX,NodeY) values("
        strSQL = strSQL & mvarRect(i).RectNo & "," & WFID & ",'"
        strSQL = strSQL & mvarRect(i).NodeName & "',"
        strSQL = strSQL & mvarRect(i).NodeType & ",'"
        strSQL = strSQL & mvarRect(i).RefAppTable & "',"
        If mvarRect(i).AddAttach = True Then
            strSQL = strSQL & "1,"
        Else
            strSQL = strSQL & "0,"
        End If
        If mvarRect(i).SeeAttach = True Then
            strSQL = strSQL & "1,"
        Else
            strSQL = strSQL & "0,"
        End If
        If mvarRect(i).AddAdvice = True Then
            strSQL = strSQL & "1,"
        Else
            strSQL = strSQL & "0,"
        End If
        If mvarRect(i).SeeAdvice = True Then
            strSQL = strSQL & "1,"
        Else
            strSQL = strSQL & "0,"
        End If
        strSQL = strSQL & mvarRect(i).AgreeNum & ","
        strSQL = strSQL & mvarRect(i).EndPoint.X & ","
        strSQL = strSQL & mvarRect(i).EndPoint.Y & ")"
        g_CONN.Execute strSQL
        If Trim$(mvarRect(i).UserName) <> "" Then
            UserName = Split(mvarRect(i).UserName, ",")
            k = UBound(UserName)
            For j = 0 To k
                strSQL = "Insert Into tbwf_nodeusedman(wfid,nodeid,operuser) values("
                strSQL = strSQL & WFID & "," & i & ",'"
                strSQL = strSQL & UserName(j) & "')"
                g_CONN.Execute strSQL
            Next j
        End If
    Next i
    '保存连线表
'    g_CONN.CommitTrans
    For i = 1 To mLineCount
        With mvarLine(i)
            strSQL = "Insert Into tbwf_act(ActId,WFId,NodeId,ActType,ActName,NextNodeId) values("
            strSQL = strSQL & .LineNo & "," & WFID & ","
            strSQL = strSQL & .BeginRect & ","
            strSQL = strSQL & .LineType & ",'"
            strSQL = strSQL & .LineName & "',"
            strSQL = strSQL & .EndRect & ")"
            g_CONN.Execute strSQL
            For j = 1 To .MidPointCount
                strSQL = "Insert Into tbwf_actPoint(ActId,WFId,PointId,PointX,PointY) values("
                strSQL = strSQL & .LineNo & "," & WFID & ","
                strSQL = strSQL & j & ","
                strSQL = strSQL & .ReturnPoint(j).X & ","
                strSQL = strSQL & .ReturnPoint(j).Y & ")"
                g_CONN.Execute strSQL
            Next j
            If .LineType = 1 Then
                tmpSql = ""
                For j = 1 To .GetCondNum
                    tmpCond = .ReturnCondition(j)
                    strSQL = "Insert Into tbwf_Condition(ActId,WFId,CondId,CondName,AppName,AppField,OperSignal,CondValue,LogicSignal) values("
                    strSQL = strSQL & .LineNo & "," & WFID & ","
                    strSQL = strSQL & tmpCond.CDS_SubCondId & ",'"
                    strSQL = strSQL & tmpCond.CDS_CondName & "','"