终于开始自己写模拟成交了(深圳A股普通交易与撤单)

用了三天时间解决了td字体小的问题之后，奚立哥貌似开始重视我了。。。开始叫我做模拟成交。。。这样能让我更好地熟悉业务。。。

考虑到公司有些环境是2000svr。我只能搬出n年没有使用的vb来。。。用惯了.net现在发现曾经最爱的vb还不是一般的低效啊。。。

 

大致需求：

用一个程序管理多个环境下的委托成交数据库。

上海是sql数据库。深圳是dbf数据库。

行情是卫星实时的dbf数据库。

 

能模拟处理20种深圳证券业务和20余种上海证券业务的成交。

实现手动成交和实时自动成交。

 

支持特殊模拟成交方式：

委托价部分成交

多价位部分成交

多价位全部成交

最优五档转撤销、最优五档转限价

未成全成

未成全撤

强制废单

 

可对被监控数据库进行添加、删除、修改操作。

 

记录成交记录，可自动保存成交记录。

 

工程基本结构如下：

config.dbf························程序配置数据库

SimularDone.frm·············窗体文件

SimularDone.RES············程序资源文件

 

GlobalVariable.bas·········静态对象模块

modErrorHandling.bas···错误处理模块

 

ConfigClass.cls···············配置管理类

DBClass.cls····················数据库操作类

PriceClass.cls·················行情管理类

DoneClass.cls················模拟成交类**(核心)

StringFormat.cls·············数据字典类

LogClass.cls···················日志管理类

 

已完成内容：

完成程序结构搭建。之后的业务扩展只需要改动部分业务代码。程序有很好的扩充性与兼容性。

完成特殊模拟成交方式。精心设计委托库转回报库接口。

实现获取实时行情。实现成交日志显示。实现数据库配置。

实现普通买卖业务的模拟成交。

 

业务流程：

首先处理特殊成交方式的请求。若需处理则处理后结束本次处理流程。

再处理撤单请求。

最后按业务类别处理各业务的买卖委托。

处理完一笔委托后需将wtclbz置为非z(正常处理后置为1)

 

程序处理技巧：

根据委托库中wtywlb字段所表示的业务类别，分类处理请求。普通交易业务类别是0B和0S。表示普通买卖。

撤单是0C。普通买卖只需将委托库中信息，转储到回报库中。而撤单委托需要根据已成交数量，在回报库中减去未成交的数量。

特殊委托则是需要使用备用字段进行部成标记。之后用group by处理部成委托，实现各种特殊成交方式。

 

 

核心代码：

