在wincc中使用ADOX动态创建Access数据库导出归档数据并显示2010-06-17 16:49前段时间为了做项目学了两周的VB和数据库，参考了不少资料终于可以实现了。在wincc6.0中使用vb脚本采用adox动态创建Access数据库，导出SQL server中的归档数据，用于选择时间段显示，并且可以曲线显示数据。还不完善，只是初稿很多细节问题没有完善。时间判断转换部分参考了工控论坛上的一位大牛的大作，一并作谢！废话少说贴代码。 数据库创建数据导出代码：
Dim begintime,endtime
Dim dcat,dconn,drs,dpstr
Dim dfm,ddlg,dtbl
Dim sPro,sDsn,sSer,sptr,sConn
Dim sSql1,sSql2
Dim sRs1,sRs2
Dim sCmd1,sCmd2
Dim m, n, s, b
b=timeconv(begintime,endtime,0)
If b=False Then
Exit Sub
Else
'create new database and table
set dcat = createobject("adox.catalog")
set dconn = createobject("tion")
set drs = createobject("dset")
Set ddlg = ScreenItems("dialog")
ddlg.Filter = "MDB文件(*.mdb)|*.mdb|AllFiles(*.*)|*.*|"
lsd检验
ddlg.FilterIndeX = 1
ddlg.InitDir = "E:\vb code"
ddlg.Flags = 6
ddlg.Action = 2
If ddlg.Filename = "" Then
MsgBox "you must input name"
Exit Sub
Else
dfm =ddlg.FileName
End If
dpstr = "Provider=Microsoft.Jet.OLEDB.4.0;"
dpstr = dpstr & "Data Source=" & dfm
dcat.Create dpstr
Set dtbl = CreateObject("adox.table")
dcat.ActiveConnection = dpstr
dtbl.Name = "MyTable"
dtbl.Columns.Append "time"
dtbl.Columns.Append "tag1value"
dtbl.Columns.Append "tag2value"
dcat.Tables.Append dtbl
dconn.Open dpstr
drs.CursorLocation = 3
drs.Open "MyTable",dconn, 1, 2
'open sql server database
sPro = "Provider = WinCCOLEDBProvider.1;"
sDsn = "Catalog = CC_test_10_04_21_18_05_57R;"
sSer = "Data Source = .\WinCC"
sptr = sPro + sDsn + sSer
sSql1="TAG:R,'SpeedAndTemp\motor_actual'," &begintime& "," &endtime
sSql2="TAG:R,'SpeedAndTemp\oil_temp'," &begintime& "," &endtime
Set sconn = CreateObject("ADODB.Connection")
sconn.ConnectionString = sptr
sconn.CursorLocation = 3
sconn.Open
Set sRs1 = CreateObject("ADODB.Recordset")
Set scmd1 = CreateObject("ADODB.Command")
sCmd1.CommandType = 1
Set sCmd1.ActiveConnection = sconn
sCmd1.CommandText = sSql1
Set sRs1 = sCmd1.Execute
Set sRs2 = CreateObject("ADODB.Recordset")
Set scmd2 = CreateObject("ADODB.Command")
sCmd2.CommandType = 1
Set sCmd2.ActiveConnection = sconn
sCmd2.CommandText = sSql2
Set sRs2 = sCmd2.Execute
m = sRs1.Fields.Count
If (m > 0) Then
MsgBox "bie"
sRs1.Movefirst
MsgBox "now"
n = 0
Do
n= n + 1
'If (n>1000) Then Exit Do
drs.AddNew
drs.Fields(0).Value = FormatDateTime(srs1.fields(1).value)
drs.Fields(1).Value = srs1.fields(2).value
drs.Fields(2).ValUe = srs2.fields(2).value
drs.Update
'End If
dRs.MoveNext
Loop While Not sRs1.EOF
dRs.Close
挑边
srs1.close
srs2.close
Else
End If
Set drs=Nothing
Set srs1=Nothing
Set srs2=Nothing
sconn.close
dc
onn.close
Set sconn=Nothing
Set dconn=Nothing
End If
MsgBox"export success!"
时间判断转换代码：
Function timeconv(begintime,endtime,choice)
'there is still some problems:checktime should return a boolen flag to show whether the number
'is in the range, then in function timeconv shoule check this flag to decide
'whether Exit funciton Or Not, this function needs to improve!
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'begin time returns the begintime you choose from combobox after some processing
'endtime is as upon
'choice is input choice of what process,0 is no processing and 1 is
'adjust to (GMT)Greenwich Mean Time
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\qim
Dim byear,bmonth,bday,bhour,bmin,bsec
Dim eyear,emonth,eday,ehour,emin,esec
Dim btime,etime,newbtime,newetime
Dim timeerr
Dim temph,tempd,stemph,stempd
Set byear = ScreenItems("byear")
Set bmonth = ScreenItems("bmonth")
Set bday = ScreenItems("bday")
Set bhour = ScreenItems("bhour")
Set bmin = ScreenItems("bmin")
Set bsec = ScreenItems("bsec")
Set eyear = ScreenItems("eyear")
Set emonth = ScreenItems("emonth")
Set eday = ScreenItems("eday")
Set ehour = ScreenItems("ehour")
Set emin = ScreenItems("emin")
Set esec = ScreenItems("esec")
'check whether entered begintime is legal or valid
If (Not ))Or (Not ))Or (Not ))Or _
(Not ))Or (Not ))Or (Not )) Then
MsgBox "some of you entered begintime is not numeric or null!",vbOKCancel,"wrong time"
timeconv=False
Exit Function
End If
'check whether time is outof range
Call ,9999,0,"begin year")
Call ,12,1,"begin month")
Call ,31,1,"begin day")
Call ,23,0,"begin hour")
Call ,59,0,"begin minutes")
Call ,59,0,"begin second")
'check whether entered endtime is legal or valid
If Not )Or Not )Or Not )Or Not _
)Or Not )Or Not ) Then
MsgBox "some of you entered endtime is not numeric or null!",vbOKCancel,"wrong time"
timeconv = False沈阳营销
Exit Function
End If
'check whether time is outof range
Call ,9999,0,"end year")
Call ,12,1,"end month")
Call ,31,1,"end day")
Call ,23,0,"end hour")
Call ,59,0,"end minutes")
Call ,59,0,"end second")
'check whether begin time is later than end time
btime= & "-" & &"-"& &" "& &":"& &":"&
+"-"++"-"++" "++":"++":"+
timeerr = DateDiff("s",btime,etime)
If timeerr<0 Then
MsgBox"y
ou entered wrong time range,begin time later than end time"
timeconv = False
Exit Function
End If
'check whether it is export time or show time,
'chioce=0--show Time,chioce=1---export Time
If choice = 0 Then
begintime = btime
endtime = etime
Else
'time convert to equalize with SQL server
>= 8 Then变压器油罐
temph=)-8
tempd=DateDiff("d",0,btime)
Else
temph=)+16
tempd=DateDiff("d",1,btime)
End If
stemph=CStr(temph)
stempd=CStr(CDate(tempd))
'new time after convert
newbtime=stempd+" "+stemph+":"++":"+
>= 8 Then
temph=)-8
tempd=DateDiff("d",0,etime)
Else
temph=)+16
tempd=DateDiff("d",1,etime)
End If
stemph=CStr(temph)
stempd=CStr(CDate(tempd))
'new time after convert
newetime=stempd+" "+stemph+":"++":"+
begintime =newbtime
endtime=newetime
End If 'end of chioce
timeconv = True
End Function
Sub checktime(input,upper,downer,note)
'check if time is outof ranges
If CInt(input)<downer Or CInt(input)>upper Then
MsgBox"you entered wrong range of " ¬e
Exit Sub
End If
End Sub
使用listview控件显示数据：
dim conn, rs, cmd, pstr,ssql
Dim opdlg,fm, ListView1,trend,item1
Dim m,n,b,s
dim begintime,endtime
b=timeconv(begintime,endtime,0)
'MsgBox CDate(begintime)
if b=false then
exit sub
else
set conn = createobject("tion")
set rs = createobject("dset")
set cmd = createobject("adodbmand")
Set opdlg = ScreenItems("dialog")
Set trend = ScreenItems("curve")
With opdlg
.Flags = 4
.Filter = "MDB文件(*.mdb)|*.mdb|AllFiles(*.*)|*.*|"
.FilterIndex = 2
.InitDir = "E:\vb code"
.Action = 1
End With
If opdlg.FileName = "" Then
MsgBox "you must choose a file"
雾都孤儿论文
Exit Sub
Else
fm = opdlg.FileName
End If
'MsgBox begintime
pstr = "Provider=Microsoft.Jet.OLEDB.4.0;"
pstr = pstr & "Data Source=" & fm
conn.cursorlocation=3
conn.open
ssql="select * from MyTable where cdate(time) between #"&begintime&"# And #"&endtime&"#"
rs.cursorlocation = 3
rs.open ssql,conn,1,2
m=unt
'MsgBox ssql
Set ListView1 = ScreenItems("listview")
ListView1.ColumnHeaders.Clear
ListView1.ColumnHeaders.Add , , CStr(Rs.Fields(0).Name), 100
ListView1.ColumnHeaders.Add , , CStr(Rs.Fields(1).Name), 70
ListView1.ColumnHeaders.Add , , CStr(Rs.Fields(2).Name), 70
If (m > 0) Then
MsgBox "here"
Rs.MoveFirst
n = 0
dcount
MsgBox s
Do While Not Rs.EOF
n = n + 1
s = Left(CStr(Rs.Fields(0).Value), 23)
Set Item1 = ListView1.ListItems.Add()
Item1.Text = Left(CStr(Rs.Fields(0).Value), 23)
Item1.SubItems(1) = FormatNumber(Rs.Fields(1).Value, 1)
Item1.SubItems(2) = FormatNumber(Rs.Fields(2).Value, 1)
trend.index = 0
trend.Datax=CDate(rs.fields(0).value)
trend.datay= rs.fields(1).value
trend.InsertData = True
trend.index = 1
trend.Datax=CDate(rs.fields(0).value)
trend.datay= rs.fields(2).value
trend.InsertData = True
If (n > 1000) Then Exit Do
Rs.MoveNext
Loop
Rs.Close
Else
End If
Set Rs = Nothing
conn.Close
Set conn = Nothing
end if 'end of b=true
使用wincc自带function trend控件显示曲线，使用复选框选择：
显示复选框与关闭
Sub X6309X94AE3X0000X79F0_OnLButtonDown(ByVal Item, ByVal Flags, ByVal x, ByVal y)
Dim checkbo
Set checkbo=ScreenItems("checkbox")
checkbo.Visible= Not checkbo.Visible
End Sub
复选框的输入输出域改变时VBS脚本，选择曲线
Sub Process_OnPropertyChanged(ByVal Item, ByVal value)
Dim curve, checkbo
Dim pp,i
Set curve= ScreenItems("curve")
Set checkbo=ScreenItems("checkbox")
pp=checkbo.Process
For i=0 To 1
curve.Index=i
If (pp Mod 2)=1 Then
curve.ItemVisible=True
Else
curve.ItemVisible=False
End If
pp=Fix(pp/2)
Next
End Sub
OK，all over！项目半路流产，所以也没有继续完善，以后有机会再说吧1
豫公网安备41160202000603
站长QQ:729038198
关于我们
投诉建议