modcondb.bas

办公流程定制

                    strSQL = strSQL & tmpCond.CDS_AppName & "','"
                    strSQL = strSQL & tmpCond.CDS_AppField & "','"
                    strSQL = strSQL & tmpCond.CDS_OperSignal & "','"
                    strSQL = strSQL & tmpCond.CDS_CondValue & "','"
                    strSQL = strSQL & tmpCond.CDS_LogicSignal & "')"
                    g_CONN.Execute strSQL
                    tmpSql = tmpSql & " " & tmpCond.CDS_LogicSignal & " " & tmpCond.CDS_AppName & "." & tmpCond.CDS_AppField & " " & tmpCond.CDS_OperSignal & " " & tmpCond.CDS_CondValue
                Next j
                If Trim$(tmpSql) <> "" Then
                    strSQL = "Insert Into tbwf_Condsql(ActId,WFId,CondSql) values("
                    strSQL = strSQL & .LineNo & "," & WFID & ",'"
                    strSQL = strSQL & tmpSql & "')"
                    g_CONN.Execute strSQL
                End If
            End If
        End With
    Next i
    g_CONN.CommitTrans
    SaveDB = True
End Function

Private Function CheckRect() As Boolean
Dim i, j As Integer
Dim line1, line2, line3, line4 As Integer
Dim RectMidpoint As POINTAPI
If mRectCount < 1 Then
    MsgBox "没有需要保存的节点。"
    CheckRect = True
    Exit Function
End If
If mLineCount < 1 Then
    MsgBox "没有需要保存的动作。"
    CheckRect = True
    Exit Function
End If
line1 = 0: line2 = 0: line3 = 0: line4 = 0
'检查开始节点
RectMidpoint = mvarRect(1).EndPoint
CheckRect = False
For i = 1 To mLineCount
    If mvarLine(i).BeginPoint.X = RectMidpoint.X And mvarLine(i).BeginPoint.Y = (RectMidpoint.Y - 400) Then
        '线的起点连接矩形的上中点
        If mvarLine(i).LineType = 1 Then
            line1 = line1 + 1
        ElseIf mvarLine(i).LineType = 3 Then
            line2 = line2 + 1
        ElseIf mvarLine(i).LineType = 4 Then
            line3 = line3 + 1
        End If
    ElseIf mvarLine(i).BeginPoint.X = RectMidpoint.X And mvarLine(i).BeginPoint.Y = (RectMidpoint.Y + 400) Then
        '线的起点连接矩形的下中点
        If mvarLine(i).LineType = 1 Then
            line1 = line1 + 1
        ElseIf mvarLine(i).LineType = 3 Then
            line2 = line2 + 1
        ElseIf mvarLine(i).LineType = 4 Then
            line3 = line3 + 1
        End If
    ElseIf mvarLine(i).BeginPoint.Y = RectMidpoint.Y And mvarLine(i).BeginPoint.X = (RectMidpoint.X - 300) Then
        '线的起点连接矩形的左中点
        If mvarLine(i).LineType = 1 Then
            line1 = line1 + 1
        ElseIf mvarLine(i).LineType = 3 Then
            line2 = line2 + 1
        ElseIf mvarLine(i).LineType = 4 Then
            line3 = line3 + 1
        End If
    ElseIf mvarLine(i).BeginPoint.Y = RectMidpoint.Y And mvarLine(i).BeginPoint.X = (RectMidpoint.X + 300) Then
        '线的起点连接矩形的右中点
        If mvarLine(i).LineType = 1 Then
            line1 = line1 + 1
        ElseIf mvarLine(i).LineType = 3 Then
            line2 = line2 + 1
        ElseIf mvarLine(i).LineType = 4 Then
            line3 = line3 + 1
        End If
    End If
Next i
If line2 > 1 Then
    MsgBox "开始节点只能有一条直流线。", vbCritical + vbOKOnly, "错误提示"
    CheckRect = True
    Exit Function
ElseIf line3 > 0 Then
    MsgBox "开始节点不应有回退线。", vbCritical + vbOKOnly, "错误提示"
    CheckRect = True
    Exit Function
ElseIf line2 = 1 And line1 > 0 Then
    MsgBox "直流线与回退线在同一节点不应同时存在。", vbCritical + vbOKOnly, "错误提示"
    CheckRect = True
    Exit Function
ElseIf line2 = 0 And line1 = 0 Then
    MsgBox "开始节点没有连线出去。", vbCritical + vbOKOnly, "错误提示"
    CheckRect = True
    Exit Function
ElseIf line1 = 1 Then
    MsgBox "开始节点使用的线型不符（分流线应该大于1）。", vbCritical + vbOKOnly, "错误提示"
    CheckRect = True
    Exit Function
