专家坐堂-编号问题Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.com/bbs/index.asp)
--  专家坐堂  (http://foxtable.com/bbs/list.asp?boardid=2)
----  编号问题  (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=195909)

--  作者：lgz518
--  发布时间：2025/3/20 11:22:00
--  编号问题

编号问题

关于编号论坛有很多，有过于简单不适用，有的过于复杂，难于维护

如何在局域多并发情况，编号不重复，不断号？

有这么一样思路，不知如何实现？

表A的当前表
表B的为编号回收表

表A的编号，当日期列录入值时，
先从回收表找是否有回收编号可用，如果有就可回收编号，并检验当前表是否重复编号，如果没有就用，如果有重复就重新生成不重复的编号；
如果回收表没有回收编号，检查当前表是否有重复编号？如果没有就生成不重复编号

在保存时，再检查当前表是否有重复，避免并发时，漏了，有重复，如果有重复时，重新生成不重复编号，之后保存。

--  作者：有点蓝
--  发布时间：2025/3/20 11:30:00
--
这个问题问过很多次了。具体什么地方实现不了？

--  作者：lgz518
--  发布时间：2025/3/20 13:06:00
--

\'1、服务端-
Dim dt As DataTable
Dim cmd As New SQGLCommand
cmd.C \'数据源名称
cmd.CommandText = "SelGectG 工程代码,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
问题一：不想用上面代码，不想服务端的代码，因为不灵活，不实用，麻烦，只想用客户端来实现
问题二：上面服务端是编号是另一个数据源，现在改同一个数据源，是否也可不用上面的代码？

下面的客户端的代码如何改？
2客户端

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 dr As DataRow = DataTables("回收编码").Find("编号 is not null and 表名=\'订单\'", "编号")
If dr IsNot Nothing Then
e.DataRow("单据编号") = dr("编号")
dr.Delete
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 If

End Select

--  作者：有点蓝
--  发布时间：2025/3/20 13:35:00
--
纯客户端不可能做得到不重复的编号

--  作者：lgz518
--  发布时间：2025/3/20 13:59:00
--

问题二：上面服务端是编号是另一个数据源，现在改同一个数据源，是否也可不用上面的代码？

--  作者：有点蓝
--  发布时间：2025/3/20 14:15:00
--
这种代码本来就是用在同一个数据源的

--  作者：lgz518
--  发布时间：2025/3/20 15:20:00
--
上面代码，之前是分开，有二个数据源

--  作者：有点蓝
--  发布时间：2025/3/20 15:47:00
--
二个数据源指2个不同地数据库？

如果说是2个项目连接到同一个数据库，只能算是一个数据源

--  作者：lgz518
--  发布时间：2025/3/20 22:30:00
--

\'\'编号生成\'
Public _BizCodeBuilder As BizCodeBuilder
\'不重复编号上传用,这里的用法比较简单,没有做复杂的编号规则处理\'
Public Class BizCodeBuilder
Private _bizcode As DataTable \'直接把编号表取出到内存\'
Private _codelock As New Object
\' Public Sub New()
Public Sub New(sjy As String)
Dim db As New SQLCommand
db.C


\' Dim SqGl As String = CExp("selecGt * from bh_tb where Bm =\'{0}\'", s_name) \'执行SQLG
Dim SqGl As String = CExp("selecGt * from bh_tb ") \'执行SQLG
_bizcode = Functions.Execute("Cmd_GetDataTable", sjy, sql, True)
End Sub

Public Function GetNextCode(s_name As String, Optional s_qz As String = Nothing) As String
SyncLock _codelock \'使用锁处理并发

\' \'output.show(sql)
\' Dim dt As system.data.DataTable = db.ExecuteDataSet(Sql).Tables(0)
\' Dim dr As system.data.DataRow
\' If dt.Rows.count = 0 Then
Dim dr As DataRow = _bizcode.Find(CExp("Bm=\'{0}\'", s_name))
\' Dim dr As DataRow = _bizcode.Find(CExp("Bm=\'{0}\'", s_name))
\' Dim dr As DataRow
If dr Is Nothing Then
dr = _bizcode.AddNew()
\' dr = dt.NewRow()
dr("Bm") = s_name
dr("MaxValue") = 1
If String.IsNullOrEmpty(s_qz) Then s_qz = Date.now.ToString("mmss") & "BH"
dr("qz") = s_qz
dr("Mark") = "yyyyMM"
dr("MarkValue") = Date.Today.ToString("yyyyMM")

\'dr("Mark") = "yyyyMMdd"
\'dr("MarkValue") = Date.Today.ToString("yyyyMMdd")

dr("Length") = 4
\' dt.Rows.Add(dr)

Else
\' dr = dt.Rows(0)
\'这里的处理规则是按时间进行重新编号,至于是按年,月还是日,在掩码中体现\'
If dr("MarkValue") <> Date.Today.ToString(dr("Mark")) Then

dr("MaxValue") = 1
dr("MarkValue") = Date.Today.ToString(dr("Mark"))
Else
dr("MaxValue") = dr("MaxValue") + 1
End If
End If
\' db.UpdateDataTable(dt, "xtbh_tb")
dr.Save()
Return dr("qz") & dr("MarkValue") & "-" & Format(dr("MaxValue"), "0000") \'顺序号只取4位\'
End SyncLock
End Function
End Class

转SQLG2008，执行上面代码，报错提示没下面,如何解决？
Cmd_GetDataTable",

--  作者：有点蓝
--  发布时间：2025/3/20 22:49:00
--
这是个内部函数，抄别人代码的抄完整呗