主题：教你实现金字塔的自动监测(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冲突等，然后将事件内的代码增加进去

 

3、VBA的Function模块增加以下代码：

 

dim dates()
dim times()
dim values()
dim SigCounts()
dim newtime()
dim states()
SigCount = 0

 

Function READSIG(Formula,SIGNUM)
    '将数组信号发生时间转换为K线位置，并记录到单值全局变量系统中，供Perl公式读取，每产生一次新K线时执行一次
    READSIG = 1
。。。。。。。。。。。。。
 READSIG=0
 newtime(SIGNUM) = cdate(time)
End Function

 

注：READSIG是自定义函数，请从公式编写窗口先添加函数

 

4、公式增加以下代码：

GLOBALVARIABLE:策略号=6;

if BARPOS=1 then
begin
  lastvbare:=round(READSIG(策略号));
end;

 

注：以上代码可参考我的帖子“教你编写一个不卡的策略”，如果你已经用了这些函数，可以把代码添加进去就行了

其中，策略号，每个公式一个号，不要重复，这样VBA代码中才可以用数组来检查每个公式的最新运行时间

5、Ctrl+D，勾选要收盘的市场，并至少勾选1分钟、5分钟和日线

6、工具、选项，设置自动收盘时间为收市后150分钟

7、数据接收》自定义补数据，在“常规”方案中，添加你要补数据的品种，注意只要补分笔就好了，不能有其他方案，只能有一个方案

8、用你的手机邮箱，设置规则，当你的email@163.com发给你的13688888888@139.com时，发短信通知，我用的是彩信通知

 

注：Frame名称和window的名称改为你自己的框架和窗口，还有公式名称

楼上的，没办法，碰到问题就得研究解决的方法。

 

另外漏了一个

9、选项》升级与时间，要启用时间同步，我是每天同步一次，本地时间和交易所时间基本上没有差别

你遇到什么问题了？建议你把代码阅读一遍，应该可以看出哪里需要做你个性化的修改的

改了一点点代码，如下：

Sub Chashuju2()
 today=Date()
 if Weekday(today)=1 or Weekday(today)=7 or  todaystop=1 then Exit Sub
 if cdate(time)>=cdate("08:59:00") and cdate(time)<=cdate("09:00:00") then
  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 = "发送邮箱@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","发送邮箱@163.com","163邮箱密码")
      Set mail = nothing
 end if
 if cdate(time)<cdate("09:15:00") or cdate(time)>cdate("15:15:00") then exit Sub
 dim code(7)
 dim market(7)
 dim zhouqimin(2)
 strcon= ""
 if application.ReceiveDataStatus = 0 then application.ReceiveData(1)
 Application.PeekAndPump
 if order.Account2(2,"1848332")<>1 then strcon = strcon & "交易帐号未登陆" & vbCrLf
 if application.ReceiveDataStatus = 0 then strcon = strcon & "金字塔数据接收未启动" & vbCrLf
 code(0)=Document.GetExtString("股指交易合约1")
 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"
 code(6)=Document.GetExtString("股指交易合约2")
 market(6)="ZJ"
 zhouqimin(0)=1
 zhouqimin(1)=5
 for pzindex=0 To 6 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 cdate(time)>cdate("09:31:00") and secs>60 then '由于我的所有公式均是1分钟调用一次VBA函数READSIG，所以公式最近一次运行时间应该在60秒内
    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<120 then
   Set mail = CreateObject("WWSCommon.SmtpMail")
      with mail
           .SenderName = "程序化监督"
           .SenderAddress = "lectureke@163.com"
           .Subject = "公式已开始运行" & cdate(date+time)
           '.Mailer = strcon
       end with
       call mail.AddReceiver("139","13697463533@139.com")
       call mail.AddTextContent("公式已开始运行")
       'call mail.AppOctStrmContent("D:\mxrb\"&Date&".xls")
       call mail.Sender("smtp.163.com","lectureke@163.com","xiaobai")
       Set mail = nothing
  end if
 else
  errorcount=errorcount+1
  if errorcount=1 or errorcount=5 then
   Set mail = CreateObject("WWSCommon.SmtpMail")
      with mail
           .SenderName = "程序化监督"
           .SenderAddress = "发送邮箱@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","发送邮箱@163.com","163密码")
       Set mail = nothing
      end if
    end if
End Sub

 

红色部分，第一个地方是修正股指期货第一笔数据（集合竞价）9:14到下一根K线开始9:16相距是两分钟，所以我在这段时间是允许程序两分钟时间不运行的；

