form5.frm

vb 编写的直接读取连个数据库进行表表读写达到数据同步

Dim bof_general_data() As String

Dim tb_blowing_patt1() As String
Dim tb_blowing_patt2() As String



Dim L3_plan() As String
Dim L3_Lab() As String
'Dim dyn_coef() As Double
'Dim production_plan() As String
'Dim sublance_coef() As String
Dim temp_cal(19) As String
Dim HM_SCR() As String

Dim HM_Cal_Raw_M() As String
Dim HM_Cal_Flux() As String

Dim HM_DATA_CAL() As String

Dim Heat_Data() As String
Public CONV_NO As String ''

Dim L2_TO_L3_Data() As String

Dim OK_Num_Plan, Error_Num_Plan As Integer
Dim OK_Num_Real, Error_Num_Real As Integer
Dim OK_Num_Cal, Error_Num_Cal As Integer

Dim OK_Num_Para, Error_Num_Para As Integer

Dim HEAT_NO_0, HEAT_NO_1, HEAT_NO_2 As String
Dim HEAT_NO2_0, HEAT_NO2_1, HEAT_NO2_2 As String

Dim int_num, int_counter As Long
Dim SYS_SDM_ON As Integer
Dim SYS_SDM_ON_BE As Integer
    
 
Private Sub Cmd_Para_Click()
    Call Read_Para
End Sub

Private Sub Cmd_SDM_TO_CCM_Click()

    Call SDM_TO_CCM
End Sub


Private Sub Command1_Click()

    If Timer1.Enabled = False Then
        Timer1.Enabled = True
        Command1.Caption = "自动刷新状态"
        Cmd_CCM_TO_SDM.Enabled = False
    Else
        Timer1.Enabled = False
        Command1.Caption = "自动停止状态"
        Cmd_CCM_TO_SDM.Enabled = True
    End If
    
End Sub

Private Sub Cmd_CCM_TO_SDM_Click()
    Call CCM_TO_SDM
End Sub

Private Sub Command2_Click()

    If Timer2.Enabled = False Then
        Timer2.Enabled = True
        Command2.Caption = "自动刷新状态"
        Cmd_SDM_TO_CCM.Enabled = False
    Else
        Timer2.Enabled = False
        Command2.Caption = "自动停止状态"
        Cmd_SDM_TO_CCM.Enabled = True
    End If
    
End Sub

Private Sub Command3_Click()
    If Timer3.Enabled = False Then
        Timer3.Enabled = True
        Command3.Caption = "自动刷新状态"
        Cmd_Para.Enabled = False
    Else
        Timer3.Enabled = False
        Command3.Caption = "自动停止状态"
        Cmd_Para.Enabled = True
    End If
End Sub

Private Sub Form_Load()

    Timer1.Enabled = False
    Timer2.Enabled = False
    Timer3.Enabled = False
    
    Timer1.Interval = Val(Text1.Text) * 1000
    Timer2.Interval = Val(Text2.Text) * 1000
    Timer3.Interval = 60000
    
    
    int_num = Val(Text3.Text)
    
'    Cmd_SDM_TO_CCM.Enabled = False
'    Command2.Enabled = False
    
    Check1.Value = 0
    Check2.Value = 1
    Check3.Value = 1
    
    SYS_SDM_ON = 0  ''启动时先置0
    SYS_SDM_ON_BE = 0
    Call Link_Oracle_Write
    
End Sub

Private Sub Text1_Change()

     If Val(Text1.Text) >= 20 And Val(Text1.Text) <= 60 Then
        Timer1.Interval = Val(Text1.Text) * 1000
     End If

End Sub
Private Sub Text3_Change()

    If Val(Text3.Text) >= 1 And Val(Text3.Text) <= 60 Then
        int_num = Val(Text3.Text)
    End If

End Sub

Private Sub Text2_Change()

     If Val(Text2.Text) >= 20 And Val(Text2.Text) <= 60 Then
        Timer2.Interval = Val(Text2.Text) * 1000
     End If
End Sub

Private Sub Timer1_Timer()

    Call CCM_TO_SDM
    
End Sub

Private Sub CCM_TO_SDM() ''测试模型BOF_SDM  从 原模型BOFCCM 中读取生产计划,   铁水,废钢,生铁实际值


'    On Error Resume Next
    
    Call Link_Oracle_Read
    Label15.Caption = " "
    Label16.Caption = " "
    
    If HEAT_NO_0 <> "" Then
   
        Call CCM_TO_SDM_Plan(HEAT_NO_0)        ''刷计划
        
        Call CCM_TO_SDM_Real(HEAT_NO_0) '0炉
        Call CCM_TO_SDM_Real(HEAT_NO_1) '1炉
        Call CCM_TO_SDM_Real(HEAT_NO_2) '2炉
        
    End If

