實(shí)現(xiàn)的功能有：

1、盤(pán)后自動(dòng)下載指定品種分筆數(shù)據(jù)，再利用金字塔自動(dòng)收盤(pán)功能保存數(shù)據(jù)

2、歷史數(shù)據(jù)檢查：每日早上開(kāi)盤(pán)前以及收盤(pán)后，兩次自動(dòng)檢查最近5個(gè)交易日指定品種的1分鐘、5分鐘、日線數(shù)據(jù)是否齊全，并自動(dòng)發(fā)短信通知

3、盤(pán)中數(shù)據(jù)檢查：盤(pán)中每分鐘檢查一次下列信息：

3.1 當(dāng)日指定品種的1分鐘、5分鐘、日線數(shù)據(jù)是否齊全

3.2 金字塔的數(shù)據(jù)接收模塊是否啟動(dòng)

3.3 檢查交易賬戶(hù)是否成功連線

3.4 檢查指定的公式是否正在正常運(yùn)行（避免公式出現(xiàn)異常時(shí)不運(yùn)行了，導(dǎo)致未能開(kāi)、平倉(cāng)）

如果有任何異常自動(dòng)發(fā)短信通知

缺點(diǎn)：

1、如果遇到節(jié)日休市，程序并不知道，仍在做盤(pán)中檢查，所以節(jié)日仍然會(huì)收盤(pán)一次異常通知

2、采用金字塔的VBA，如果VBA也崩潰了，就有了另外一個(gè)問(wèn)題，誰(shuí)來(lái)監(jiān)測(cè)VBA是否正常運(yùn)行？目前的辦法是每日至少會(huì)收到幾個(gè)一切正常的短信通知，如果連這幾個(gè)都收不到了，則認(rèn)為斷網(wǎng)了、金字塔崩潰了、甚至電腦都崩潰了

本程序有一定局限性，只希望對(duì)金字塔開(kāi)發(fā)團(tuán)隊(duì)有一定啟發(fā)，在日后的版本中，用更好的手段將系統(tǒng)監(jiān)測(cè)作為一項(xiàng)內(nèi)置功能，實(shí)現(xiàn)金字塔的高安全性

實(shí)現(xiàn)步驟：

1、創(chuàng)建3個(gè)VBA宏：

SJBC、Chashuju、Chashuju2

2、VBA宏模塊增加以下代碼（覆蓋第一步所增加的宏代碼）：

todayhas=0
todayhas2=0
todaystop=0
errorcount=0

Sub SJBC()
 '16~17點(diǎn)開(kāi)始補(bǔ)分筆數(shù)據(jù)
 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","數(shù)據(jù)接收")
 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","自定義補(bǔ)數(shù)據(jù)")
    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","開(kāi)始補(bǔ)充")
    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點(diǎn)下載分筆數(shù)據(jù)
     elseif todayhas2=0 and cdate(time)>cdate("08:50:00") and cdate(time)<cdate("09:00:00") then
      todayhas2=1  '開(kāi)盤(pán)前歷史數(shù)據(jù)檢查
      todayhas=0
      todaystop=0
      errorcount=0
      call application.killtimer(0)
      call application.Settimer(0,300000)
      Chashuju '開(kāi)盤(pán)前做一次歷史數(shù)據(jù)檢查
     elseif todayhas2=1 and cdate(time)<cdate("08:50:00") then
      todayhas2=0
     end if
    elseif ID=1 then
     '16:10~17:10點(diǎn)關(guān)閉補(bǔ)數(shù)據(jù)窗口
     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","數(shù)據(jù)接收")
  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點(diǎn)重新加載公式(預(yù)計(jì)17點(diǎn)30分~45已經(jīng)完成收盤(pán)作業(yè))
     Set Grid = Frame1.GetGridByName("Window1")
  Grid.DeleteFormula "多策略整合"   '這里換成你自己的公式名稱(chēng)
  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 "多策略整合"  '這里換成你自己的公式名稱(chēng)
     Grid.ReInitFormula
     call application.killtimer(2)
    elseif ID=3 then
     '每分鐘一次盤(pán)中異常檢查
     call application.killtimer(3)
     Chashuju2
     interval = (90-Second(time))*1000
     call application.Settimer(3,interval) '逢30秒進(jìn)行盤(pán)中檢查，如09:15:30、09:16:30等
    end if
