frwinccadodc.frm

使用 VB 编写访问 WinCC 软件的 SQL server 数据库的代码。

                oBt.ToolTipText = edSql
                
                Set conn = CreateObject("ADODB.Connection")
                conn.ConnectionString = GetSQLOLEDBConnString(m_SER, m_DSN)
                conn.CursorLocation = 3
                conn.Open
                
                Set oCom = CreateObject("ADODB.Command")
                Set oCom.ActiveConnection = conn
                oCom.CommandType = 1
                oCom.CommandText = edSql
                oCom.Execute
                'DataGrid1.Caption = edSql

                conn.Close
                Set conn = Nothing
                
                .RecordSource = m_Sql(0)
                .Refresh
                DataGrid1.Caption = m_Sql(0)
                oBt.BackColor = RGB(0, 100, 20)
                Lap.Caption = "Number of records=" & .Recordset.RecordCount
                
                
            End If
        Else
        
            oBt.ToolTipText = edSql
            .RecordSource = edSql
            .Refresh
            DataGrid1.Caption = edSql
            oBt.BackColor = RGB(0, 100, 20)
            Lap.Caption = "Number of records=" & .Recordset.RecordCount
            If m_Mod = TAGLOGG Then
              ShowTagValuesWithMs
            End If
        End If
    Case 2
        NextSql (False)
    Case 3
        Lap = m_ERR
        m_ERR = ""
    Case 4
        edSql.Enabled = Not edSql.Enabled
    End Select
End With
Exit Sub
ErrH:
   s = "Error in : " + oBt.ToolTipText + vbCr & _
       Err.Description & vbCr
  MsgBox s
  m_ERR = m_ERR + s
End Sub

Private Sub cmdCsv_Click()
Dim oRs As ADODB.Recordset, N As Long, M As Long, Z(), sL As String, K%

On Error GoTo ErrH:
  Set oRs = Adodc1.Recordset
  N = oRs.RecordCount
  M = oRs.Fields.Count
  ReDim Z(M)
  For K = 0 To M - 1
    Z(K) = oRs(K).Name
  Next K
  sL = Join(Z, g_c_CSV_Delimiter)
  sL = Left(sL, Len(sL) - 1)
  Open sCsv For Output As #1
  Print #1, sL
  If N < 2 Then
    Close #1
    Exit Sub
  End If
  oRs.MoveFirst
  While Not oRs.EOF
    For K = 0 To M - 1
      Z(K) = oRs(K).Value
    Next K
    sL = Join(Z, g_c_CSV_Delimiter)
    sL = Left(sL, Len(sL) - 1)
    Print #1, sL
    oRs.MoveNext
  Wend
  
  oRs.MoveFirst
  Close #1
  Lap.Caption = "Export to " & sCsv & vbCr & _
              "completed"
              
  Exit Sub
ErrH:
  Lap.Caption = Err.Description
End Sub

Private Sub cmdStat_Click()
Dim oRs As ADODB.Recordset, N As Long
On Error GoTo ErrH:
  Set oRs = Adodc1.Recordset
  N = oRs.RecordCount
  If N < 2 Then Exit Sub
  If (m_Mod = TAGLOGG) Then
    Dim Sum As Single, Avg As Double, Sta As Double, V As Double, dSqr As Double
    N = 0
    While Not oRs.EOF
      N = N + 1
      V = oRs(2).Value
      Sum = Sum + V
      Sta = Sta + V * V
      oRs.MoveNext
    Wend
    Avg = Sum / N
    dSqr = Sta - N * Avg ^ 2
    Sta = Sqr(dSqr / (N - 1))
    oRs.MoveFirst
    Lap.Caption = "N   =" & N & vbCr & _
                  "Sum =" & Format(Sum, "0.000") & vbCr & _
                  "Avg =" & Format(Avg, " 0.000") & vbCr & _
                  "Sta =" & Format(Sta, " 0.000") & vbCr & _
                  "--------------------"
  Else
    Dim MsgNr As Long
      MsgNr = oRs(0).Value
      N = 0
    While Not oRs.EOF
      If (oRs(0).Value = MsgNr) Then
        N = N + 1
        Sum = Sum + oRs("TimeDiff").Value
      End If
      oRs.MoveNext
    Wend
    Avg = Sum / N
    oRs.MoveFirst
    Lap.Caption = "MsgNr=" & MsgNr & vbCr & _
                  "N   =" & N & vbCr & _
                  "Sum =" & Format(Sum, "0.000") & vbCr & _
                  "Avg =" & Format(Avg, " 0.000") & vbCr & _
                  "--------------------"
  End If
  Exit Sub
ErrH:
   Lap.Caption = Err.Description
   
End Sub

Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer)
Dim s As String, sL As String, sI As String, i%
s = DataGrid1.Columns(ColIndex).Caption
sL = "Actions on " & s & vbCr & _
     "N = nothing" & vbCr & _
     "O = order  " & vbCr & _
     "V = visible" & vbCr
sI = InputBox(sL, "Functions", "N")
Select Case sI
Case "N"
Case "O"
     sL = Adodc1.RecordSource
     sL = sL & " ORDER BY " & s
     Adodc1.RecordSource = sL
     Adodc1.Refresh
