和昨天相比今天增加或减少的合约[金字塔模型]

期货里有的时候突然有些合约就开始有成交量了, 而有的合约不知何时就没有成交量了. 
作为每日收盘后对当天行情的统计的一部分, 我们也许需要判断:
(1) 哪些合约昨日没有成交量而今日有非零的成交量;
(2) 那些合约昨日有非零的成交量而今日的成交量却是零;
(3) 哪些主力合约今日没有成交.这里主力的定义沿用金字塔的官方认定.
为实现以上目的, 金字塔vbs代码如下, 以活跃论坛, 给各位看官以福利, 也感谢金字塔多年的使用.
也许您觉得这是雕虫小技, 但是从每日成交合约的变化, 也许可以未雨绸缪.
ps:
主要是没有用字典---虚拟机里字典会出错, 而是用一些简单的办法绕过而自是写个类似字典的东西;
再者用ini, 还有vbs的for循环里面不能用if...else if....等等, 无他.

模型策略源码：( 前面的序号要删除 )

1 sub myGetTickCmmdt()
2 Dim marketName, useFuture
3 Dim fso, outputf, d, d_num, dmain, dmain_num, prefixStockNameCur, suffixStockNameCur, lastPrefix, dirc
4 useFuture = 1
5
6 if useFuture = 1 then
7     marketName=Array("SQ","DQ","ZQ","ZJ")
8 end if
9 NameFolder = year(date)*10000 + month(date)*100 + day(date)
10 Set fso = CreateObject("scripting.filesystemobject")
11 Set d = CreateObject("Stock.ArrayString")
12 Set d_num = CreateObject("Stock.Array")   
13 Set dmain = CreateObject("Stock.ArrayString")
14 Set dmain_num = CreateObject("Stock.Array")   
15 dirc = "C:\\Users\\ui\\Stock.ini"
16 lastPrefix = " "
17 msgbox "hi"
18     
19 For j=0 To UBound(marketName)
20 n = marketData.GetReportCount(marketName(j))
21
22 outputf_0 = "C:\\Users\\ui\\Downloads\\jk\\"&NameFolder&"\\"&marketName(j)& "\\"
23
24 For i=0 To n-1
25 Set reportData = marketdata.GetReportDataByIndex(marketName(j),i)                               
26      IF useFuture = 1 then
27 parseStockName reportData.label, prefixStockNameCur, suffixStockNameCur
28
29 IF suffixStockNameCur＞="00" and suffixStockNameCur＜="99" and reportData.Volume ＜= 0 THEN
30 aligning reportData.label, 0, d, d_num
31 IF suffixStockNameCur = "00" THEN
32 aligning reportData.label, 0, dmain, dmain_num    
33 END IF
34 END IF
35 IF suffixStockNameCur＞="00" and suffixStockNameCur＜="99" and reportData.Volume ＞ 0 THEN
36 aligning reportData.label, reportData.Volume, d, d_num
37 IF suffixStockNameCur = "00" THEN
38 aligning reportData.label, reportData.Volume, dmain, dmain_num
39 END IF
40
41 IF lastPrefix ＜＞ prefixStockNameCur THEN
42 lastPrefix = prefixStockNameCur            
43 END IF        
44 End If
45 end if
46 Next
47 Next   
48    
49 IF 1 = useFuture Then
50 \'checkPrefixSuffix d, d_num
51 checkLabel d, d_num, dmain, dmain_num, marketName, dirc
52 END IF
53 set fso = Nothing
54 set d = Nothing
55 set d_num = Nothing
56 set dmain = Nothing
57 set dmain_num = Nothing
58 end sub
59
60
61 Sub checkLabel(ByRef dq, ByRef dq_num, ByRef dm, ByRef dm_num, mktName, dirc)
62 Dim newContracts, justLosingContracts, newContracts_num, justLosingContracts_num
63 SET newContracts = CreateObject("Stock.ArrayString")
64 SET justLosingContracts = CreateObject("Stock.ArrayString")
65 SET newContracts_num = CreateObject("Stock.Array")
66 SET justLosingContracts_num = CreateObject("Stock.Array")
67
68 Set fs = CreateObject("Scripting.FileSystemObject")
69 Set f = fs.GetFile(dirc)
70 tmp_ = dirc&".0"
71 application.MsgOut tmp_
72 f.Copy tmp_
73 set f = Nothing
74 set fs = Nothing
75
76 For j = 0 To dq.count - 1
77 label = dq.Getat(j)
78     statPre = Document.GetPrivateProfileInt("MyCpp", label, -1, dirc)
79 IF statPre = -1 THEN
80 msgbox "failed to fetch_from_ini for " & label
81 application.MsgOut "failed to fetch_from_ini for " & label
82 EXIT SUB
83 END IF
84        
85 statNow = dq_num.Getat(j)
86 IF statPre = 0 and statNow ＜＞ 0 THEN
87 newContracts.addBack(label)
88 newContracts_num.addBack(statNow)
89 tmp = Document.WritePrivateProfileInt("MyCpp", label, 1, dirc)
90 END IF
91 IF statPre ＜＞ 0 and statNow = 0 THEN
92 justLosingContracts.addBack(label)
93 justLosingContracts_num.addBack(statPre)
94 tmp = Document.WritePrivateProfileInt("MyCpp", label, 0, dirc)
95 END IF
96 NEXT
97    
98 For i = 0 To dm.count - 1
99 if 0 = dm_num.getat(i) THEN
100 application.MsgOut "MISSING Main: " & dm.getat(i)
101 END IF
102 NEXT
103        
104 printStockarraystring newContracts, newContracts_num, "newContracts"
105 printStockarraystring justLosingContracts, justLosingContracts_num, "justLosingContracts"
106 SET newContracts = Nothing
107 SET justLosingContracts = Nothing
108 SET newContracts_num = Nothing
109 SET justLosingContracts_num = Nothing
110 End Sub
111
112 Sub printStockarraystring(ByRef arraytoprint, ByRef array_num, names)
113 For i = 0 To arraytoprint.count - 1
114 application.MsgOut names & ":" & arraytoprint.GetAt(i) & "|" & array_num.GetAt(i)
115 NEXT
116 END Sub
117
118 sub aligning(label, int_num, ByRef d, ByRef d_num)
119 d.AddBack(label)
120 int_a = CLng(int_num)
121 d_num.addback(int_a)   
122 end sub
123
124 sub parseStockName(label, ByRef prefixStockName, ByRef suffixStockName)
125 select case len(label)
126 case 4
127 prefixStockName=left(label,2)
128 case 3
129 prefixStockName=left(label,1)
130 case 5
131 prefixStockName=left(label,3)
132 case else
133 application.MsgOut "wrong future label " & label
134 msgbox "wrong future label " & label
135 end select
136 suffixStockName=right(label,2)
137 end sub
138
139 Sub checkPrefixSuffix(ByRef dq, ByRef dq_num)
140 Dim tmp_prefix_last, tmp_label, tmp_suffix_last, tmp_prefix, tmp_suffix
141 Dim tmp_array
142 tmp_prefix_last = " "
143 tmp_suffix_last = "00"
144 Set tmp_array = CreateObject("Stock.ArrayString")
145    
146 For j = 0 To dq.count - 1   
147 IF 0 ＜＞ dq_num.getat(j) THEN
148 tmp_array.addback dq.getat(j)
149 END IF
150 NEXT
151 tmp_array.Sort(0)
152
153 For i = 0 To tmp_array.count - 1   
154 tmp_label = tmp_array.GetAt(i)
155 parseStockName tmp_label, tmp_prefix, tmp_suffix       
156    
157 If tmp_prefix_last ＜＞ tmp_prefix Then
158      IF "00" ＜＞ tmp_suffix_last THEN
159 application.MsgOut "ODD: prefix:" & tmp_prefix_last & " suffix:" & tmp_suffix_last
160 END IF
161 tmp_suffix_last = tmp_suffix
162 tmp_prefix_last = tmp_prefix               
163 ELSE
164 IF tmp_suffix ＜ tmp_suffix_last THEN
165 tmp_suffix_last = tmp_suffix
166 END IF
167 End If           
168 Next       
169
170 IF "00" ＜＞ tmp_suffix_last THEN
171 application.MsgOut "ODD SUFFIX " & tmp_prefix_last & " " & tmp_suffix_last
172 END IF
173
174 set tmp_array = Nothing   
175 End Sub
176

{别忘了将本网告诉您身边的朋友，向朋友传达有用资料，也是一种人情，你朋友会感谢你的。}