frmsfgz.frm

采用面向负荷控制技术

           End If
                If find <> "" Then
                   sql = sql & find
                End If
            Set rs = Nothing
            rs.ActiveConnection = "dsn=dbw;uid=sa"
            rs.CursorLocation = adUseClient
            rs.CursorType = adOpenKeyset
            rs.LockType = adLockOptimistic
            rs.Source = sql
            rs.Open
            If rs.RecordCount = 0 Then
               comupdate.Enabled = False
               comdelete.Enabled = False
               MsgBox "没有查到相关算法信息！", vbExclamation + vbInformation
            Else
               comupdate.Enabled = True
               comdelete.Enabled = True
            
            End If
            Set DataGrid1.DataSource = rs
            DataGrid1.Refresh
       
  
End Sub

Private Sub Comfind1_Click()
    Dim lens As Integer
 Dim sql As String
 Dim find As String
 Dim msg As Integer
 Dim i As Integer
 
       sql = "select * from t_knowledge  "
        find = ""
            If Trim$(txtcode) <> "" Then
               find = "where zhshcode='" & Trim$(txtcode.Text) & "'"
            End If
             
            If Trim$(txtname.Text) <> "" Then
              If find <> "" Then
                find = find & " and zhshname='" & Trim$(txtname.Text) & "'"
              Else
                find = " where zhshname='" & Trim$(txtname.Text) & "'"
              End If
            End If
            If Trim$(txtwt.Text) <> "" Then
                If find <> "" Then
                  find = find & " and question='" & Trim$(txtwt.Text) & "'"
                Else
                  find = "where question='" & Trim$(txtwt.Text) & "'"
                End If
           End If
           If Trim$(txtmodel.Text) <> "" Then
                If find <> "" Then
                  find = find & " and chjmodel='" & Trim$(txtmodel.Text) & "'"
                Else
                  find = "where chjmodel='" & Trim$(txtmodel.Text) & "'"
                End If
           End If
           If Trim$(txtdd.Text) <> "" Then
                If find <> "" Then
                  find = find & " and  ddmb='" & Trim$(txtdd.Text) & "'"
                Else
                  find = "where ddmb='" & Trim$(txtdd.Text) & "'"
                End If
           End If
                If find <> "" Then
                   sql = sql & find
                End If
            Set rs = Nothing
            rs.ActiveConnection = "dsn=dbw;uid=sa"
            rs.CursorLocation = adUseClient
            rs.CursorType = adOpenKeyset
            rs.LockType = adLockOptimistic
            rs.Source = sql
            rs.Open
            If rs.RecordCount = 0 Then
               comupdate.Enabled = False
               comdelete.Enabled = False
               MsgBox "没有查到相关规则信息！", vbExclamation + vbInformation
            Else
               comupdate.Enabled = True
               comdelete.Enabled = True
            
            End If
            Set DataGrid1.DataSource = rs
            DataGrid1.Refresh
  End Sub

Private Sub comincrease_Click()
   ' 设置“CancelError”为 True
CommonDialog1.CancelError = True
On Error GoTo errhandler
' 设置标志
CommonDialog1.Flags = cdlOFNHideReadOnly
' 设置过滤器
CommonDialog1.Filter = "All Files (*.*)|*.*|Text Files" & _
"(*.txt)|*.txt|Batch Files (*.bat)|*.bat"
' 指定缺省的过滤器
CommonDialog1.FilterIndex = 2
' 显示“打开”对话框
CommonDialog1.ShowOpen
' 显示选定文件的名字
MsgBox CommonDialog1.FileName
txtsfmsh.Text = CommonDialog1.FileName
Exit Sub

errhandler:
' 用户按了“取消”按钮
End Sub

Private Sub cominitial_Click()
 Unload Me
End Sub