End Sub
Private Sub SDM_TO_CCM()  ''测试模型BOF_SDM  向 原模型BOFCCM 写过程计算,设定数据

    
'    On Error Resume Next
    
    Call Link_Oracle_Write
    Label17.Caption = " "

    If SYS_SDM_ON = 1 Then Label17.Caption = "系统投入状态!,正在向CCM写数据!!!! "
    If SYS_SDM_ON = 0 Then Label17.Caption = "系统退出状态!没有向CCM写数据! "
    
    If SYS_SDM_ON = 1 Then Check1.Value = 0
    If SYS_SDM_ON = 0 Then Check1.Value = 1
    If HEAT_NO2_0 <> "" And SYS_SDM_ON = 1 Then    '''如果系统投入,刷新数据
    
    '''温度计算值 设定值----------------------------------------------------------------------
    Call SDM_TO_CCM_Cal(HEAT_NO2_0)
    Call SDM_TO_CCM_Cal(HEAT_NO2_1)
    Call SDM_TO_CCM_Cal(HEAT_NO2_2)
   
    End If
    
End Sub
Private Sub CCM_TO_SDM_Plan(ByVal PLAN_HEAT_ID As String)  '从原系统中读取----生产计划----------

On Error GoTo PlanError

    Dim Data_Querry As Date
    Dim BE_NO, PLAN_HEAT_L3 As String
'    Data_Querry = Date - 100

    BE_NO = Mid(Year(Date), 3, 1)
    PLAN_HEAT_L3 = BE_NO + PLAN_HEAT_ID
    
    'L3_L2_plan-------------三级生产计划
    
    Set rs_CCM = New ADODB.Recordset
'    sql_CCM = "select * from l3_l2_plan  where SEND_TIME >=TO_DATE('" & Data_Querry & "','yyyy-mm-dd HH24:mi:ss') order by PLAN_HEAT_ID desc ,SEND_TIME desc"
    sql_CCM = "select * from l3_l2_plan  where PLAN_HEAT_ID>='" & PLAN_HEAT_L3 & "'  order by PLAN_HEAT_ID desc ,SEND_TIME desc"
    rs_CCM.Open sql_CCM, cn_CCM, adOpenStatic, adLockOptimistic


    If rs_CCM.RecordCount > 0 Then

        j = rs_CCM.RecordCount
        ReDim L3_plan(0 To j - 1, 0 To 9)
        rs_CCM.MoveFirst
        For k = 0 To j - 1
            For i = 0 To 9
                If IsNull(rs_CCM.Fields(i)) = True Then
                    L3_plan(k, i) = 0
                Else
                    L3_plan(k, i) = rs_CCM.Fields(i)
                End If
            Next i
            rs_CCM.MoveNext
        Next k


        For k = 0 To j - 1
            Set rs_SDM = New ADODB.Recordset
            sql_SDM = "select * from l3_l2_plan where PLAN_HEAT_ID='" & Trim(L3_plan(k, 0)) & "' and MSG_NUMBER='" & Trim(L3_plan(k, 9)) & "' "
            rs_SDM.Open sql_SDM, cn_SDM, adOpenStatic, adLockOptimistic
            If rs_SDM.RecordCount <> 0 Then
'               For i = 0 To 9
'                  rs_SDM.Fields(i) = L3_plan(k, i)
'               Next i
'               rs_SDM.Update
'               rs_SDM.Close
               Else
                  rs_SDM.AddNew
                  For i = 0 To 9
                      rs_SDM.Fields(i) = L3_plan(k, i)
                  Next i
                  rs_SDM.Update
                  rs_SDM.Close
            End If
        Next k

    End If



    'tc_production_plan--------二级生产计划

    Set rs_CCM = New ADODB.Recordset
    sql_CCM = "select * from tc_production_plan  order by heat_no"
    rs_CCM.Open sql_CCM, cn_CCM, adOpenStatic, adLockOptimistic

    If rs_CCM.RecordCount <> 0 Then

        j = rs_CCM.RecordCount
        ReDim production_plan(0 To j - 1, 0 To 15)
        rs_CCM.MoveFirst
        For k = 0 To j - 1
            For i = 0 To 15
                If IsNull(rs_CCM.Fields(i)) = True Then
                    production_plan(k, i) = 0
                Else
                     production_plan(k, i) = rs_CCM.Fields(i)
                End If
            Next i
            rs_CCM.MoveNext
        Next k



        For k = 0 To j - 1
            Set rs_SDM = New ADODB.Recordset
            sql_SDM = "select * from tc_production_plan where heat_no='" & Trim(production_plan(k, 1)) & "' order by heat_no"
            rs_SDM.Open sql_SDM, cn_SDM, adOpenStatic, adLockOptimistic
            If rs_SDM.RecordCount <> 0 Then
               For i = 0 To 9
                  rs_SDM.Fields(i) = production_plan(k, i)
               Next i
               For i = 11 To 15
                  rs_SDM.Fields(i) = production_plan(k, i)
               Next i
               rs_SDM.Update
               rs_SDM.Close
               Else
                  rs_SDM.AddNew
                  For i = 0 To 15
                     rs_SDM.Fields(i) = production_plan(k, i)
                  Next i
                  rs_SDM.Update
                  rs_SDM.Close
            End If
        Next k

    End If
    
  
    
