Foxtable(狐表)用户栏目专家坐堂 → [分享] 新版《网络环境下复杂的不重复编号》


  共有16617人关注过本帖平板打印复制链接

主题:[分享] 新版《网络环境下复杂的不重复编号》

帅哥哟,离线,有人找我吗?
程兴刚
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信 一级勋章
等级:超级版主 帖子:7235 积分:40550 威望:0 精华:16 注册:2008/8/31 23:23:00
[分享] 新版《网络环境下复杂的不重复编号》  发帖心情 Post By:2012/12/17 13:17:00 [只看该作者]

注:实现了自动补号,删除记录自动回收编号供调用:

 

【后台“编号”表结构截图】:

 
此主题相关图片如下:未命名.jpg
按此在新窗口浏览图片

 

【各事件代码:】

 

一、:DataRowAdding 事件代码:

 

Dim cmd As New SQLCommand
Dim dt As Date
cmd.C
cmd.CommandText = "Select GetDate()"
dt = cmd.ExecuteScalar()
e.DataRow("入库日期")= format(dt,"yyyy-MM-dd")  ‘按照服务器时间设置入库时间,杜绝用户修改系统时间导致事后补单;

 

二、DataRowAdded事件代码:调用后台可用入库,并未下一个用户生成新的备用编号:

 

Dim cmd As New SQLCommand
Dim dt As Date
cmd.C
cmd.CommandText = "Select GetDate()"
dt = cmd.ExecuteScalar() ’之所以重取后台时间,因为是长日期时间格式,已被将来根据用户ID或姓名,加上这个时间,自动生成增删记录,生成文本文件而备用!
Dim dr As DataRow = e.DataRow
Dim pf As String = "RK" & format(dr("入库日期"),"yyyyMMdd") & "-" '设置入库单编号前缀
Dim cmd1 As New SQLCommand
Dim cmd2 As New SQLCommand
Dim Key1,key2 As Integer
Dim nm As String = e.DataTable.name
cmd1.C '设置数据源名称
cmd2.C
cmd1.commandText = "Select Count(*) From [编号] Where [前缀] = '" & pf & "' And 表名 = '" & nm & "' and 已用标识 = 0"
If cmd1.ExecuteScalar = 0 Then '如果编号表不存在前缀的行,那么增加一行
    cmd1.commandtext = "Insert Into 编号 (表名, 日期, 前缀, 顺序号, 已用标识) Values('" & nm & "','" & dt & "','" & pf & "',1,0)"
    cmd1.ExecuteNonQuery
End If
cmd1.CommandText = "Select Min(顺序号) From {编号} Where 表名 = '" & nm & "' and 前缀 = '" & pf & "' and 已用标识 = 0 Or 已用标识 Is Null"
key1 = cmd1.ExecuteScalar()

cmd1.CommandText = "Select Max(顺序号) From {编号} Where 表名 = '" & nm & "' and 前缀 = '" & pf & "' and 已用标识 = 0"
key2 = cmd1.ExecuteScalar()
cmd1.commandText = "Update [编号] Set [已用标识] = 1 Where [顺序号] = " & Key1 & " And [前缀] = '" & pf & "' And 表名 = '" & nm & "'"
cmd1.ExecuteNonQuery()
If key1 = key2
    cmd1.commandtext = "Insert Into 编号 (表名, 日期, 前缀, 顺序号, 已用标识) Values('" & nm & "','" & dt & "','" & pf & "'," & key2+1 & ",0)"
    cmd1.ExecuteNonQuery
End If
cmd1.CommandText = "DELETE FROM {编号} Where 表名 = '" & nm & "' and 前缀 = '" & pf & "' and 顺序号 = " & key1 & "And 已用标识 = 1"
cmd1.ExecuteNonQuery()
Dim dr1 As DataRow = DataTables("sys_系统设置").find("[设置名称] = '出库单编号位数'")
If dr1 Is Nothing
    dr1 = DataTables("sys_系统设置").AddNew()
    dr1("设置名称") = "入库单编号位数"
    dr1("设置值") = 5
End If
Dim a As Byte = dr1("设置值")
Dim s As String = Format(Key1,"00000000000000000000")
e.DataRow("入库单编号") = pf & s.SubString(s.Length - a)

 

三、BeforeDeleteDataRow事件代码:【删除记录时,回收编号到后台】

 

Dim cmd As New SQLCommand
Dim dt As Date
cmd.C
cmd.CommandText = "Select GetDate()"
dt = cmd.ExecuteScalar()
Dim dr As DataRow = e.DataRow
Dim dh As String = dr("入库单编号")
Dim pf As String = dh.Split("-")(0) & "-"
Dim Key As Integer = val(dh.Split("-")(1))
Dim nm As String = e.DataTable.name
cmd.commandtext = "Insert Into 编号 (表名, 日期, 前缀, 顺序号, 已用标识) Values('" & nm & "','" & dt & "','" & pf & "'," & key & ",0)"
cmd.ExecuteNonQuery

 

四、AfterOpenProject事件

(加上这一段代码,保证以后每次启动时,自动删除今天以前的后台可用编号<如果您的编号是按月编码,改成删除本月以前的后台可用编号即可>,避免后台数据库膨胀。

 

 

Dim dt As Date
cmd.C
cmd.CommandText = "Select GetDate()"
dt = cmd.ExecuteScalar()
cmd.C '设置数据源名称
dt = "#" & format(dt,"yyyy-MM-dd") & " 00:00:00.000#"
cmd.CommandText = "DELETE FROM {编号} Where 日期 < '" & dt & "'"
cmd.ExecuteNonQuery()

 

 

     【说明】:培训操作人,下班前尽量不要从尾行以前删除记录,因为已经回收了的编号没有被得到再次启用,这样的断号是没办法解决的。

 

删号再新增记录优先补号效果截图(顺序不对不用担心,填写完所有记录,打印报表前按照编号、入库日期排序即可):

 
此主题相关图片如下:未命名.jpg
按此在新窗口浏览图片

[此贴子已经被作者于2012-12-17 13:26:36编辑过]

 回到顶部
总数 46 1 2 3 4 5 下一页