mdlmdb.bas

来自「这是一个实际的工程中所用的源程序」· BAS 代码 · 共 169 行

Attribute VB_Name = "mdlMdb"
Option Explicit
'format(dateadd("s",3600*24.0+3600,"1899-12-31 00:00:00"),"DD日HH小时mm分ss秒")
' ______________
'|
'|
'|______________
Public Sub SaveToBanXR(v日期 As Date, _
                        v班次 As String, _
                        v时间 As Date, _
                        vCang() As Double)
                         
    Dim cmdText As String
    Dim i As Integer
    Dim ub As Integer
    ub = UBound(vCang)
    
    On Error GoTo err1
       cmdText = "INSERT INTO tblBanXR(日期,班次,时间"
    For i = 1 To ub
       cmdText = cmdText & ",NameTech" & CStr(i)
    Next i
       cmdText = cmdText & ") VALUES (#" & CStr(v日期) & "#,'" & CStr(v班次) & "',#" & CStr(v时间) & "#"
       
    For i = 1 To ub
       cmdText = cmdText & "," & CStr(vCang(i))
    Next i
    cmdText = cmdText & ")"
    
'    cmdText = "INSERT INTO tblBanXR(日期,班次,时间," & _
'                            "NameTech1) " & _
'              "VALUES (#" & CStr(v日期) & "#,'" & CStr(v班次) & "',#" & CStr(v时间) & "#" & _
'                            CStr(vCang(1)) & ")"

                           
    Call CNExecute(cmdText, CN_Main, "SaveToBanXR")
    
    Exit Sub
err1:
    Debug.Assert False
    Call meErr("SaveToBanXR:存储班数据过程", Err.Description) ', , , , PATH_Errlog)
    Err.Clear
    Resume Next
End Sub

Public Sub SaveToRuning( _
                         v日期 As Date, _
                         vAddr As Integer, _
                         v物料 As String, _
                         v开始时间 As Date, _
                         v结束时间 As Date, _
                         v开始值 As Double, _
                         v结束值 As Double)
                         
    Dim cmdText As String
    On Error GoTo err1
    cmdText = "INSERT INTO tblRuning(日期, Addr, 物料, 开始时间, 结束时间, 开始值, 结束值) " & _
              "VALUES (#" & CStr(v日期) & "#," & _
                            CStr(vAddr) & ",'" & _
                            v物料 & "'," & _
                      "#" & CStr(v开始时间) & "#," & _
                      "#" & CStr(v结束时间) & "#," & _
                            CStr(v开始值) & "," & _
                            CStr(v结束值) & ")"
                            
    Call CNExecute(cmdText, CN_Main, "SaveToRuning")
    
    Exit Sub
err1:
    Debug.Assert False
    Call meErr("CStorage.SaveToRuning", Err.Description) ', , , , PATH_Errlog)
    Err.Clear
    Resume Next
End Sub
Public Sub SaveToCiiXR( _
                        vAddr As Integer, _
                        v日期 As Date, _
                        v开始时间 As Date, _
                        v结束时间 As Date, _
                        v开始值 As Double, _
                        v结束值 As Double, _
                        v合计值 As Double, _
                        v上煤码头 As String)
                         
    Dim cmdText As String
    On Error GoTo err1
    cmdText = "INSERT INTO tblCiiXR(Addr,日期,开始时间, 结束时间, 开始值, 结束值,合计值,上煤码头) " & _
              "VALUES (" & CStr(vAddr) & "," & _
                     "#" & CStr(v日期) & "#," & _
                     "#" & CStr(v开始时间) & "#," & _
                     "#" & CStr(v结束时间) & "#," & _
                           CStr(v开始值) & "," & _
                           CStr(v结束值) & "," & _
                           CStr(v合计值) & ",'" & _
                           v上煤码头 & "')"
     Debug.Print cmdText
    Call CNExecute(cmdText, CN_Main, "SaveToCiiXR")
    
    Exit Sub
err1:
    Debug.Assert False
    Call meErr("SaveToCiiXR:皮带结束存储数据过程", Err.Description) ', , , , PATH_Errlog)
    Err.Clear
    Resume Next
End Sub

'Public Enum eShop
'    [e仪表] = -1
'    [e船名] = 0
'    [e煤种] = 1
'    [e流程] = 2
'    [e设定] = 3
'    [e计量] = 4
'    [e日期] = 5
'    [e时间] = 6
'    [e备注] = 7
'End Enum

Public Sub SaveToCiiUS( _
                        v仪表 As String, _
                        v船名 As String, _
                        v煤种 As String, _
                        v流程 As String, _
                        v设定值 As Double, _
                        v计量值 As Double, _
                        v日期 As Date, _
                        v时间 As Date, _
                        v备注 As String)

    Dim cmdText As String
    On Error GoTo err1
    cmdText = "INSERT INTO tblBanXR(" & _
              nmShop(eShop.e仪表) & "," & _
              nmShop(eShop.e船名) & "," & _
              nmShop(eShop.e煤种) & "," & _
              nmShop(eShop.e流程) & "," & _
              nmShop(eShop.e设定) & "," & _
              nmShop(eShop.e计量) & "," & _
              nmShop(eShop.e日期) & "," & _
              nmShop(eShop.e时间) & "," & _
              nmShop(eShop.e备注) & ") " _
              & "VALUES (" & _
                     "'" & CStr(v仪表) & "'," & _
                     "'" & CStr(v船名) & "'," & _
                     "'" & CStr(v煤种) & "'," & _
                     "'" & CStr(v流程) & "'," & _
                           CStr(v设定值) & "," & _
                           CStr(v计量值) & "," & _
                     "#" & CStr(v日期) & "#," & _
                     "#" & CStr(v时间) & "#," & _
                     "'" & CStr(v备注) & "'" & ")"
                           
    Call CNExecute(cmdText, CN_Main, "SaveToCiiUS")
    
    Exit Sub
err1:
    Debug.Assert False
    Call meErr("SaveToCiiUS", Err.Description) ', , , , PATH_Errlog)
    Err.Clear
    Resume Next
End Sub