End If
'检查中间节点
For j = 2 To mRectCount
    RectMidpoint = mvarRect(j).EndPoint
    line1 = 0: line2 = 0: line3 = 0: line4 = 0
    For i = 1 To mLineCount
        If mvarLine(i).BeginPoint.X = RectMidpoint.X And mvarLine(i).BeginPoint.Y = (RectMidpoint.Y - 400) Then
            '线的起点连接矩形的上中点
            If mvarLine(i).LineType = 1 Then
                line1 = line1 + 1
            ElseIf mvarLine(i).LineType = 3 Then
                line2 = line2 + 1
            ElseIf mvarLine(i).LineType = 4 Then
                line3 = line3 + 1
            End If
        ElseIf mvarLine(i).BeginPoint.X = RectMidpoint.X And mvarLine(i).BeginPoint.Y = (RectMidpoint.Y + 400) Then
            '线的起点连接矩形的下中点
            If mvarLine(i).LineType = 1 Then
                line1 = line1 + 1
            ElseIf mvarLine(i).LineType = 3 Then
                line2 = line2 + 1
            ElseIf mvarLine(i).LineType = 4 Then
                line3 = line3 + 1
            End If
        ElseIf mvarLine(i).BeginPoint.Y = RectMidpoint.Y And mvarLine(i).BeginPoint.X = (RectMidpoint.X - 300) Then
            '线的起点连接矩形的左中点
            If mvarLine(i).LineType = 1 Then
                line1 = line1 + 1
            ElseIf mvarLine(i).LineType = 3 Then
                line2 = line2 + 1
            ElseIf mvarLine(i).LineType = 4 Then
                line3 = line3 + 1
            End If
        ElseIf mvarLine(i).BeginPoint.Y = RectMidpoint.Y And mvarLine(i).BeginPoint.X = (RectMidpoint.X + 300) Then
            '线的起点连接矩形的右中点
            If mvarLine(i).LineType = 1 Then
                line1 = line1 + 1
            ElseIf mvarLine(i).LineType = 3 Then
                line2 = line2 + 1
            ElseIf mvarLine(i).LineType = 4 Then
                line3 = line3 + 1
            End If
        ElseIf mvarLine(i).EndPoint.X = RectMidpoint.X And mvarLine(i).EndPoint.Y = (RectMidpoint.Y - 400) Then
            '线的终点连接矩形的上中点
            If mvarLine(i).LineType = 1 Then
                line4 = line4 + 1
            ElseIf mvarLine(i).LineType = 3 Then
                line4 = line4 + 1
            End If
        ElseIf mvarLine(i).EndPoint.X = RectMidpoint.X And mvarLine(i).EndPoint.Y = (RectMidpoint.Y + 400) Then
            '线的终点连接矩形的下中点
            If mvarLine(i).LineType = 1 Then
                line4 = line4 + 1
            ElseIf mvarLine(i).LineType = 3 Then
                line4 = line4 + 1
            End If
        ElseIf mvarLine(i).EndPoint.Y = RectMidpoint.Y And mvarLine(i).EndPoint.X = (RectMidpoint.X - 300) Then
            '线的终点连接矩形的左中点
            If mvarLine(i).LineType = 1 Then
                line4 = line4 + 1
            ElseIf mvarLine(i).LineType = 3 Then
                line4 = line4 + 1
            End If
        ElseIf mvarLine(i).EndPoint.Y = RectMidpoint.Y And mvarLine(i).EndPoint.X = (RectMidpoint.X + 300) Then
            '线的终点连接矩形的右中点
            If mvarLine(i).LineType = 1 Then
                line4 = line4 + 1
            ElseIf mvarLine(i).LineType = 3 Then
                line4 = line4 + 1
            End If
        End If
    Next i
    
    If mvarRect(j).NodeType = 3 Then
        If line2 > 0 Then
            MsgBox "[" & mvarRect(j).NodeName & "]为结束节点，结束节点不应有出去的直流线。", vbCritical + vbOKOnly, "错误提示"
            CheckRect = True
            Exit Function
        ElseIf line3 > 1 Then
            MsgBox "[" & mvarRect(j).NodeName & "]为结束节点，结束节点只能有一条回退线。", vbCritical + vbOKOnly, "错误提示"
            CheckRect = True
            Exit Function
        ElseIf line1 > 0 Then
            MsgBox "[" & mvarRect(j).NodeName & "]为结束节点，结束节点不应有出去的分流线。", vbCritical + vbOKOnly, "错误提示"
            CheckRect = True
            Exit Function
        ElseIf line4 = 0 Then
            MsgBox "[" & mvarRect(j).NodeName & "]为结束节点，结束节点要有进入的连接动作。", vbCritical + vbOKOnly, "错误提示"
            CheckRect = True
            Exit Function
        End If
    Else
        If line2 > 1 Then
            MsgBox "[" & mvarRect(j).NodeName & "]为中间节点，中间节点只能有一条出去的直流线。", vbCritical + vbOKOnly, "错误提示"
            CheckRect = True
            Exit Function
        ElseIf line3 > 1 Then
            MsgBox "[" & mvarRect(j).NodeName & "]为中间节点，中间节点只能有一条出去的回退线。"
            CheckRect = True
            Exit Function
        ElseIf line2 = 1 And line1 > 0 Then
            MsgBox "[" & mvarRect(j).NodeName & "]为中间节点，在中间节点上不应同时存在直流线与分流线。", vbCritical + vbOKOnly, "错误提示"
            CheckRect = True
            Exit Function
        ElseIf line2 = 0 And line1 = 0 Then
            MsgBox "[" & mvarRect(j).NodeName & "]为中间节点，在该中间节点上没有出去动作连线。", vbCritical + vbOKOnly, "错误提示"
            CheckRect = True
            Exit Function
        ElseIf line1 = 1 Then
            MsgBox "[" & mvarRect(j).NodeName & "]为中间节点，在该中间节点上出去分流线不应该小于2条。", vbCritical + vbOKOnly, "错误提示"
            CheckRect = True
            Exit Function
        ElseIf line4 = 0 Then
            MsgBox "[" & mvarRect(j).NodeName & "]为中间节点，在该中间节点上要有进入的动作线。", vbCritical + vbOKOnly, "错误提示"
            Exit Function
        End If
    End If
