''''''''''''''''''''''''''''''''''''
'项目名称:白盘自定义合约
'功能:自定义品种套利
'开始时间:2015年12月9日
'''''''''''''''''''''''''''''''''''
private nInstDefineID,nInstDefineTime
private dNewInsts,dNewInstsMarket,dOldInstsMarket,vOldInst,vNewInst
Sub Application_VBAStart()
nInstDefineID=3 '自定义合约定时器ID
nInstDefineTime=1 '自定义合约定时器刷新时间
nCycle = 1 '周期类型，0 1分钟 1 5分钟 2 15分钟 3 30分钟 4 60分钟 5日线 6周线 7月线 8年线 9多日线 10分笔成交 11多小时线 12多秒线 13多分钟线 14季度线 15半年线 16节气线 17 3分钟 18 10分钟 19 多笔线
'定义新合约
Set dNewInsts = CreateObject("Scripting.Dictionary")
Set dNewInstsMarket = CreateObject("Scripting.Dictionary")
Set dOldInstsMarket = CreateObject("Scripting.Dictionary")
'dNewInsts.add "IF00","IF15"
'dNewInstsMarket.add "IF15","ZJ"
'dOldInstsMarket.add "IF00","ZJ"
dNewInsts.add "RB00","RB15"
dNewInstsMarket.add "RB15","SQ"
dOldInstsMarket.add "RB00","SQ"
vOldInsts=dNewInsts.keys
vNewInsts=dNewInsts.Items
'设置历史数据共享内存模式。0：共享。1：独享
'marketdata.HistoryDataMode=1
For j=0 To dNewInsts.Count-1
sOldInst = vOldInsts(j)
sNewInst = vNewInsts(j)
sOldInstMarket = dOldInstsMarket.Item(sOldInst)
sNewInstMarket = dNewInstsMarket.Item(sNewInst)
'查看对应的新合约是否存在，如果不存在，则新创建合约
If marketdata.IsExistStock(sNewInst,sNewInstMarket)=0 Then
call marketdata.AddStock(sNewInst,sNewInstMarket, sNewInst)
End If
Set HistoryNew = marketdata.GetHistoryData(sNewInst,sNewInstMarket,nCycle)
'清空新的合约数据
For i=0 to HistoryNew.Count-1
HistoryNew.RemoveAt(i)
Next
Call HistoryNew.SaveData(sNewInst,sNewInstMarket,2)
application.MsgOut "--------" & HistoryNew.count
'循环老合约数据，发现是白盘的数据，则插入到新合约中
Set HistoryOld = marketdata.GetHistoryData(sOldInst,sOldInstMarket,nCycle)
nBegin = 0
If HistoryOld.Count-300<0 Then
nBegin = 0
Else
nBegin = HistoryOld.Count-300
End If
For i=nBegin to HistoryOld.Count-1 Step 1
sDate=HistoryOld.Date(i) '2015/12/9 15:00:00
'如果是白盘数据，则加入到新合约历史数据中
If IsBaiPan(sDate)=1 Then
Call HistoryNew.InsertAt(HistoryNew.Count)
'用老合约的i行数据更新新合约的最新一条数据
UpdateByHistoryData HistoryNew,HistoryOld,i
application.msgout "count=" & HistoryNew.Count & " date=" &HistoryNew.date(HistoryNew.Count-1)
End If 'IsBaiPan(sDate)=1
Next 'i=nBegin to HistoryOld.Count-1 Step 1
Call HistoryNew.SaveData(sNewInst,sNewInstMarket,2)
Next
Set History11 = marketdata.GetHistoryData("RB15","SQ",1)
application.msgout "---date=" &HistoryNew.date(HistoryNew.Count-1)
application.msgout "---count=" &HistoryNew.Count-1
'Call Application.SetTimer(nInstDefineID,nInstDefineTime*1000)
End Sub
Sub Application_Timer(ID)
'application.msgout "==="
If ID=nInstDefineID Then
'设置历史数据共享内存模式。0：共享。1：独享
'marketdata.HistoryDataMode=0
vOldInsts=dNewInsts.keys
vNewInsts=dNewInsts.Items
For j=0 To dNewInsts.Count-1
sOldInst = vOldInsts(j)
sNewInst = vNewInsts(j)
sOldInstMarket = dOldInstsMarket.Item(sOldInst)
sNewInstMarket = dNewInstsMarket.Item(sNewInst)
Set HistoryNew = marketdata.GetHistoryData(sNewInst,sNewInstMarket,2)
Set HistoryOld = marketdata.GetHistoryData(sOldInst,sOldInstMarket,2)
'对比新、老合约最后一条数据的时间是否一样，如果一样，则更新新合约的数据。否则，新增新合约一条数据
sDateOld = HistoryOld.Date(HistoryOld.Count-1)
sDateNew = HistoryNew.Date(HistoryNew.Count-1)
If sDateOld<>sDateNew Then
Call HistoryNew.InsertAt(HistoryNew.Count)
End If
UpdateByHistoryData HistoryNew,HistoryOld,HistoryOld.Count-1
Call HistoryNew.SaveData(sNewInst,sNewInstMarket,2)
Next
End If
End Sub
Function IsBaiPan(sDate)
'2015/12/9 15:00:00
IsBaiPan = 0
iPos1 = InStr(1, sDate, " ", vbTextCompare)
If iPos1=0 Then
IsBaiPan = 0
Else
vDate = Split(sDate," ")
sTime = vDate(1)
If CDate(sTime) >= CDate("09:00:00") and CDate(sTime) <= CDate("15:30:00") Then
IsBaiPan = 1
'application.msgout sDate
End If
End If
End Function
Sub UpdateByHistoryData(byref HistoryNew,byref HistoryOld,i)
HistoryNew.Open(HistoryNew.Count-1) = HistoryOld.Open(i)
HistoryNew.High(HistoryNew.Count-1) = HistoryOld.High(i)
HistoryNew.Date(HistoryNew.Count-1) = HistoryOld.Date(i)
HistoryNew.Low(HistoryNew.Count-1) = HistoryOld.Low(i)
HistoryNew.Close(HistoryNew.Count-1) = HistoryOld.Close(i)
HistoryNew.Volume(HistoryNew.Count-1) = HistoryOld.Volume(i)
'HistoryNew.Amount(HistoryNew.Count-1) = HistoryOld.Amount(i)
'HistoryNew.Advance(HistoryNew.Count-1) = HistoryOld.Advance(i)
'HistoryNew.Decline(HistoryNew.Count-1) = HistoryOld.Decline(i)
HistoryNew.Qt(HistoryNew.Count-1) = HistoryOld.Qt(i)
HistoryNew.Openint(HistoryNew.Count-1) = HistoryOld.Openint(i)
'HistoryNew.OpenV(HistoryNew.Count-1) = HistoryOld.OpenV(i)
'HistoryNew.OpenA(HistoryNew.Count-1) = HistoryOld.OpenA(i)
HistoryNew.ASKPRICE(HistoryNew.Count-1) = HistoryOld.ASKPRICE(i)
HistoryNew.ASKVOL(HistoryNew.Count-1) = HistoryOld.ASKVOL(i)
HistoryNew.BIDPRICE(HistoryNew.Count-1) = HistoryOld.BIDPRICE(i)
HistoryNew.BIDVOL(HistoryNew.Count-1) = HistoryOld.BIDVOL(i)
End Sub