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

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

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

考虑到公司有些环境是2000svr。我只能搬出n年没有使用的vb来。。。用惯了现在发现曾经最爱的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.EOFrs("wtclbz") = Convert.RndWTCLBZLog.LogWrite rs("wtzqdm"), rs("wtwtsl"), rs("wtwtjg"), "99"rs.Updaters.MoveNextWend'写入成交日志Exit SubEnd IfIf 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.EOFSet 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 ThenWtToHb db, rowEnd Ifrs.MoveNextWendEnd If'先处理各种撤单Set rs = db.GetRecordSet("select * from sjswt where wtywlb like '%C' and wtclbz='z'")Set MainForm.dg.DataSource = rsWhile Not rs.EOFDone db, rs, CJTypers.CancelUpdaters.MoveNextWend'再处理常规委托业务Set rs = db.GetRecordSet("select * from sjswt where wtywlb not like '%C' and wtclbz='z'")Set MainForm.dg.DataSource = rsWhile Not rs.EOFDone db, rs, CJTypers.CancelUpdaters.MoveNextWend End Sub '************************************************************************************* '主要业务过程 '************************************************************************************* Private Sub Done(ByRef db As DBClass, rs As ADODB.Recordset, CJType As Integer) '传入委托业务类别 Dim SLRand As Integer, JGRand As IntegerSelect 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") = 0WtToHb db, rsCase "0B", "0S" '普通买卖SetRndByCJType CJType, SLRand, JGRandWtToHb db, rs, CJType, SLRand, JGRandEnd Select End Sub 'SLRand 0-不随机 1-随机部成 2-随机全成 'JGRand 0-不随机 1-随机方式1 2-随机方式2 Private 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'得到最大成交序号+1hbcjhm = db.GetData("select max(hbcjhm) from sjshb")If hbcjhm = "" Thenhbcjhm = "10000001"Elsehbcjhm = Int(hbcjhm) + 1End IfRandomize Second(Now)Dim hb As ADODB.RecordsetSet hb = db.GetRecordSet("select * from sjshb")Dim cjbs As Integer '成交笔数If SLRand > 0 Thencjbs = Int(Rnd * 10 + 3)Elsecjbs = 1End IfDim i As Integer, maxSL As IntegermaxSL = rs("wtwtsl") - 1For i = 1 To cjbshb.AddNewhb("hbcjhm") = hbcjhmhb("hbzqdm") = rs("wtzqdm")hb("hbhtxh") = rs("wthtxh")hb("hbgddm") = rs("wtgddm")hb("hbcjsl") = rs("wtwtsl")hb("hbcjjg") = rs("wtwtjg")hb("hbdfxw") = dfxwhb("hbdfgd") = dfgdhb("hbcjsj") = GetSJString()hb("hbcjrq") = GetRQString()hb("hbywlb") = rs("wtywlb")hb("hbcdyy") = cdyyhb("hbmark") = rs("wtmark")hb("hbbybz") = rs("wtbybz")If SLRand > 0 ThenIf i = 1 Thenhb("hbcjsl") = 1Elsehb("hbcjsl") = Int(Rnd * maxSL * 0.6 + 1)End IfIf SLRand = 2 And i = cjbs Thenhb("hbcjsl") = maxSL + 1End IfIf SLRand = 1 Then hb("hbbybz") = "3"End IfIf JGRand = 1 ThenDim hq As New PriceClasshb("hbcjjg") = hq.GetRandPrice(rs("wtwtjg"), hb("hbzqdm"), 1)End IfmaxSL = maxSL - hb("hbcjsl")If maxSL = 0 Then i = cjbs + 1hbcjhm = hbcjhm + 1 '合同序号递增'写入成交日志Log.LogWrite hb("hbzqdm"), hb("hbcjsl"), hb("hbcjjg"), hb("hbywlb")Nexthb.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 CJTypeCase 1SLRand = 2JGRand = 0Case 2SLRand = 1JGRand = 0Case 4SLRand = 2JGRand = 1Case ElseSLRand = 0JGRand = 0End Select End Function Private Function GetSJString()GetSJString = Format(Time, "hhmmss") End Function Private Function GetRQString()GetRQString = Replace(Format(Date, "mm-dd-yy"), "-", "/") End Function