Private Sub comupdate_Click()
Dim findrs As New ADODB.Recordset
  Dim msg As Integer
  msg = MsgBox("您确实要修改此算法吗？", vbYesNo + vbQuestion)
  If msg = vbYes Then
      If Trim$(txtsfcode.Text) = "" Then
       MsgBox "请您输入算法代号!", vbExclamation + vbInformation
       Exit Sub
      End If
        If Trim$(txtsfname.Text) = "" Then
           MsgBox "请您输入算法名称！", vbExclamation + vbInformation
           Exit Sub
        End If
        If Trim$(txtsflx.Text) = "" Then
          MsgBox "请您输入问题类型！", vbExclamation + vbInformation
           Exit Sub
        End If
      
        If Trim$(txtsfcsh.Text) = "" Then
           MsgBox "请您输入算法的参数信息！", vbExclamation + vbInformation
           Exit Sub
        End If
         If Trim$(txtsfmsh.Text) = "" Then
           MsgBox "请您输入加载算法！", vbExclamation + vbInformation
           Exit Sub
        End If
                Set findrs = Nothing
                findrs.ActiveConnection = "dsn=dbw;uid=sa"
                findrs.CursorLocation = adUseClient
                findrs.CursorType = adOpenKeyset
                findrs.LockType = adLockOptimistic
                findrs.Source = "select * from t_Algorithm where sfcode='" & Trim$(txtsfcode.Text) & "'"
                findrs.Open
                If findrs.RecordCount <> 0 Then
                    rs("sfname") = Trim$(txtsfname)
                    rs("sflx") = Trim$(txtsflx)
                    rs("sfcsh") = Trim$(txtsfcsh)
                    rs("sfmsh") = Trim$(txtsfmsh)
                    If txtnote.Text <> "" Then rs("note") = CStr(txtnote.Text)
                    rs.Update
                Else
                    rs.Delete
                    DoEvents
                    rs.AddNew
                    rs("sfcode") = Trim$(txtsfcode)
                    rs("sfname") = Trim$(txtsfname)
                    rs("sflx") = Trim$(txtsflx)
                    rs("sfcsh") = Trim$(txtsfcsh)
                    rs("sfmsh") = Trim$(txtsfmsh)
                    If txtnote.Text <> "" Then rs("note") = CStr(txtnote.Text)
                    rs.Update
               End If
   End If

End Sub

Private Sub Comupdate1_Click()
  Dim findrs As New ADODB.Recordset
  Dim msg As Integer
  msg = MsgBox("您确实要修改此规则吗？", vbYesNo + vbQuestion)
  If msg = vbYes Then
      If Trim$(txtcode.Text) = "" Then
       MsgBox "请您输入规则代号!", vbExclamation + vbInformation
       Exit Sub
      End If
        If Trim$(txtname.Text) = "" Then
           MsgBox "请您输入规则名称！", vbExclamation + vbInformation
           Exit Sub
        End If
        If Trim$(txtwt.Text) = "" Then
          MsgBox "请您输入问题类型！", vbExclamation + vbInformation
           Exit Sub
        End If
      
        If Trim$(txtmodel.Text) = "" Then
           MsgBox "请您输入车间模式！", vbExclamation + vbInformation
           Exit Sub
        End If
         If Trim$(txtdd.Text) = "" Then
           MsgBox "请您输入调度目标！", vbExclamation + vbInformation
           Exit Sub
        End If
        If Trim$(txtsf.Text) = "" Then
           MsgBox "请您输入算法代号！", vbExclamation + vbInformation
           Exit Sub
        End If

                Set findrs = Nothing
                findrs.ActiveConnection = "dsn=dbw;uid=sa"
                findrs.CursorLocation = adUseClient
                findrs.CursorType = adOpenKeyset
                findrs.LockType = adLockOptimistic
                findrs.Source = "select * from t_knowledge where zhshcode='" & Trim$(txtcode.Text) & "'"
                findrs.Open
                If findrs.RecordCount <> 0 Then
                    
                     rs("zhshname") = Trim$(txtname)
                     rs("question") = Trim$(txtwt)
                     rs("chjmodel") = Trim$(txtmodel)
                     rs("sfcode") = Trim$(txtsf)
                     rs("ddmb") = Trim$((txtdd.Text))
                     rs.Update
                    
                Else
                    rs.Delete
                    DoEvents
                    rs.AddNew
                     rs("zhshcode") = Trim$(txtcode)
                     rs("zhshname") = Trim$(txtname)
                     rs("question") = Trim$(txtwt)
                     rs("chjmodel") = Trim$(txtmodel)
                     rs("sfcode") = Trim$(txtsf)
                     rs("ddmb") = Trim$((txtdd.Text))
                     rs.Update
            End If
   End If

End Sub