Next j

'检查动作性
For i = 1 To mLineCount
    line1 = mvarLine(i).BeginRect
    line2 = mvarLine(i).EndRect
    If mvarLine(i).LineType = 3 Or mvarLine(i).LineType = 1 Then
        For j = i + 1 To mLineCount
            line3 = mvarLine(j).BeginRect
            line4 = mvarLine(j).EndRect
            If line3 = line2 And line1 = line4 And (mvarLine(j).LineType = 3 Or mvarLine(j).LineType = 1) Then
                MsgBox "流程定义出现二义性", vbCritical + vbOKOnly, "错误提示"
                CheckRect = True
                Exit Function
            End If
            If line1 = line3 And line2 = line4 And mvarLine(j).LineType = 4 Then
                MsgBox "流程定义出现二义性", vbCritical + vbOKOnly, "错误提示"
                CheckRect = True
                Exit Function
            End If
        Next j
    End If
    If mvarRect(line1).NodeType = 1 Or mvarRect(line1).NodeType = 4 Or mvarRect(line1).NodeType = 0 Then
        If Trim$(mvarRect(line2).UserName) = "" Then
            MsgBox "节点" & line1 & "为自动节点，节点" & line2 & "必需指定用户。", vbCritical + vbOKOnly, "错误提示"
            CheckRect = True
            Exit Function
        End If
    End If
    If mvarLine(i).LineType = 1 Then
        If mvarLine(i).GetCondNum < 1 Then
            MsgBox "分流线没有设置分流条件。", vbCritical + vbOKOnly, "错误提示"
            CheckRect = True
            Exit Function
        End If
    End If
Next i
End Function


'=====================================================
'************************************************
'************************************************
'=====================================================
'转换函数过程
'16进制转换10进制
Function DataN(Flag As String) As String
    Select Case Flag
        Case "A"
            DataN = "10"
        Case "B"
            DataN = "11"
        Case "C"
            DataN = "12"
        Case "D"
            DataN = "13"
        Case "E"
            DataN = "14"
        Case "F"
            DataN = "15"
        Case Else
            DataN = Flag
    End Select
End Function

'infile:需加密的字符串
Private Function Pencode(infile As String) As String
Dim basecode As String
Dim i, j, k, l As Integer
Dim StrAsc() As String
On Error GoTo errhand:
    basecode = "PkPm84272233"
    l = Len(basecode)
    j = Len(infile)
    ReDim StrAsc(j)
    For i = 1 To j
        StrAsc(i) = Asc(Mid(infile, i, 1))
        k = i Mod l
        StrAsc(i) = StrAsc(i) Xor Asc(Mid(basecode, k + 1, 1))
        StrAsc(i) = Hex(CInt(StrAsc(i)))
    Next i
    Pencode = ""
    For i = j To 1 Step -1
        Pencode = Pencode & StrAsc(i) & "-"
    Next i
    If Trim$(Pencode) <> "" Then
        Pencode = Left(Pencode, Len(Pencode) - 1)
    End If
    Exit Function
errhand:
    Pencode = ""
    Exit Function
End Function

Private Function Pdecode(Outfile As String) As String
Dim basecode As String
Dim i, j, k, l As Integer
Dim StrAsc() As String
On Error GoTo errhand:
    basecode = "PkPm84272233"
    l = Len(basecode)
    StrAsc = Split(Outfile, "-")
    j = UBound(StrAsc)
    For i = j To 0 Step -1
        
        If Len(StrAsc(i)) = 1 Then
            StrAsc(i) = DataN(StrAsc(i))
        Else
            StrAsc(i) = Val(DataN((Left(StrAsc(i), 1))) * 16 + Val(DataN(Right(StrAsc(i), 1))))
        End If
        
        k = (j - i + 1) Mod l
        StrAsc(i) = StrAsc(i) Xor Asc(Mid(basecode, k + 1, 1))
        StrAsc(i) = Chr(StrAsc(i))
    Next i
    Pdecode = ""
    For i = j To 0 Step -1
        Pdecode = Pdecode & StrAsc(i)
    Next i

    Exit Function
errhand:
    Pdecode = ""
    Exit Function
End Function