Public Sub SimDone(ByRef db As DBClass, CJType As Integer)Dim rs As New ADODB.Recordset, row As New ADODB.Recordset '特殊成交方式 If CJType = "6" Then 'CJType-6 强制废单 Set rs = db.GetRecordSet("select * from sjswt where wtclbz='z'") While Not rs.EOF rs("wtclbz") = Convert.RndWTCLBZ Log.LogWrite rs("wtzqdm"), rs("wtwtsl"), rs("wtwtjg"), "99" rs.Update rs.MoveNext Wend '写入成交日志 Exit Sub End If If CJType = "3" Then 'CJType-3 部成全成 '取得部分成交的合同序号和已成交数量 Set rs = db.GetRecordSet("select hbhtxh,sum(hbcjsl) as slsum from sjshb group by hbhtxh having hbbybz='3'") While Not rs.EOF Set row = db.GetRecordSet("select * from sjswt where wthtxh='" & rs("hbhtxh") & "'") '新委托数量=原委托数量-已成交数量 row("wtwtsl") = Int(row("wtwtsl")) - Int(rs("slsum")) row("wtmark") = "3x" If row("wtwtsl") > 0 Then WtToHb db, row End If rs.MoveNext Wend End If '先处理各种撤单 Set rs = db.GetRecordSet("select * from sjswt where wtywlb like '%C' and wtclbz='z'") Set MainForm.dg.DataSource = rs While Not rs.EOF Done db, rs, CJType rs.CancelUpdate rs.MoveNext Wend '再处理常规委托业务 Set rs = db.GetRecordSet("select * from sjswt where wtywlb not like '%C' and wtclbz='z'") Set MainForm.dg.DataSource = rs While Not rs.EOF Done db, rs, CJType rs.CancelUpdate rs.MoveNext WendEnd Sub'*************************************************************************************'主要业务过程'*************************************************************************************Private Sub Done(ByRef db As DBClass, rs As ADODB.Recordset, CJType As Integer) '传入委托业务类别Dim SLRand As Integer, JGRand As Integer Select Case UCase(rs("wtywlb")) Case "0C" '普通买卖撤单 Dim DoneCount As Integer, tmp As String '取得已成交数量 tmp = db.GetData("select sum(hbcjsl) from sjshb where hbhtxh='" & rs("wthtxh") & "' and (hbywlb='0B' or hbywlb='0S')") DoneCount = IIf(tmp = "", 0, tmp) '回报成交数量=已成交数量-委托数量（≤0） rs("wtwtsl") = DoneCount - Int(rs("wtwtsl")) rs("wtwtjg") = 0 WtToHb db, rs Case "0B", "0S" '普通买卖 SetRndByCJType CJType, SLRand, JGRand WtToHb db, rs, CJType, SLRand, JGRand End SelectEnd Sub'SLRand 0-不随机 1-随机部成 2-随机全成'JGRand 0-不随机 1-随机方式1 2-随机方式2Private Sub WtToHb(ByRef db As DBClass, _ rs As ADODB.Recordset, _ Optional CJType As Integer, _ Optional SLRand As Integer, _ Optional JGRand As Integer, _ Optional cdyy As String, _ Optional dfxw As String, _ Optional dfgd As String _ ) '插入回报表 Dim hbcjhm '得到最大成交序号+1 hbcjhm = db.GetData("select max(hbcjhm) from sjshb") If hbcjhm = "" Then hbcjhm = "10000001" Else hbcjhm = Int(hbcjhm) + 1 End If Randomize Second(Now) Dim hb As ADODB.Recordset Set hb = db.GetRecordSet("select * from sjshb") Dim cjbs As Integer '成交笔数 If SLRand > 0 Then cjbs = Int(Rnd * 10 + 3) Else cjbs = 1 End If Dim i As Integer, maxSL As Integer maxSL = rs("wtwtsl") - 1 For i = 1 To cjbs hb.AddNew hb("hbcjhm") = hbcjhm hb("hbzqdm") = rs("wtzqdm") hb("hbhtxh") = rs("wthtxh") hb("hbgddm") = rs("wtgddm") hb("hbcjsl") = rs("wtwtsl") hb("hbcjjg") = rs("wtwtjg") hb("hbdfxw") = dfxw hb("hbdfgd") = dfgd hb("hbcjsj") = GetSJString() hb("hbcjrq") = GetRQString() hb("hbywlb") = rs("wtywlb") hb("hbcdyy") = cdyy hb("hbmark") = rs("wtmark") hb("hbbybz") = rs("wtbybz") If SLRand > 0 Then If i = 1 Then hb("hbcjsl") = 1 Else hb("hbcjsl") = Int(Rnd * maxSL * 0.6 + 1) End If If SLRand = 2 And i = cjbs Then hb("hbcjsl") = maxSL + 1 End If If SLRand = 1 Then hb("hbbybz") = "3" End If If JGRand = 1 Then Dim hq As New PriceClass hb("hbcjjg") = hq.GetRandPrice(rs("wtwtjg"), hb("hbzqdm"), 1) End If maxSL = maxSL - hb("hbcjsl") If maxSL = 0 Then i = cjbs + 1 hbcjhm = hbcjhm + 1 '合同序号递增 '写入成交日志 Log.LogWrite hb("hbzqdm"), hb("hbcjsl"), hb("hbcjjg"), hb("hbywlb") Next hb.Update '修改委托处理标志 db.ExecSQL "update sjswt set wtclbz='1' where wthtxh='" & rs("wthtxh") & "'"End Sub'*************************************************************************************Private Function SetRndByCJType(CJType As Integer, ByRef SLRand As Integer, ByRef JGRand As Integer) Select Case CJType Case 1 SLRand = 2 JGRand = 0 Case 2 SLRand = 1 JGRand = 0 Case 4 SLRand = 2 JGRand = 1 Case Else SLRand = 0 JGRand = 0 End SelectEnd FunctionPrivate Function GetSJString() GetSJString = Format(Time, "hhmmss")End FunctionPrivate Function GetRQString() GetRQString = Replace(Format(Date, "mm-dd-yy"), "-", "/")End Function