-- 作者:klc
-- 发布时间:2013/7/10 16:27:55
-- 教你实现金字塔的自动监测(24小时无人照看)
实现的功能有:
1、盘后自动下载指定品种分笔数据,再利用金字塔自动收盘功能保存数据
2、历史数据检查:每日早上开盘前以及收盘后,两次自动检查最近5个交易日指定品种的1分钟、5分钟、日线数据是否齐全,并自动发短信通知
3、盘中数据检查:盘中每分钟检查一次下列信息:
3.1 当日指定品种的1分钟、5分钟、日线数据是否齐全
3.2 金字塔的数据接收模块是否启动
3.3 检查交易账户是否成功连线
3.4 检查指定的公式是否正在正常运行(避免公式出现异常时不运行了,导致未能开、平仓)
如果有任何异常自动发短信通知
缺点:
1、如果遇到节日休市,程序并不知道,仍在做盘中检查,所以节日仍然会收盘一次异常通知
2、采用金字塔的VBA,如果VBA也崩溃了,就有了另外一个问题,谁来监测VBA是否正常运行?目前的办法是每日至少会收到几个一切正常的短信通知,如果连这几个都收不到了,则认为断网了、金字塔崩溃了、甚至电脑都崩溃了
本程序有一定局限性,只希望对金字塔开发团队有一定启发,在日后的版本中,用更好的手段将系统监测作为一项内置功能,实现金字塔的高安全性
实现步骤:
1、创建3个VBA宏:
SJBC、Chashuju、Chashuju2
2、VBA宏模块增加以下代码(覆盖第一步所增加的宏代码):
todayhas=0 todayhas2=0 todaystop=0 errorcount=0
Sub SJBC() \'16~17点开始补分笔数据 if application.ReceiveDataStatus=0 then application.ReceiveData(1) Application.PeekAndPump application.SendMessage(33882) call application.Settimer(1,600000) call application.Settimer(2,9000000) Set Wrap = CreateObject("DynamicWrapper") Wrap.Register "user32.dll","FindWindowA","i=ss","f=s", "r=l" Wrap.Register "user32.dll","FindWindowExA","i=llss","f=s", "r=l" Wrap.Register "user32.dll","SendMessageA","i=lull","f=s", "r=l" h = Wrap.FindWindowA("#32770","数据接收") tab=Wrap.FindWindowExA(h,0,"SysTabControl32","") TCM_SETCURFOCUS=4912 WM_SETFOCUS=7 WM_KEYDOWN=256 WM_KEYUP=257 BM_CLICK=245 Wrap.SendMessageA tab,TCM_SETCURFOCUS,2,0 h1=Wrap.FindWindowExA(h,0,"#32770","自定义补数据") cb=Wrap.FindWindowExA(h1,0,"ComboBox","") Wrap.SendMessageA cb,WM_SETFOCUS,0,0 Wrap.SendMessageA cb,WM_KEYDOWN,VK_DOWN,0 Wrap.SendMessageA cb,WM_KEYUP,VK_DOWN,0 bt=0 bt=Wrap.FindWindowExA(h1,0,"Button","开始补充") Wrap.SendMessageA bt,BM_CLICK,0,0 if bt<>0 then todayhas=1 End Sub
Sub APPLICATION_VBAStart() todayhas=0 todayhas2=0 todaystop=0 errorcount=0 if cdate(time)>cdate("09:00:00") and cdate(time)<cdate("16:00:00") then call application.Settimer(0,300000) else call application.Settimer(0,20000) end if call application.Settimer(3,60000) \'application.MsgOut marketdata.GetMarketInfo2("zj").TradeSeconds / 60 End Sub
Sub APPLICATION_VBAEnd() call application.killtimer(0) call application.killtimer(2) call application.killtimer(3) for i = 0 to SigCount-1 Set dates(i) = nothing Set times(i) = nothing Set values(i) = nothing next SigCount=0 End Sub
Sub APPLICATION_Timer(ID) if ID=0 then if todayhas=0 and cdate(time)>cdate("16:00:00") and cdate(time)<cdate("17:00:00") then call application.killtimer(0) call application.Settimer(0,20000) SJBC \'16~17点下载分笔数据 elseif todayhas2=0 and cdate(time)>cdate("08:50:00") and cdate(time)<cdate("09:00:00") then todayhas2=1 \'开盘前历史数据检查 todayhas=0 todaystop=0 errorcount=0 call application.killtimer(0) call application.Settimer(0,300000) Chashuju \'开盘前做一次历史数据检查 elseif todayhas2=1 and cdate(time)<cdate("08:50:00") then todayhas2=0 end if elseif ID=1 then \'16:10~17:10点关闭补数据窗口 Set Wrap = CreateObject("DynamicWrapper") Wrap.Register "user32.dll","FindWindowA","i=ss","f=s", "r=l" Wrap.Register "user32.dll","SendMessageA","i=lull","f=s", "r=l" WM_CLOSE=16 h = Wrap.FindWindowA("#32770","数据接收") Wrap.SendMessageA h,WM_CLOSE,0,0 \'for i = 0 to SigCount-1 \' Set dates(i) = nothing \' Set times(i) = nothing \' Set values(i) = nothing \'next call application.killtimer(1) elseif ID=2 then \'18:30~19:30点重新加载公式(预计17点30分~45已经完成收盘作业) Set Grid = Frame1.GetGridByName("Window1") Grid.DeleteFormula "多策略整合" \'这里换成你自己的公式名称 for i = 0 to SigCount-1 Set dates(i) = nothing Set times(i) = nothing Set values(i) = nothing states(i) = 0 next SigCount=0 Grid.InsertFormula "多策略整合" \'这里换成你自己的公式名称 Grid.ReInitFormula call application.killtimer(2) elseif ID=3 then \'每分钟一次盘中异常检查 call application.killtimer(3) Chashuju2 interval = (90-Second(time))*1000 call application.Settimer(3,interval) \'逢30秒进行盘中检查,如09:15:30、09:16:30等 end if End Sub
Sub Chashuju() dim code(6) dim market(6) dim zhouqimin(2) strcon= ""
\'以下是要检查历史数据的品种,大家替换为自己想监测的品种,market数组保存的是品种对应的市场代码,如ZJ表示中金 code(0)=Document.GetExtString("股指交易合约") \'交易的合约我在公式中保存到了全局变量中,大家可以用其他方式获得,或者写死 market(0)="ZJ" code(1)=Document.GetExtString("股指主力合约") \'主力合约我在公式中通过比较合约的交易量得出,并保存到全局变量中 market(1)="ZJ" code(2)="000001" market(2)="SH" code(3)="1Z2016" market(3)="SH" code(4)="1Z2056" market(4)="SH" code(5)="000300" market(5)="SH"
today=Date() if cdate(time)<cdate("16:00:00") then today=today-1 firstday=today-6 \'检查最近7天的数据(实际是最近5个交易日) zhouqimin(0)=1 zhouqimin(1)=5 for pzindex=0 To 5 step 1 for X=firstday TO today step 1 if Weekday(X)>1 and Weekday(X)<7 then for zhouqi = 0 to 5 step 1 if zhouqi<2 or zhouqi>4 then set History = marketdata.GetHistoryData(code(pzindex),market(pzindex),zhouqi) Xa=X set mkt = marketdata.GetMarketInfo2(market(pzindex)) if zhouqi<2 then Xa=cdate(X+mkt.opentime-cdate("1975-1-1")+cdate("00:0" & zhouqimin(zhouqi) & ":00")) a=History.GetPosFromDate(Xa) aaa=History.GetPosFromDate(cdate(X+mkt.closetime-cdate("1975-1-1"))) if zhouqi=5 then if History.Date(aaa)<>cdate(X) then strcon=strcon & code(pzindex) & " " & X & " 缺少日线" & vbCrLf else if History.Date(a)<cdate(X) then aa=aaa-a else aa=aaa-a+1 Knum = mkt.TradeSeconds / 60 / zhouqimin(zhouqi) if aa<>Knum then strcon=strcon & code(pzindex) & " " & X & " " & zhouqimin(zhouqi) & "分钟K线数仅为" & aa & vbCrLf end if end if next end if next next if strcomp(strcon,"")<>0 then Set mail = CreateObject("WWSCommon.SmtpMail") with mail .SenderName = "数据检查" .SenderAddress = "email@163.com" .Subject = "历史数据缺失整通知" & cdate(date+time) end with call mail.AddReceiver("139","13688888888@139.com") call mail.AddTextContent(strcon) call mail.Sender("smtp.163.com","email@163.com","123456") Set mail = nothing else Set mail = CreateObject("WWSCommon.SmtpMail") with mail .SenderName = "数据检查" .SenderAddress = "email@163.com" .Subject = "历史K线数据完整" & cdate(date+time) end with call mail.AddReceiver("139","13688888888@139.com") call mail.AddTextContent("历史K线数据完整") call mail.Sender("smtp.163.com","email@163.com","123456") Set mail = nothing end if End Sub
Sub Chashuju2()\'盘中数据检查 today=Date() if Weekday(today)=1 or Weekday(today)=7 or todaystop=1 then Exit Sub\'星期6和7不检查 if cdate(time)>=cdate("08:59:00") and cdate(time)<=cdate("09:00:00") then \'开盘前8点59分先做一次账户检查 Set mail = CreateObject("WWSCommon.SmtpMail") strcon= "" if order.Account2(2,"你的ctp账户")<>1 then strcon = strcon & "交易帐号未登陆" & vbCrLf if application.ReceiveDataStatus = 0 then strcon = strcon & "金字塔数据接收未启动" & vbCrLf with mail .SenderName = "程序化监督" .SenderAddress = "email@163.com" if strcomp(strcon,"")=0 then .Subject = "盘中检测已准备就绪" & cdate(date+time) strcon = "盘中检测已准备就绪" else .Subject = "盘中检测异常" & cdate(date+time) end if end with call mail.AddReceiver("139","13688888888@139.com") call mail.AddTextContent(strcon) call mail.Sender("smtp.163.com","email@163.com","123456") Set mail = nothing end if if cdate(time)<cdate("09:15:00") or cdate(time)>cdate("15:15:00") then exit Sub\'只在所交易的合约开盘的时间内做检查,我交易合约是股指,所以定这个时间 dim code(6) dim market(6) dim zhouqimin(2) strcon= "" if application.ReceiveDataStatus = 0 then application.ReceiveData(1) Application.PeekAndPump if order.Account2(2,"你的ctp账户")<>1 then strcon = strcon & "交易帐号未登陆" & vbCrLf if application.ReceiveDataStatus = 0 then strcon = strcon & "金字塔数据接收未启动" & vbCrLf code(0)=Document.GetExtString("股指交易合约") market(0)="ZJ" code(1)=Document.GetExtString("股指主力合约") market(1)="ZJ" code(2)="000001" market(2)="SH" code(3)="1Z2016" market(3)="SH" code(4)="1Z2056" market(4)="SH" code(5)="000300" market(5)="SH" zhouqimin(0)=1 zhouqimin(1)=5 for pzindex=0 To 5 step 1 for zhouqi = 0 to 5 step 1 if zhouqi<2 or zhouqi>4 then set History = marketdata.GetHistoryData(code(pzindex),market(pzindex),zhouqi) Xa=today set mkt = marketdata.GetMarketInfo2(market(pzindex)) if zhouqi<2 then Xa=cdate(today+mkt.opentime-cdate("1975-1-1")+cdate("00:0" & zhouqimin(zhouqi) & ":00")) a=History.GetPosFromDate(Xa) aaa=History.GetPosFromDate(cdate(today+mkt.closetime-cdate("1975-1-1"))) copentime=cdate(mkt.opentime-cdate("1975-1-1")) if zhouqi<2 then Kn = mkt.TradeSeconds / 60 / zhouqimin(zhouqi) if zhouqi=5 then if cdate(time)>cdate(copentime) and History.Date(aaa)<>cdate(today) then strcon=strcon & code(pzindex) & " 当天日线缺失" & vbCrLf else if History.Date(a)<cdate(today) then aa=aaa-a else aa=aaa-a+1 mins = DateDiff("n",cdate(copentime),cdate(time)) if mins>-1 and (cdate(time)<cdate("11:30:00") or cdate(time)>cdate("13:00:00")) then\'中午休市时不检查 if cdate(time)<cdate("11:30:00") then mins = mins \\ zhouqimin(zhouqi)+1 elseif cdate(time)>cdate("13:00:00") then mins = mins \\ zhouqimin(zhouqi)+1-90 \\ zhouqimin(zhouqi) end if if mins<>aa and aa<Kn then strcon=strcon & code(pzindex) & " 当天" & zhouqimin(zhouqi) & "分钟K线数目前为" & aa & ",应为" & mins & vbCrLf elseif aa>Kn then strcon=strcon & code(pzindex) & " 当天" & zhouqimin(zhouqi) & "分钟K线数目前为" & aa & ",应为" & Kn & vbCrLf end if end if end if end if next next secs = 100 for i=0 to SigCount-1 step 1 if states(i)=1 and (cdate(time)<cdate("11:30:00") or cdate(time)>cdate("13:00:00")) then\'进对已加载的公式检查状态,中午休市不检查 secs = DateDiff("s",cdate(newtime(i)),cdate(time)) if secs>60 then \'由于我的所有公式均是1分钟调用一次VBA函数READSIG,所以公式最近一次运行时间应该在60秒内,如果你的公式是5分钟的,那么这个时间要加大 strcon = strcon & "策略" & i & "已超过" & secs & "秒没有执行" & vbCrLf end if end if next if strcomp(strcon,"")=0 then errorcount=0 if (cdate(time)<cdate("09:16:05") or (cdate(time)>cdate("13:00:00") and cdate(time)<cdate("13:01:05"))) and secs<60 then
\'固定在上午和下午开盘后的第一次检查时发邮件通知,即使是一切正常时 Set mail = CreateObject("WWSCommon.SmtpMail") with mail .SenderName = "程序化监督" .SenderAddress = "email@163.com" .Subject = "公式已开始运行" & cdate(date+time) end with call mail.AddReceiver("139","13688888888@139.com") call mail.AddTextContent("公式已开始运行") call mail.Sender("smtp.163.com","email@163.com","123456") Set mail = nothing end if else errorcount=errorcount+1 if errorcount=1 then\'连续异常时,仅在第一次有异常时通知,这样如果是节日休市,就不用理会;如果出现异常后,又恢复正常,再有异常也会通知 Set mail = CreateObject("WWSCommon.SmtpMail") with mail .SenderName = "程序化监督" .SenderAddress = "email@163.com" .Subject = "程序化盘中异常通知" & cdate(date+time) end with call mail.AddReceiver("139","13688888888@139.com") call mail.AddTextContent(strcon) call mail.Sender("smtp.163.com","email@163.com","123456") Set mail = nothing end if end if End Sub
注意:其中的APPLICATION_VBAStart、APPLICATION_VBAEnd、APPLICATION_Timer是VBA内置的事件,整个金字塔中都只能有一个,如果你已经用了这些事件,那么不要直接覆盖,而是检查下和你自己的代码有没有同名变量、Timer的ID冲突等,然后将事件内的代码增加进去
|