Private Sub DataGrid1_Click()
   If rs.RecordCount <> 0 Then
        rs.Bookmark = DataGrid1.Bookmark
        txtsfcode = rs("sfcode")
        txtsfname = rs("sfname")
        txtsflx = rs("sflx")
        txtsfcsh = rs("sfcsh")
        txtsfmsh = rs("sfmsh")
        If Not IsNull(rs("note")) Then txtnote = rs("note")
    End If
End Sub

Private Sub DataGrid2_Click()
   If rs.RecordCount <> 0 Then
     txtcode.Text = CStr(rs("zhshcode"))
     txtname.Text = CStr(rs("zhshname"))
     txtwt.Text = CStr(rs("question"))
     txtmodel.Text = CStr(rs("chjmodel"))
     txtsf.Text = CStr(rs("sfcode"))
     txtdd.Text = CStr(rs("ddmb"))
     
   End If
End Sub

Private Sub Form_Load()
            Set rs = Nothing
            rs.ActiveConnection = "dsn=dbw;uid=sa"
            rs.CursorLocation = adUseClient
            rs.CursorType = adOpenDynamic
            rs.LockType = adLockOptimistic
            rs.Source = "select * from t_algorithm"
            rs.Open
            
            SSTab1.Tab = 0
       If rs.RecordCount = 0 Then
               comupdate.Enabled = False
               comdelete.Enabled = False
       End If
       Set DataGrid1.DataSource = rs
       DataGrid1.Refresh
       Call initial(DataGrid1, "算法库")
       Set mconn = Nothing
       mconn.Open "dsn=dbw;uid=sa"
        Dim sql As String, i As Integer
        Set rs2 = Nothing
        sql = "select * from rules order by ruleno "
        rs2.CursorLocation = adUseClient
        rs2.Open sql, mconn, adOpenKeyset, adLockPessimistic
         Call opengz
End Sub


Private Sub SSTab1_Click(PreviousTab As Integer)
      If SSTab1.Tab = 0 Then
           Set rs = Nothing
            rs.ActiveConnection = "dsn=dbw;uid=sa"
            rs.CursorLocation = adUseClient
            rs.CursorType = adOpenDynamic
            rs.LockType = adLockOptimistic
            rs.Source = "select * from t_algorithm"
            rs.Open
           
       If rs.RecordCount = 0 Then
               comupdate.Enabled = False
               comdelete.Enabled = False
       End If
       Set DataGrid1.DataSource = rs
       DataGrid1.Refresh
        Call initial(DataGrid1, "算法库")
      Else
       Set rs = Nothing
            rs.ActiveConnection = "dsn=dbw;uid=sa"
            rs.CursorLocation = adUseClient
            rs.CursorType = adOpenDynamic
            rs.LockType = adLockOptimistic
            rs.Source = "select * from t_knowledge"
            rs.Open
            
       If rs.RecordCount = 0 Then
               comupdate.Enabled = False
               comdelete.Enabled = False
       End If
       Set DataGrid2.DataSource = rs
       DataGrid1.Refresh
        Call initial(DataGrid2, "知识库")
      End If
End Sub

Sub opengz()
Dim sql As String, i As Integer
Set rs2 = Nothing
sql = "select * from rules order by ruleno "
rs2.CursorLocation = adUseClient
rs2.Open sql, mconn, adOpenKeyset, adLockPessimistic
If rs2.RecordCount = 0 Then
    Set DataGrid3.DataSource = Nothing
    DataGrid2.Refresh
Else
    rs2.MoveFirst
    Set DataGrid3.DataSource = rs2
    DataGrid3.Refresh
    DataGrid3.Columns.Item(0).Caption = " 编 号 "
    DataGrid3.Columns(0).Width = 0.7 * (DataGrid1.Width + 600) / 6
    DataGrid3.Columns.Item(1).Caption = " 名  称"
    DataGrid3.Columns(1).Width = 0.7 * (DataGrid1.Width + 600) / 3
    DataGrid3.Columns.Item(2).Caption = " 路  径 "
    DataGrid3.Columns(2).Width = 0.7 * (DataGrid1.Width + 600) / 3
    DataGrid3.Columns.Item(3).Caption = " 描  述"
    DataGrid3.Columns(3).Width = 0.7 * (DataGrid1.Width + 600) / 6
    DataGrid3.Columns.Item(4).Caption = " 备  注"
    DataGrid3.Columns(4).Width = 0.7 * (DataGrid1.Width + 600) / 6
    'Call DataGrid3_Click
End If

End Sub