End Sub

Sub Chashuju()
 dim code(6)
 dim market(6)
 dim zhouqimin(2)
 strcon= ""

'以下是要檢查歷史數(shù)據(jù)的品種，大家替換為自己想監(jiān)測(cè)的品種，market數(shù)組保存的是品種對(duì)應(yīng)的市場(chǎng)代碼，如ZJ表示中金
 code(0)=Document.GetExtString("股指交易合約")  '交易的合約我在公式中保存到了全局變量中，大家可以用其他方式獲得，或者寫(xiě)死
 market(0)="ZJ"
 code(1)=Document.GetExtString("股指主力合約")  '主力合約我在公式中通過(guò)比較合約的交易量得出，并保存到全局變量中
 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天的數(shù)據(jù)（實(shí)際是最近5個(gè)交易日）
 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線數(shù)僅為" & aa & vbCrLf
      end if
     end if
    next
   end if
  next
 next
 if strcomp(strcon,"")<>0 then
  Set mail = CreateObject("WWSCommon.SmtpMail")
     with mail
          .SenderName = "數(shù)據(jù)檢查"
          .SenderAddress = "email@163.com"
          .Subject = "歷史數(shù)據(jù)缺失整通知" & 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 = "數(shù)據(jù)檢查"
          .SenderAddress = "email@163.com"
          .Subject = "歷史K線數(shù)據(jù)完整" & cdate(date+time)
      end with
      call mail.AddReceiver("139","13688888888@139.com")
      call mail.AddTextContent("歷史K線數(shù)據(jù)完整")
      call mail.Sender("smtp.163.com","email@163.com","123456")
      Set mail = nothing
 end if
End Sub

Sub Chashuju2()'盤(pán)中數(shù)據(jù)檢查
 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 '開(kāi)盤(pán)前8點(diǎn)59分先做一次賬戶(hù)檢查
  Set mail = CreateObject("WWSCommon.SmtpMail")
  strcon= ""
  if order.Account2(2,"你的ctp賬戶(hù)")<>1 then strcon = strcon & "交易帳號(hào)未登陸" & vbCrLf
  if application.ReceiveDataStatus = 0 then strcon = strcon & "金字塔數(shù)據(jù)接收未啟動(dòng)" & vbCrLf
     with mail
          .SenderName = "程序化監(jiān)督"
          .SenderAddress = "email@163.com"
          if strcomp(strcon,"")=0 then
           .Subject = "盤(pán)中檢測(cè)已準(zhǔn)備就緒" & cdate(date+time)
           strcon = "盤(pán)中檢測(cè)已準(zhǔn)備就緒"
          else
           .Subject = "盤(pán)中檢測(cè)異常" & 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'只在所交易的合約開(kāi)盤(pán)的時(shí)間內(nèi)做檢查，我交易合約是股指，所以定這個(gè)時(shí)間
 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賬戶(hù)")<>1 then strcon = strcon & "交易帳號(hào)未登陸" & vbCrLf
 if application.ReceiveDataStatus = 0 then strcon = strcon & "金字塔數(shù)據(jù)接收未啟動(dòng)" & 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) & " 當(dāng)天日線缺失" & 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'中午休市時(shí)不檢查
      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) & " 當(dāng)天" & zhouqimin(zhouqi) & "分鐘K線數(shù)目前為" & aa & ",應(yīng)為" & mins & vbCrLf
      elseif aa>Kn then
       strcon=strcon & code(pzindex) & " 當(dāng)天" & zhouqimin(zhouqi) & "分鐘K線數(shù)目前為" & aa & ",應(yīng)為" & 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'進(jìn)對(duì)已加載的公式檢查狀態(tài)，中午休市不檢查
   secs = DateDiff("s",cdate(newtime(i)),cdate(time))
   if secs>60 then '由于我的所有公式均是1分鐘調(diào)用一次VBA函數(shù)READSIG，所以公式最近一次運(yùn)行時(shí)間應(yīng)該在60秒內(nèi)，如果你的公式是5分鐘的，那么這個(gè)時(shí)間要加大
    strcon = strcon & "策略" & i & "已超過(guò)" & secs & "秒沒(méi)有執(zhí)行" & 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