第二个地方，or errorcount=5表示，如果数据第一次查到有欠缺了，errorcount为1时会发一个短信通知，如果连续5分钟都有欠缺，那么errorcount将等于5，会再发一个异常通知短信。所以，如果是只收到一个异常通知，而5分钟时未收到第二个异常通知，表示可能金字塔只是短暂网络异常导致数据欠缺，没有发生连续的数据欠缺。如果5分钟间隔收到两次通知，那么表示情况严重，数据接收可能已经完全有问题了。

如果一天之中，什么短信都收不到（实际上9点前就应该收到两个短信的，一个说历史数据完整，一个说监控准备就绪），表示可能：
1、你的邮箱出故障了，收不了信或发不了短信
2、金字塔完全瘫痪，连vba都运行不了了

 

下午开盘，应该也要收到一个短信，否则也表示可能出现上面两个问题之一了

 

如果盘中其他时间都没收到短信，那么恭喜，一切正常

 

如果盘中收到一次异常提醒，但没有在5分钟后收到第二个，那么只是短暂的问题，无需担心

 

如果收到一次一次提醒，5分钟后又收到第二次提醒，那么请马上找台电脑，远程控制，看看金字塔出了什么问题

改了下盘中监测，新代码如下，修改或新增的代码用了红色字体：

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"

 Holding = Document.GetExtData("IFHOLDING")
 dim BuyHoding
 dim BuyTodayHoding
 dim SellHoding
 dim SellTodayHoding
 dim BuyCost
 dim SellCost
 dim PNL
 Dim UseMargin
 Result = Order.HoldingInfoByCode2(code(0),market(0),BuyHoding,BuyCost,BuyTodayHoding,SellHoding,SellCost,SellTodayHoding,PNL,UseMargin,"你的ctp登陆资金账号")
 If Result = 1 Then
  if Round(BuyHoding-SellHoding)<>Round(Holding) then
   strcon = strcon & code(0) & "持仓不同步，实际持仓" & Round(BuyHoding-SellHoding) & "手，应为" & Holding & "手" & vbCrLf
  end if
 End If

 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 cdate(time)>cdate("09:31:00") and 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<120 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<3 or errorcount=5 then'连续异常时，会有第1、第2、第5次通知；如果出现异常后，又恢复正常，异常通知次数会重新计算
   Set mail = CreateObject("WWSCommon.SmtpMail")
      with mail
           .SenderName = "程序化监督"
           .SenderAddress = "email@163.com"
           .Subject = "盘中异常通知第" & errorcount & "次 " & 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

1、增加了持仓同步检查，如果持仓不同步，会发异常通知，每分钟检查一次（需要先在公式中将holding的值用extdbdataset保存为IFHOLDING，如果你交易多个品种，需要保存为不同的变量名称，并在代码中对每一个交易的合约进行持仓检查）

2、修复了早盘第一根K线正常执行时，由于距离竞价开盘超过60秒而认为是异常的问题

3、异常通知只通知一次的规则改为：当第一次监测到异常时，发出“第一次通知”，如果连续出现异常，再发出第2、第5次通知，之后就不会再通知。如果5分钟内收到3次通知（或者连续2分钟收到两次异常通知），就说明程序出现问题且恢复不了了。如果只收到“第1次通知”且无第二次通知，说明短暂的异常随后消失了。

对于担心由于断网、断电、死机等情况，而造成即使出现了问题也无法发出通知的情况，我用双机监测的办法得到了完美的解决：

1、在两个不同的地点，同时运行金字塔、你的策略、和我的监测代码，主机备用机同时登陆你的交易资金账号（但需要用不同的账号登陆金字塔，或者备用机用免费账号登陆）；

2、主机开启金字塔的图表程序化交易，以及持仓同步，备用机不开启以上两项功能（就是备用机不交易，只检查）

3、备用机的监控代码中，发出的邮件标题加上“（备用）”两个字以示区别

 

两台机同时断网断电死机的情况几乎不存在，这样你就可以放心的无人照看了！

VBA其实不难的，那我只介绍下怎么添加“自定义函数”和创建“宏”：

1、新建“自定义函数”：

在公式编辑界面，自定义函数中点击鼠标右键：

此主题相关图片如下：1.gif

输入函数名和参数，例如创建“Function READSIG(Formula,SIGNUM)”这个函数，那么输入：

此主题相关图片如下：2.gif

如果除了Formula外，有1个以上的参数，参数间用逗号隔开。

 

在Perl公式中，调用自定义函数时，并不需要是输入参数Formula，而是当“READSIG(SIGNUM)”来调用；

例如我的函数READSIG是用于读取历史信号的，1分钟调用一次（见另外一个帖子，编写不卡策略那个），在这里，这个函数用于记录公式的最新运行时间的，所以可以放在公式的任何地方，只要保证一分钟至少调用一次就可以了。SigNum是公式序号，是一个数字，如果我有5个公式在运行，那在公式中就分别用1、2、3、4、5来替换这个参数，例如：

READSIG(1);