Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

file 172 lines (141 sloc) 5.235 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172
Attribute VB_Name = "Search"
Option Base 1

Public Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByRef saArray() As Any) As Long
Public Declare Function timeGetTime Lib "winmm.dll" () As Long '获取开机至今过去多少时间
Public Declare Function timeBeginPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long '时间分辨率
Public Declare Function timeEndPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long


'读取数据库

Public Function ReadData(TableName As String, TagName As String) As Report_Data()
    Dim TagValue() As Report_Data
    Dim i As Integer
    Dim rs_Num As Integer
    MyData = "database\OPC1.mdb"
    Set Cnn = New ADODB.Connection
'建立与数据库的连接
    With Cnn
        .Provider = "microsoft.jet.oledb.4.0"
        .Open MyData
    End With
'查询数据表
    Set rs = New ADODB.Recordset
    rs.Open TableName, Cnn, 1, 1
    rs.MoveFirst
    rs_Num = rs.RecordCount
   ' rs_Numb = rs.Fields.Count
  ReDim TagValue(rs_Num) As Report_Data
' ReDim ReadData(rs_Num) As Report_Data
     i = 1

 Do While Not rs.EOF
 TagValue(i).TagName = rs(TagName)
 TagValue(i).N = rs(0)
 TagValue(i).TagDIS = rs("TagDIS")
                i = i + 1
                rs.MoveNext
Loop

 ReadData = TagValue
'弹出提示信息
    'MsgBox "XXXXXXXXXX", vbInformation + vbOKOnly
    '关闭数据集和与数据库的连接,并释放变量
    rs.Close
    Cnn.Close
    Set rs = Nothing
    Set Cnn = Nothing

End Function
'存储数据
Public Function SaveData(TableNames As String, UpNum As Integer, DownNum As Integer, LastNum As Integer, VarName() As Variant, Now_Hour As Date)
 MyData = "database\OPC1.mdb"
 Dim NowHour As Integer
 NowHour = Hour(Now_Hour)
 Set Cnn = New ADODB.Connection
    With Cnn
        .Provider = "microsoft.jet.oledb.4.0"
        .Open MyData
    End With
    Set rs = New ADODB.Recordset
    rs.Open TableNames, Cnn, 1, 3
    rs.MoveLast
    rs.AddNew
    rs("日期") = Now_Hour
    If SafeArrayGetDim(VarName) = 0 Then
    For i = UpNum To DownNum + 2 'fmMain.LvListView.ListItems.Count
        rs(i - LastNum - 2) = fmMain.LvListView.ListItems(i).SubItems(3)
    Next i
    
    Else
        If NowHour = 16 Then '中班记录插入算法
        rs(2) = fmMain.LvListView.ListItems(1 + LastNum + 3).SubItems(3) - VarName(2, 0) '产量
        rs(3) = fmMain.LvListView.ListItems(2 + LastNum + 3).SubItems(3) - VarName(3, 0) '运行时间
           If rs(3) > 0.05 Then
             For i = UpNum To DownNum 'fmMain.LvListView.ListItems.Count
                rs(i - LastNum) = (fmMain.LvListView.ListItems(i + 2).SubItems(3) * fmMain.LvListView.ListItems(5 + LastNum).SubItems(3) - VarName(i - LastNum, 0) * VarName(3, 0)) / rs(3) '参数均值
             Next i
             If TableNames = "窑系统" Then
             rs(38) = fmMain.LvListView.ListItems(58).SubItems(3) - VarName(38, 0)
             rs(39) = fmMain.LvListView.ListItems(59).SubItems(3) - VarName(39, 0)
             End If
            Else
                For i = UpNum To DownNum
                rs(i - LastNum) = 0
                Next i
             
           End If
         Else
         If NowHour = 0 Then '夜班记录插入算法
         rs(2) = fmMain.LvListView.ListItems(1 + LastNum + 3).SubItems(3) - VarName(2, 1) - VarName(2, 0) '产量
         rs(3) = fmMain.LvListView.ListItems(2 + LastNum + 3).SubItems(3) - VarName(3, 1) - VarName(3, 0) '运行时间
         If rs(3) > 0.05 Then
            For i = UpNum To DownNum 'fmMain.LvListView.ListItems.Count
                 rs(i - LastNum) = (fmMain.LvListView.ListItems(i + 2).SubItems(3) * fmMain.LvListView.ListItems(5 + LastNum).SubItems(3) - VarName(i - LastNum, 0) * VarName(3, 0) - VarName(i - LastNum, 1) * VarName(3, 1)) / rs(3)
            Next i
             If TableNames = "窑系统" Then
             rs(38) = fmMain.LvListView.ListItems(58).SubItems(3) - VarName(38, 0) - VarName(38, 1)
             rs(39) = fmMain.LvListView.ListItems(59).SubItems(3) - VarName(39, 0) - VarName(39, 1)
             End If
            Else
                 For i = UpNum To DownNum
                 rs(i - LastNum) = 0
                 Next i
            End If
         End If
        End If
    End If
    rs.Update
    
   
    rs.Close
    Cnn.Close
    Set rs = Nothing
    Set Cnn = Nothing

End Function
Public Function CheckData(TableName As String, k As Integer) As Variant
 MyData = "database\OPC1.mdb"
 Dim tt() As Variant
         Set Cnn = New ADODB.Connection
         With Cnn
         .Provider = "microsoft.jet.oledb.4.0"
         .Open MyData
          End With
          Set rs = New ADODB.Recordset
          rs.Open TableName, Cnn, 1, 1
          If Not rs.EOF Then
          rs.MoveLast
       End If
          If IsNull(rs(4)) Or IsNull(rs("日期")) Or k = 8 Then
         CheckData = tt
          Else
          If 490 < DateDiff("n", rs("日期"), Now) Then '大于8小时,60*98
         CheckData = tt
         Else
         If k = 16 Then
         CheckData = rs.GetRows(1)
         Else
         If k = 0 Then
         rs.MovePrevious
         CheckData = rs.GetRows(2)
         Else
         CheckData = tt
         End If
         End If
          End If
          End If
           rs.Close
  Cnn.Close
    Set rs = Nothing
   Set Cnn = Nothing



















End Function
Something went wrong with that request. Please try again.