用OpenQQ实现网络环境下的编号
我们之前介绍的编号方法,在多用户环境下会出现重复,参考:常用编号生成方法
有了Open,我们可以轻松解决这个问题。
以下例子,在实际测试的时候,如果表中已经有不符合规范的编号,请先删除之,否则会影响编号的生成结果
一、按类别编号
假定有下图所示的一个表,编号根据类别生成,前两位为类别,后三位为顺序号:
这里假定使用的是外部数据源。
服务端的设计
1、在服务端的全局代码中编写代码:
Public flbhs As New Dictionary(of String,Integer)
2、在服务端的AfterOpenProjet事件中编写代码:
Dim
dt As
DataTable
Dim
cmd As
New SQLCommand
cmd.ConnectionName
= "数据源名称"
cmd.CommandText
= "Select
类别,
Max(编号)
As 编号
From {产品}
Group By 类别"
dt =
cmd.ExecuteReader
flbhs.Clear()
For
Each dr
As DataRow
In dt.DataRows
Dim qz
As String =
dr("类别")
'编号前缀
Dim bh
As String =
dr("编号")
Dim id
As Integer
If bh.Length
= 5 Then
bh =
bh.SubString(2)
If Integer.TryParse(bh,id)
Then
flbhs.Add(qz,
id)
End If
End
If
Next
上述代码在启动项目后,用SQL语句提取每个类别的最大编号,将其整数部分存储在字典flbhs中。
3、在服务端的OpenQQ服务端事件ReceivedMessage中编写代码:
Dim
msg As
String = e.Message
If
msg.StartsWith(":f")
AndAlso msg.EndsWith("f:")
Then
msg = msg.SubString(2,
msg.Length -
4)
If
flbhs.ContainsKey(msg)
Then '如果存在这个类别的编号
flbhs(msg)
=
flbhs(msg) +
1 '将该类别最大编号加1
Else
flbhs.Add(msg,1)
'如果是这个列表的首次编号,则编号等于1
End
If
e.ReturnValue
= flbhs(msg)
'将编号返回给客户端
End
If
客户端的设计
选择客户端项目对应的表,在其DataColChanged事件中加上代码:
If
e.DataCol.Name
= "类别" Then
If e.DataRow.IsNull("类别")
Then
e.DataRow("编号")
= Nothing
Else
If
QQClient.Ready =
False Then
PopMessage("QQClient未启动,无法生成编号!","提示",PopIconEnum.Infomation,5)
Else
Dim
bh As String
= e.DataRow("类别")
Dim rt
As String =
QQClient.SendWait(":f"
& bh
& "f:")
Dim
id As
Integer
If
rt > "" Then
If
Integer.TryParse(rt,id)
Then
e.DataRow("编号")
= bh &
Format(id,"000")
Else
PopMessage("服务器返回错误信息:"
& rt,"提示",PopIconEnum.Infomation,5)
End If
Else
PopMessage("服务器无响应,无法生成编号!","提示",PopIconEnum.Infomation,5)
End If
End If
End If
End
If
二、按月生成编号
假定有个订单表,需要按月自动生成编号,四位年,两位月,最后三位是顺序号,如下图所示:
这里假定使用的是外部数据源。
服务端的设计
1、在服务端的全局代码中编写代码:
Public flbhs As new Dictionary(of String,Integer)
2、在服务端的AfterOpenProjet事件中编写代码:
Dim
dt As
DataTable
Dim
cmd As
New
SQLCommand
cmd.ConnectionName
= "数据源名称"
cmd.CommandText
= "Select Year(日期)
As 年,
Month(日期)
As 月,
Max(编号)
as 编号
From {订单}
Group By Year(日期),
Month(日期)"
dt =
cmd.ExecuteReader
flbhs.Clear()
For
Each dr
As DataRow
In dt.DataRows
Dim qz
As String =
dr("年")
& Format(dr("月"),"00")
'编号前缀,4位年,2位月
Dim bh
As String =
dr("编号")
Dim id
As Integer
If bh.Length
= 10 Then
bh =
bh.SubString(7)
If Integer.TryParse(bh,id)
Then
flbhs.Add(qz,
id)
End If
End
If
Next
上述代码在启动项目后,用SQL语句提取现有数据的每月最大编号,将其整数部分存储在字典flbhs中。
3、在服务端的OpenQQ服务端事件ReceivedMessage中编写代码:
Dim
msg As
String = e.Message
If
msg.StartsWith(":p")
AndAlso msg.EndsWith("p:")
Then
msg = msg.SubString(2,
msg.Length -
4)
If
flbhs.ContainsKey(msg)
Then
'如果存在这个月的编号
flbhs(msg)
= flbhs(msg) +
1
'将该月最大编号加1
Else
flbhs.Add(msg,1)
'如果是这个月的首次编号,则编号等于1
End If
e.ReturnValue
= flbhs(msg) '将编号返回给客户端
End
If
客户端的设计
选择客户端项目的订单表,在其DataColChanged事件中加上代码:
If
e.DataCol.Name
= "日期"
Then
If e.DataRow.IsNull("日期")
Then
e.DataRow("编号")
= Nothing
Else
If
QQClient.Ready =
False Then
PopMessage("QQClient未启动,无法生成编号!","提示",PopIconEnum.Infomation,5)
Else
Dim
bh As String
= Format(e.DataRow("日期"),"yyyyMM")
Dim rt
As String =
QQClient.SendWait(":p"
& bh
& "p:")
Dim id
As Integer
If
rt > "" Then
If
Integer.TryParse(rt,id)
Then
e.DataRow("编号")
= bh &
"-" &
Format(id,"000")
Else
PopMessage("服务器返回错误信息:"
& rt,"提示",PopIconEnum.Infomation,5)
End If
Else
PopMessage("服务器无响应,无法生成编号!","提示",PopIconEnum.Infomation,5)
End If
End If
End
If
End
If
三、按日期和类别编号
假定有个表,需要按月自动生成编号,根据工程代码按顺序编号,前4位是工程代码,然后是4位年,2位月,最后4位是顺序号,如下图所示:
其实如果你看懂了前面的例子,这个例子就是多余的,无非就是在服务器端记录每一个前缀的最大序号,遇到客户端申请编号的时候,将最大序号加1,然后返回给客户端。
编程的是千变万化的,但万变不离其宗,基本原理明白了,就可以举一反三,以不变应万变。
接下来我们看看是不是和第一个例子一样。
服务端的设计
1、在服务端的全局代码中编写代码:
Public flbhs As new Dictionary(of String,Integer)
2、在服务端的AfterOpenProjet事件中编写代码:
Dim
dt As
DataTable
Dim
cmd As
New
SQLCommand
cmd.ConnectionName
= "数据源名称"
cmd.CommandText
= "Select
工程代码,Year(制单日期)
As 年,
Month(制单日期)
As 月,
Max(单据编号)
as 单据编号
From {工程}
Group By
工程代码,Year(制单日期),
Month(制单日期)"
dt =
cmd.ExecuteReader
flbhs.Clear()
For
Each dr
As DataRow
In dt.DataRows
Dim qz
As String =
dr("工程代码")
& "-"
& dr("年")
& Format(dr("月"),"00")
'编号前缀,4位工程代码,4位年,2位月
Dim bh
As String =
dr("单据编号")
Dim id
As Integer
If bh.Length
= 16
Then
bh =
bh.SubString(12)
If Integer.TryParse(bh,id)
Then
flbhs.Add(qz,
id)
End If
End
If
Next
上述代码除了表名、列名的变化,以及给编号前缀加上工程代码外,真正发生变化的就是两个数字,你可以想想为什么一个由10改为16,一个由7改为12?
3、在服务端的OpenQQ服务端事件ReceivedMessage中编写代码:
Dim
msg As
String = e.Message
If
msg.StartsWith(":g")
AndAlso msg.EndsWith("g:")
Then
msg = msg.SubString(2,
msg.Length -
4)
If
flbhs.ContainsKey(msg)
Then
'如果存在这个月的编号
flbhs(msg)
= flbhs(msg) +
1
'将该月最大编号加1
Else
flbhs.Add(msg,1)
'如果这个月的首次编号,则编号等于1
End
If
e.ReturnValue
= flbhs(msg)
End
If
上述代码没有任何改变。
客户端的设计
选择客户端项目的对应的表,在其DataColChanged事件中加上代码:
Select
e.DataCol.Name
Case
"制单日期","工程代码"
If e.DataRow.IsNull("制单日期")
OrElse e.DataRow.IsNull("工程代码")
Then
e.DataRow("单据编号")
= Nothing
Else
If
QQClient.Ready =
False Then
PopMessage("QQClient未启动,无法生成编号!","提示",PopIconEnum.Infomation,5)
Else
Dim
bh As
String = e.DataRow("工程代码")
& "-"
& Format(e.DataRow("制单日期"),"yyyyMM")
Dim rt
As String =
QQClient.SendWait(":g"
& bh
& "g:")
Dim
id As
Integer
If
rt > ""
Then
If
Integer.TryParse(rt,id)
Then
e.DataRow("单据编号")
= bh &
"-" &
Format(id,"0000")
Else
PopMessage("服务器返回错误信息:"
& rt,"提示",PopIconEnum.Infomation,5)
End
If
Else
PopMessage("服务器无响应,无法生成编号!","提示",PopIconEnum.Infomation,5)
End If
End
If
End
If
End
Select
上述代码除了表名、列名的变化,以及给编号前缀加上工程代码外,唯一发生变化的只是将:
Format(id,"000")
改成了
Format(id,"0000")
因为顺序号原来是3位,现在是4位。