发布于 2006-07-21 11:21:37
0楼
我到VB编程的网上找了两个程序修改了一下,现在能够实现VB将WINCC数据读到ACCESS,VB程序自动隐藏,WINCC停止运行VB程序也自动停止运行。原代码如下:
'添加图标到任务栏提示区
Const MAX_TOOLTIP As Integer = 64
Const NIF_ICON = &H2 '删除图标
Const NIF_MESSAGE = &H1
Const NIF_TIP = &H4
Const NIM_ADD = &H0 '添加图标到任务栏提示区
Const NIM_DELETE = &H2
Const WM_MOUSEMOVE = &H200
Const WM_LBUTTONDOWN = &H201
Const WM_LBUTTONUP = &H202
Const WM_LBUTTONDBLCLK = &H203
Const WM_RBUTTONDOWN = &H204
Const WM_RBUTTONUP = &H205
Const WM_RBUTTONDBLCLK = &H206
Const SW_RESTORE = 9
Const SW_HIDE = 0
Private Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * MAX_TOOLTIP
End Type
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" _
(ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Private nfIconData As NOTIFYICONDATA
'当“WINCC运行系统”关闭时关闭此程序
'显示当前运行的窗体的API声明
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDNEXT = 2
Private Const GWL_STYLE = (-16)
Private Const WS_VISIBLE = &H10000000
Private Const WS_BORDER = &H800000
'关闭当前运行的窗体的API声明
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_CLOSE = &H10
Dim appname As String
'定义所要窗口风格的变量
Dim IsTask As Long
'找出所有窗口的过程
Sub FindAllApps()
Dim hwcurr As Long
Dim intLen As Long
Dim strTitle As String
Dim Bit_Wincc_Run As Boolean
Bit_Wincc_Run = False
'列表清空
List1.Clear
'获得第一个窗口的句柄
hwcurr = GetWindow(Me.hwnd, GW_HWNDFIRST)
'循环,找出主窗口列表中所有的窗口
Do While hwcurr <> TaskWindow(hwcurr)
If hwcurr <> Me.hwnd And TaskWindow(hwcurr) Then
'获得该窗口的标题长度及标题
intLen = GetWindowTextLength(hwcurr) + 1
strTitle = Space$(intLen)
intLen = GetWindowText(hwcurr, strTitle, intLen)
If intLen > 0 Then
List1.AddItem strTitle, 0
If List1.List(0) = "WinCC 运行系统 - " Then
'If List1.List(0) = "好的进程" Then
Bit_Wincc_Run = True
End If
End If
End If
'获得下一个窗口的句柄
hwcurr = GetWindow(hwcurr, GW_HWNDNEXT)
Loop
If Bit_Wincc_Run = False Then
End
End If
End Sub
Private Sub Form_Load()
'定义需要显示的窗口,可见并且有边界
IsTask = WS_VISIBLE Or WS_BORDER
FindAllApps
'添加图标到任务栏提示区
'添加图标
nfIconData.hwnd = Me.hwnd
nfIconData.uID = Me.Icon
nfIconData.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
nfIconData.uCallbackMessage = WM_MOUSEMOVE
nfIconData.hIcon = Me.Icon.Handle
nfIconData.szTip = "System Tray Example" & vbNullChar
nfIconData.cbSize = Len(nfIconData)
Call Shell_NotifyIcon(NIM_ADD, nfIconData)
'隐藏窗口
ShowWindow Me.hwnd, SW_HIDE
Me.Visible = False
End Sub
'判断窗口是否符合要求
Function TaskWindow(hwcurr As Long) As Long
Dim lngStyle As Long
'获取窗口风格,并判断是否符合要求
lngStyle = GetWindowLong(hwcurr, GWL_STYLE)
If (lngStyle And IsTask) = IsTask Then
TaskWindow = True
End If
End Function
Private Sub Timer1_Timer()
'在窗体重画时刷新列表
FindAllApps
End Sub
Private Sub Timer2_Timer()
Dim wincc As Object
Dim wk As Workspace
Dim db As Database
Dim rs As Recordset
Dim iColumnCount As Long
Dim lColumnIndex As Long
Dim sDBFILE As String
Dim sTagName As String
Dim test1 As Variant
Dim test2 As Variant
Dim test3 As Variant
Dim test4 As Variant
Dim Tagval(14) As Single
If Minute(Now) = 0 And Second(Now) = 0 Then
Set wincc = CreateObject("WinCC-Runtime-Project") '创建wincc运行对象,这个方法在组态手册里能找到
sDBFILE = "d:\data1\db1.mdb"
test1 = wincc.getvalue("test_1") '读取wincc变量值到vb的text变量
test2 = wincc.getvalue("test_2")
test3 = wincc.getvalue("test_3")
test4 = wincc.getvalue("test_4")
Tagval(1) = test1
Tagval(2) = test2
Tagval(3) = test3
Tagval(4) = test4
Set wk = Workspaces(0)
Set db = wk.OpenDatabase(sDBFILE)
iColumnCount = db.TableDefs("FloatTable").Fields.Count
Set rs = db.OpenRecordset("Select * from FloatTable")
rs.AddNew
rs.Fields(0).Value = Now()
For lColumnIndex = 1 To iColumnCount - 1
rs.Fields(lColumnIndex).Value = Tagval(lColumnIndex)
Next lColumnIndex
rs.Update
End If
End Sub
注意:完成上述VB程序后,编译生成.exe文件,在WINCC启动项里添加它就可以了。
如果你想从ACCESS里查询你需要的日期的数据生成只需要在EXCEL自带的VBA里编写一段查询的程序就可以生成日报表、月报表了。这些我都测试过了,打算下次用WINCC做工程就这样做。VB原代码有写的不好的地方请各位兄弟多指点。
张其鹏