📄 frwinccadodc.frm
字号:
VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
Begin VB.Form frWinCCAdoDC
Caption = "Testing WinCC OLEDB Provider for Archives"
ClientHeight = 4725
ClientLeft = 45
ClientTop = 330
ClientWidth = 7440
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 4725
ScaleWidth = 7440
WindowState = 2 'Maximized
Begin VB.CommandButton cmdCsv
Caption = "Export(csv)"
Height = 310
Left = 3546
TabIndex = 8
Top = 1500
Width = 1135
End
Begin VB.CommandButton cmdStat
Caption = "Statistics"
Height = 310
Left = 2400
TabIndex = 7
Top = 1500
Width = 1135
End
Begin VB.CommandButton btJob
Caption = "Next example"
Height = 310
Index = 2
Left = 1202
TabIndex = 6
Top = 1500
Width = 1135
End
Begin VB.CommandButton btJob
Caption = "Show Connection"
Height = 310
Index = 0
Left = 4710
TabIndex = 3
Top = 1500
Width = 1470
End
Begin VB.CommandButton btJob
Caption = "Execute"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 310
Index = 1
Left = 0
TabIndex = 2
Top = 1500
Width = 1135
End
Begin VB.CommandButton btJob
Caption = "Show ERR"
Height = 310
Index = 3
Left = 6210
TabIndex = 1
Top = 1500
Width = 1135
End
Begin VB.TextBox edSql
Height = 285
Left = 0
TabIndex = 0
Text = "-"
Top = 1200
Width = 7440
End
Begin MSDataGridLib.DataGrid DataGrid1
Bindings = "frWinCCAdoDC.frx":0000
Height = 2820
Left = 0
TabIndex = 4
Top = 1875
Width = 7440
_ExtentX = 13123
_ExtentY = 4974
_Version = 393216
AllowUpdate = 0 'False
HeadLines = 1
RowHeight = 15
BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "WinCC Databases"
ColumnCount = 2
BeginProperty Column00
DataField = ""
Caption = ""
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1031
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column01
DataField = ""
Caption = ""
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1031
SubFormatType = 0
EndProperty
EndProperty
SplitCount = 1
BeginProperty Split0
BeginProperty Column00
EndProperty
BeginProperty Column01
EndProperty
EndProperty
End
Begin MSAdodcLib.Adodc Adodc1
Align = 1 'Align Top
Height = 375
Left = 0
Top = 0
Visible = 0 'False
Width = 7440
_ExtentX = 13123
_ExtentY = 661
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 1
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
Caption = "Adodc1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin VB.Label Lap
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "-----"
ForeColor = &H80000008&
Height = 1215
Left = 0
TabIndex = 5
Top = 0
Width = 7425
End
End
Attribute VB_Name = "frWinCCAdoDC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const SSRCT0 = "TAG:R,1,'0000-00-00 00:01:00','0000-00-00 00:00:00'"
Const SSRCT1 = "TAG:R,(1;2),'0000-00-00 00:30:00.000','0000-00-00 00:00:00.000'"
Const SSRCT2 = "TAG:R,1,'0000-00-00 01:00:00.000','0000-00-00 00:00:00.000'"
Const SSRCT3 = "TAG:R,2,'0000-00-00 00:05:00.000','0000-00-00 00:00:00.000'"
Const SSRCT4 = "TAG:R,3,'0000-00-00 00:05:00.000','0000-00-00 00:00:00.000'"
Const SSRCT5 = "TAG:R,1,"
Const SSRCA0 = "ALARMVIEW:SELECT * FROM ALGVIEWDEU"
Const SSRCU0 = "SELECT * FROM UA#TEST"
' CC_opdb_02-06-26_12:11:44R
Dim m_ERR As String
Dim m_Sql(5) As String, m_I As Long, sCsv As String
Dim m_W As Long, m_H As Long
Dim m_SER As String, m_DSN As String, m_Mod As Long, Laps(3) As String
Dim m_Time(10) As String
Function FormatISO8601(dtMyTime As Date) As String
Dim YY As String
Dim MM As String
Dim DD As String
Dim HH As String
Dim MI As String
Dim SE As String
YY = Year(dtMyTime)
MM = Right("0" & Month(dtMyTime), 2)
DD = Right("0" & Day(dtMyTime), 2)
HH = Right("0" & Hour(dtMyTime), 2)
MI = Right("0" & Minute(dtMyTime), 2)
SE = Right("0" & Second(dtMyTime), 2)
FormatISO8601 = YY & "-" & MM & "-" & DD & " " & HH & ":" & MI & ":" & SE
End Function
Private Sub SetDefaultTimes()
m_Time(0) = FormatISO8601(Date) ' today
m_Time(1) = FormatISO8601(DateAdd("d", 1, Date)) ' tomorrow
m_Time(2) = FormatISO8601(DateAdd("d", -1, Date)) ' yesterday
m_Time(3) = FormatISO8601(DateSerial(Year(Date), Month(Date), 1)) ' 1.day of this month
m_Time(4) = FormatISO8601(DateSerial(Year(Date), Month(Date) - 1, 1)) ' 1.day of the last month
End Sub
Private Sub NextSql(b As Boolean)
If (b) Then
m_I = 0
If (m_Mod = TAGLOGG) Then 'Tag Logging
edSql = SSRCT0
m_Sql(0) = SSRCT0
m_Sql(1) = SSRCT1
m_Sql(2) = SSRCT2
m_Sql(3) = SSRCT3
m_Sql(4) = SSRCT4
m_Sql(5) = SSRCT5 & "'" & m_Time(0) & "'" & "," & "'" & m_Time(1) & "'"
ElseIf (m_Mod = ALALOGG) Then ' Alarm Logging
edSql = SSRCA0
m_Sql(0) = SSRCA0
m_Sql(1) = SSRCA0 & " WHERE DateTime>" & "'" & m_Time(2) & "'" & " AND DateTime<" & "'" & m_Time(1) & "'"
m_Sql(2) = SSRCA0 & " WHERE DateTime>" & "'" & m_Time(4) & "'" & " AND DateTime<" & m_Time(3) & "'"
m_Sql(3) = SSRCA0 & " WHERE State=2"
m_Sql(4) = SSRCA0 & " WHERE TimeDiff>100"
m_Sql(5) = SSRCA0 & " WHERE DateTime>" & "'" & m_Time(3) & "'"
ElseIf (m_Mod = UA) Then ' User Archive
edSql = SSRCU0
m_Sql(0) = SSRCU0
m_Sql(1) = SSRCU0 & " WHERE LastAccess > " & "'" & m_Time(2) & "'" & " AND LastAccess < " & "'" & m_Time(0) & "'"
m_Sql(2) = SSRCU0 & " WHERE ID > 3"
m_Sql(3) = "INSERT INTO UA#TEST (ID, F_Integer, F_Float, F_Double, F_String) VALUES (100, 10, '10.0', 100, 'AAAA')"
m_Sql(4) = "UPDATE UA#TEST SET UA#TEST.F_STRING = 'String_New' WHERE ID = 3"
m_Sql(5) = "DELETE FROM UA#TEST WHERE ID = 30"
Else
edSql = SSRCU0
End If
Else
m_I = m_I + 1
If (m_I = 6) Then m_I = 0
edSql = m_Sql(m_I)
End If
End Sub
Private Sub btJob_Click(Index As Integer)
Dim s As String, oBt As Object
On Error GoTo ErrH
Set oBt = btJob(Index)
With Adodc1
Select Case Index
Case 0 ' Show connection
Lap.Caption = "Connection String " & vbCr & _
.ConnectionString & vbCr & _
"RecordSource:" & vbCr & _
.RecordSource & vbCr
Clipboard.SetText Lap.Caption
Case 1 ' set recordsource
If g_Mod = UA Then
If Left(edSql, 1) = "S" Then ' SELECT (Read)
oBt.ToolTipText = edSql
.RecordSource = edSql
.Refresh
DataGrid1.Caption = edSql
oBt.BackColor = RGB(0, 100, 20)
Lap.Caption = "Number of records=" & .Recordset.RecordCount
Else 'Write
Dim conn As Object
Dim oCom As Object
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -