-- 作者:wgpsc
-- 发布时间:2012/4/16 14:06:25
--
数据库用的是Firebird
下为全部代码:
public conn,SQL,rs,oHistoryData,cIF,lUpdate,ifoldvol,sholdvol,szoldvol lUpdate=False \'在ReportNotify()中是否更新数据库 ifoldvol=0 sholdvol=0 szoldvol=0 set conn = CreateObject("ADODB.connection") conn.C set rs = createObject("ADODB.recordSet") conn.open \'本来设置的是需要才打开,但出了问题后就放在这里打开,然后在窗体的UNLOAD中关闭,不过问题依旧
sub Application_VBAStart() Call Application.SetTimer(1,0) TransData.show end sub
Sub MARKETDATA_ReportNotify(RD) if not lUpdate then exit sub select case rd.label case cIF if rd.volume=ifoldvol then exit sub SQL ="insert into ZJIF00B1(timemark,p,vol) values (cast(\'"&rd.date&"\' as timestamp),"&rd.newprice&","&(rd.volume-ifoldvol)&")" conn.execute(sql) ifoldvol=rd.volume case "399001" if rd.volume=szoldvol then exit sub SQL ="insert into SZ399001B1(timemark,p,vol) values (cast(\'"&rd.date&"\' as timestamp),"&rd.newprice&","&(rd.volume-ifoldvol)&")" conn.execute(sql) szoldvol=rd.volume case "000001" if rd.volume=sholdvol then exit sub SQL ="insert into SH000001B1(timemark,p,vol) values (cast(\'"&rd.date&"\' as timestamp),"&rd.newprice&","&(rd.volume-ifoldvol)&")" conn.execute(sql) sholdvol=rd.volume END SELECT end sub
Private Sub TransData_cmdStart_click() if TransData_cmdStart.caption="Start Transfer" then Call Application.SetTimer(1,0) TransData_cmdStart.caption="End Transfer" \'conn.open \'更新主力合约 call getIf(cIF) SQL ="update maincontract set stockcode=\'"&cIF&"\' where market=\'ZJ\'" conn.execute(SQL) \'首先补数据 call Transfer() \'二次补数据,因为第一次耗时多,造成部分实时数据又未补上 call Transfer()
\'注册行情,开始自动写数据 call marketdata.RegReportNotify(cIF,"ZJ") call marketdata.RegReportNotify("399001","SZ") call marketdata.RegReportNotify("000001","SH") lUpdate=True \'设置触发器 Call Application.SetTimer(1,8000)
else \'取消品种注册 call marketdata.unRegReportNotify(cIF,"ZJ") call marketdata.unRegReportNotify("399001","SZ") call marketdata.unRegReportNotify("000001","SH") lUpdate=False \'取消触发器 Call Application.SetTimer(1,0) \'conn.close TransData_cmdStart.caption="Start Transfer" end if end sub
Private sub Transfer() \'获得数据库已更新时间 \'更新M1 call updatedata_m1("SZ","399001") call updatedata_m1("SH","000001") call updatedata_m1("ZJ",cIF) \'更新笔 if time()>#09:30:00# then call updatedata_B1("SZ","399001") call updatedata_B1("SH","000001") end if if time()>#09:15:00# then call updatedata_B1("ZJ",cIF) end if end sub
Private sub updatedata_m1(cmarket,cstockcode) dim lasttime,table,ggi,gi ggi=0 table=cmarket&cstockcode&"M1" if cmarket="ZJ" then table="ZJIF00M1" call getdatatime(table,lasttime) set oHistoryData = marketdata.GethistoryData(cstockcode,cmarket,0) if not isnull(lasttime) then for gi=1 to oHistoryData.count-1 if oHistoryData.date(gi)>=lasttime then ggi=gi exit for end if next if ggi=0 then exit sub if oHistoryData.date(ggi)<dateadd("s",40,lasttime) then SQL ="update "&table&" set o="&oHistoryData.open(ggi)&",h="&oHistoryData.high(ggi)&",l="&oHistoryData.low(ggi)&",c="&oHistoryData.close(ggi)&",vol="&oHistoryData.volume(ggi)&" where timemark=cast(\'"&oHistoryData.date(ggi)&"\' as timestamp)" conn.execute(SQL) ggi=ggi+1 end if end if if ggi<oHistorydata.count-1 then for gi=ggi to oHistoryData.count-1 SQL ="insert into "&table&"(timemark,o,h,l,c,vol) values (cast(\'"&oHistoryData.date(gi)&"\' as timestamp),"&oHistoryData.open(gi)&","&oHistoryData.high(gi)&","&oHistoryData.low(gi)&","&oHistoryData.close(gi)&","&oHistoryData.volume(gi)&")" conn.execute(sql) next end if end sub
Private sub miniupdatedata_m1(cmarket,cstockcode) dim lasttime,table,gi,ggi,stockcode ggi=0 table=cmarket&cstockcode&"M1" stockcode=cstockcode \'从newtime表中查最新数据 if cmarket="ZJ" then stockcode="IF00" table="ZJIF00M1" end if SQL="SELECT timemark as tlast FROM newtime where stockcode=\'"&stockcode&"\' and cyc=\'M1\'" rs.open SQL,conn,0,1 lasttime=rs.Fields("tlast") rs.close set oHistoryData = marketdata.GethistoryData(cstockcode,cmarket,0) for gi=oHistoryData.count-1 to 0 step -1 \'oHistoryData.date(gi)是否会有条记录与lasttime完全一致? if oHistoryData.date(gi)<=lasttime then ggi=gi exit for end if next for gi=ggi to oHistoryData.count-1 if oHistoryData.date(gi)<dateadd("s",40,lasttime) then SQL ="update "&table&" set o="&oHistoryData.open(gi)&",h="&oHistoryData.high(gi)&",l="&oHistoryData.low(gi)&",c="&oHistoryData.close(gi)&",vol="&oHistoryData.volume(gi)&" where timemark=cast(\'"&oHistoryData.date(gi)&"\' as timestamp)" else SQL ="insert into "&table&"(timemark,o,h,l,c,vol) values (cast(\'"&oHistoryData.date(gi)&"\' as timestamp),"&oHistoryData.open(gi)&","&oHistoryData.high(gi)&","&oHistoryData.low(gi)&","&oHistoryData.close(gi)&","&oHistoryData.volume(gi)&")" end if conn.execute(SQL) next end sub
Private sub updatedata_B1(cmarket,cstockcode) dim lasttime,table,ggi,gi ggi=0 table=cmarket&cstockcode&"B1" if cmarket="ZJ" then table="ZJIF00B1" call getdatatime(table,lasttime) set oHistoryData= marketdata.GetMinuteData(cstockcode,cmarket) if not isnull(lasttime) then for gi=oHistoryData.count-1 to 1 step -1 if oHistoryData.date(gi)<=lasttime then ggi=gi exit for end if next end if if ggi<oHistorydata.count-1 then if ggi=0 then SQL ="insert into "&table&"(timemark,p,vol) values (cast(\'"&oHistoryData.date(0)&"\' as timestamp),"&oHistoryData.newprice(0)&","&oHistoryData.volume(0)&")" conn.execute(sql) ggi=ggi+1 end if for gi=ggi to oHistoryData.count-1 SQL ="insert into "&table&"(timemark,p,vol) values (cast(\'"&oHistoryData.date(gi)&"\' as timestamp),"&oHistoryData.newprice(gi)&","&(oHistoryData.volume(gi)-oHistoryData.volume(gi-1))&")" conn.execute(sql) next end if select case cmarket case "SH" sholdvol=oHistoryData.volume(oHistoryData.count-1) case "SZ" szoldvol=oHistoryData.volume(oHistoryData.count-1) case "ZJ" ifoldvol=oHistoryData.volume(oHistoryData.count-1) END SELECT end sub
private sub TransData_load() call marketdata.unRegReportNotify(cIF,"ZJ") call marketdata.unRegReportNotify("000001","SH") call marketdata.unRegReportNotify("399001","SZ") lUpdate=False \'取消触发器 Call Application.SetTimer(1,0)
end sub
private sub TransData_unload() call marketdata.unRegReportNotify(cIF,"ZJ") call marketdata.unRegReportNotify("000001","SH") call marketdata.unRegReportNotify("399001","SZ") lUpdate=False \'取消触发器 Call Application.SetTimer(1,0) \'if TransData_cmdStart.caption="End Transfer" then conn.close \'end if set conn=nothing set rs=nothing end sub
Sub GetIF(byref MainIF) \'得到期指主力合约 Dim MaxVolume,count,i,report1 MaxVolume=0 \'得到市场所有品种 Count = MarketData.GetReportCount("ZJ") For i = 0 To Count-1 Set Report1 = MarketData.GetReportDataByIndex("ZJ",i) if Left(Report1.Label,2) = "IF" Then \'只处理有效合约 if Right(Report1.Label,2) >= "01" And Right(Report1.Label,2) <= "12" Then If Report1.Volume > MaxVolume Then MainIF = Report1.Label MaxVolume = Report1.Volume End if end if End if Next End Sub
sub getdatatime(ctmptable,ByRef tlasttime) SQL="SELECT MAX(timemark) as tlast FROM "&ctmptable rs.open SQL,conn,0,1 tlasttime=rs.Fields("tlast") rs.close end sub
Sub APPLICATION_Timer(ID) if ID=1 then if time()<#09:14:59# or (time()>#11:30:59# and time()<#12:59:59#) or time()>#15:15:59# or weekday(date())=1 or weekday(date())=7 then \'非交易时间 exit sub end if call miniupdatedata_m1("SZ","399001") call miniupdatedata_m1("ZJ",cIF) call miniupdatedata_m1("SH","000001") end if End Sub
|