'固定在上午和下午開(kāi)盤(pán)后的第一次檢查時(shí)發(fā)郵件通知，即使是一切正常時(shí)
   Set mail = CreateObject("WWSCommon.SmtpMail")
      with mail
           .SenderName = "程序化監(jiān)督"
           .SenderAddress = "email@163.com"
           .Subject = "公式已開(kāi)始運(yùn)行" & cdate(date+time)
       end with
       call mail.AddReceiver("139","13688888888@139.com")
       call mail.AddTextContent("公式已開(kāi)始運(yùn)行")
       call mail.Sender("smtp.163.com","email@163.com","123456")
       Set mail = nothing
  end if
 else
  errorcount=errorcount+1
  if errorcount=1 then'連續(xù)異常時(shí)，僅在第一次有異常時(shí)通知，這樣如果是節(jié)日休市，就不用理會(huì)；如果出現(xiàn)異常后，又恢復(fù)正常，再有異常也會(huì)通知
   Set mail = CreateObject("WWSCommon.SmtpMail")
      with mail
           .SenderName = "程序化監(jiān)督"
           .SenderAddress = "email@163.com"
           .Subject = "程序化盤(pán)中異常通知" & 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內(nèi)置的事件，整個(gè)金字塔中都只能有一個(gè)，如果你已經(jīng)用了這些事件，那么不要直接覆蓋，而是檢查下和你自己的代碼有沒(méi)有同名變量、Timer的ID沖突等，然后將事件內(nèi)的代碼增加進(jìn)去

3、VBA的Function模塊增加以下代碼：

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

Function READSIG(Formula,SIGNUM)
    '將數(shù)組信號(hào)發(fā)生時(shí)間轉(zhuǎn)換為K線位置，并記錄到單值全局變量系統(tǒng)中，供Perl公式讀取，每產(chǎn)生一次新K線時(shí)執(zhí)行一次
    READSIG = 1
。。。。。。。。。。。。。
 READSIG=0
 newtime(SIGNUM) = cdate(time)
End Function

注：READSIG是自定義函數(shù)，請(qǐng)從公式編寫(xiě)窗口先添加函數(shù)

4、公式增加以下代碼：

GLOBALVARIABLE:策略號(hào)=6;

if BARPOS=1 then
begin
  lastvbare:=round(READSIG(策略號(hào)));
end;

注：以上代碼可參考我的帖子“教你編寫(xiě)一個(gè)不卡的策略”，如果你已經(jīng)用了這些函數(shù)，可以把代碼添加進(jìn)去就行了

其中，策略號(hào)，每個(gè)公式一個(gè)號(hào)，不要重復(fù)，這樣VBA代碼中才可以用數(shù)組來(lái)檢查每個(gè)公式的最新運(yùn)行時(shí)間

5、Ctrl+D，勾選要收盤(pán)的市場(chǎng)，并至少勾選1分鐘、5分鐘和日線

6、工具、選項(xiàng)，設(shè)置自動(dòng)收盤(pán)時(shí)間為收市后150分鐘

7、數(shù)據(jù)接收》自定義補(bǔ)數(shù)據(jù)，在“常規(guī)”方案中，添加你要補(bǔ)數(shù)據(jù)的品種，注意只要補(bǔ)分筆就好了，不能有其他方案，只能有一個(gè)方案

8、用你的手機(jī)郵箱，設(shè)置規(guī)則，當(dāng)你的email@163.com發(fā)給你的13688888888@139.com時(shí)，發(fā)短信通知，我用的是彩信通知

注：Frame名稱(chēng)和window的名稱(chēng)改為你自己的框架和窗口，還有公式名稱(chēng)