Case "V"
   For i = 3 To DataGrid1.Columns.Count - 1
       If (i = ColIndex) Then
       Else
         DataGrid1.Columns(i).Visible = False
       End If
   Next i
End Select

End Sub



Private Sub Form_Load()
  m_DSN = g_DSN
  m_Mod = g_Mod
  m_SER = g_SER
  If m_Mod = 0 Then Exit Sub
  If m_Mod = TAGLOGG Then sCsv = g_Path & g_FilT
  If m_Mod = ALALOGG Then sCsv = g_Path & g_FilA
  Laps(0) = E01
  Laps(1) = T01
  Laps(2) = T02
  Laps(3) = T03
  SetDefaultTimes
  If (g_Mod = UA) Then  ' User Archive
    Adodc1.ConnectionString = GetSQLOLEDBConnString(m_SER, m_DSN)
    cmdStat.Enabled = False
    cmdCsv.Enabled = False
  Else
    Adodc1.ConnectionString = GetWinCCOleDbConnString(m_SER, m_DSN)
  End If
  NextSql (True)
  DataGrid1.Caption = m_SER & ";" & m_DSN & Laps(m_Mod)
End Sub
Private Sub Form_Resize()
Dim w As Long
w = Me.Width - 300
If m_W = 0 Then
    m_W = Me.Width
    m_H = Me.Height
End If

If Me.Width < m_W Or Me.Height < m_H Then
Else
   DataGrid1.Width = w
   Lap.Width = w
   edSql.Width = w - edSql.Left
   DataGrid1.Height = Me.Height - DataGrid1.Top - 500
   Debug.Print DataGrid1.Height
End If
End Sub


Private Sub ShowTagValuesWithMs()

  Dim rs
  Dim i
  
  On Error GoTo ErrH:
  
  For i = 1 To DataGrid1.Columns.Count - 1
    DataGrid1.Columns.Remove 0
  Next

  Dim strColumns
  Dim aColumn
  strColumns = "ValueID,DateTime,Ms,RealValue,Quality,Flags"
 
  aColumn = Split(strColumns, ",")
  
  For i = LBound(aColumn) To UBound(aColumn) - 1
    DataGrid1.Columns.Add i
  Next

  Set rs = New ADODB.Recordset

  With rs
      .Fields.Append "ValueID", adInteger
      .Fields.Append "DateTime", adVarChar, 255
      .Fields.Append "Ms", adInteger
      .Fields.Append "RealValue", adDouble
      .Fields.Append "Quality", adInteger
      .Fields.Append "Flags", adInteger
      .CursorType = adOpenStatic
      .LockType = adLockOptimistic
      .Open
  End With

  Dim strDateTime As String
  Dim iMs As Integer

  While Adodc1.Recordset.EOF = False
    
    rs.AddNew
    rs("ValueID").Value = Adodc1.Recordset("ValueID").Value
    
    SplitDateTimeAndMs Adodc1.Recordset("Timestamp").Value, strDateTime, iMs
    
    rs("DateTime").Value = strDateTime
    rs("MS").Value = iMs
    rs("RealValue").Value = Adodc1.Recordset("RealValue").Value
    rs("Quality").Value = Adodc1.Recordset("Quality").Value
    rs("Flags").Value = Adodc1.Recordset("Flags").Value
    rs.MoveNext
    Adodc1.Recordset.MoveNext
  Wend

  If Adodc1.Recordset.BOF = False Then
    Adodc1.Recordset.MoveFirst
  End If

  Dim nColumnWidth As Integer

  For i = 0 To UBound(aColumn) - LBound(aColumn)
    DataGrid1.Columns.Item(i).DataField = aColumn(i + LBound(aColumn))
    DataGrid1.Columns.Item(i).Caption = aColumn(i + LBound(aColumn))
    Select Case UCase(aColumn(i))
      Case "VALUEID"
        nColumnWidth = 900
      Case "DATETIME"
        nColumnWidth = 1900
      Case "MS"
        nColumnWidth = 500
      Case "REALVALUE"
        nColumnWidth = 2000
      Case "QUALITY"
        nColumnWidth = 900
      Case "FLAGS"
        nColumnWidth = 900
      Case Else
        nColumnWidth = 1000
    End Select
    DataGrid1.Columns.Item(i).Width = nColumnWidth
  Next

  DataGrid1.HoldFields
  Set DataGrid1.DataSource = rs
  
  Exit Sub
  
ErrH:
   Lap.Caption = Err.Description
  
End Sub

Private Sub SplitDateTimeAndMs(dtDateTimeWithMs_in As Variant, strDateTime_out As String, strMs_out As Integer)
     
  Dim diff As Double
  Dim dtTemp As Double
     
  diff = (CDbl(dtDateTimeWithMs_in) - CDbl(CDate(CStr(dtDateTimeWithMs_in)))) * 24 * 60 * 60 * 1000
  If (diff < 0) Then
    diff = 1000 + diff
    dtTemp = CDbl(dtDateTimeWithMs_in) - diff / (24# * 60 * 60 * 1000)
    strDateTime_out = CDate(dtTemp)
  Else
    strDateTime_out = CDate(dtDateTimeWithMs_in)
  End If
  strMs_out = "00" & Round(diff)
  strMs_out = Right(strMs_out, 3)
  
End Sub