'   L3_L2_plan -------------化验室值

    Dim HEAT_ID_BE As String
    HEAT_ID_BE = PLAN_HEAT_ID - 2
    
    Set rs_CCM = New ADODB.Recordset
    sql_CCM = "select * from TC_ANALYSIS_FROM_LAB  where HEAT_NO>='" & HEAT_ID_BE & "'  order by HEAT_NO desc ,ANALYSE_TIME desc"
    rs_CCM.Open sql_CCM, cn_CCM, adOpenStatic, adLockOptimistic
    
    If rs_CCM.RecordCount > 0 Then

        j = rs_CCM.RecordCount
        ReDim L3_Lab(0 To j - 1, 0 To 45)
        rs_CCM.MoveFirst
        For k = 0 To j - 1
            For i = 0 To 45
                If IsNull(rs_CCM.Fields(i)) = True Then
                    L3_Lab(k, i) = 0
                Else
                    L3_Lab(k, i) = rs_CCM.Fields(i)
                End If
            Next i
            rs_CCM.MoveNext
        Next k
        
        
        For k = 0 To j - 1
            Set rs_SDM = New ADODB.Recordset
            sql_SDM = "select * from TC_ANALYSIS_FROM_LAB where HEAT_NO='" & Trim(L3_Lab(k, 0)) & "' and ANALYSIS_TYPE='" & Trim(L3_Lab(k, 2)) & "' and ANALYSE_TIME= TO_DATE('" & Trim(L3_Lab(k, 3)) & "','yyyy-mm-dd HH24:mi:ss') "
            rs_SDM.Open sql_SDM, cn_SDM, adOpenStatic, adLockOptimistic
            If rs_SDM.RecordCount <> 0 Then
'               For i = 0 To 9
'                  rs_SDM.Fields(i) = L3_Lab(k, i)
'               Next i
'               rs_SDM.Update
'               rs_SDM.Close
               Else
                  rs_SDM.AddNew
                  For i = 0 To 45
                     rs_SDM.Fields(i) = L3_Lab(k, i)
                  Next i
                  rs_SDM.Update
                  rs_SDM.Close
            End If
        Next k

    End If
    
    
    
    OK_Num_Plan = OK_Num_Plan + 1
    Label9.Caption = "读计划_成功次数： " + Trim(OK_Num_Plan)
    If OK_Num_Plan >= 7000 Then OK_Num_Plan = 0
    Exit Sub
     
PlanError:
    Beep

    Error_Num_Plan = Error_Num_Plan + 1
    If Error_Num_Plan >= 7000 Then Error_Num_Plan = 0
    Label10.Caption = "读计划_失败次数： " + Trim(Error_Num_Plan)
    Label15.Caption = "错误信息：" + Err.Description
    
End Sub
Private Sub CCM_TO_SDM_Real(ByVal Heat_no As String) ''从原系统中读取----铁水\废钢\生铁--实际值-------

On Error GoTo RealError


    '''铁水实际成分温度
    
    Dim HM_DATA(7) As Double
    
    For k = 2 To 3
    
        Set rs_CCM = New ADODB.Recordset
        sql_CCM = "select HEAT_NO,HM_C, HM_SI, HM_MN, HM_P, HM_S, HM_CU, HM_TEMP from TC_HM_DATA  where  HEAT_NO ='" & Trim(Heat_no) & "'  and rec='" & k & "' order by heat_no"
        rs_CCM.Open sql_CCM, cn_CCM, adOpenStatic, adLockOptimistic
            
            If rs_CCM.RecordCount <> 0 Then
                rs_CCM.MoveFirst
    
                For i = 1 To 7
                    If IsNull(rs_CCM.Fields(i)) = True Then
                        HM_DATA(i) = 100
                    Else
                         HM_DATA(i) = rs_CCM.Fields(i)
                    End If
                Next i
            
           
                Set rs_SDM = New ADODB.Recordset
                sql_SDM = "select HEAT_NO,HM_C, HM_SI, HM_MN, HM_P, HM_S, HM_CU, HM_TEMP from TC_HM_DATA  where  HEAT_NO ='" & Trim(Heat_no) & "'  and rec='" & k & "' order by heat_no"
                rs_SDM.Open sql_SDM, cn_SDM, adOpenStatic, adLockOptimistic
                    
                If rs_SDM.RecordCount <> 0 Then
                  rs_SDM.MoveFirst
        
                    If HM_DATA(1) <> 100 And HM_DATA(2) <> 100 And HM_DATA(3) <> 100 And HM_DATA(4) <> 100 And HM_DATA(5) <> 100 And HM_DATA(7) <> 100 Then
                        
                          For i = 1 To 7
                             If HM_DATA(i) <> 100 Then