主题：[原创]和昨天相比今天增加或减少的合约

以下内容为程序代码:

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