我通过我们论坛的一个实例,做了一下调整,我仅要我需要的功能,实现了我的想法:方法如下
创建一个表:有以下字段
Num 字符型
user_ID :字符型
computer_ID:字符型
login_time :日期型 要在表的属性中把他的日期时间格式调整为:DateLongTime
refresh_time :日期型 要在表的属性中把他的日期时间格式调整为:DateLongTime
state :字符型
1、在登录窗口的“登录”按钮中,添加以下代码(登录成功的代码中)
Dim i As String = DataTables("用户登录状态表").sqlCompute("max(Num)")
Dim idx As Integer
If i > "" Then
idx=i+1
Else
idx=1
End If
_login_num = idx ’_login_num为全局变量类型:integer
Dim filter1 As String = "[user_ID] = '" & zhanghao & "'" ’ zhanghao 为登录窗口上输入用户名的值
Dim dr1 As DataRow = DataTables("用户登录状态表").Find(filter1)
If dr1 Is Nothing Then
With Tables("用户登录状态表")
.AddNew
.Current("Num") = idx
.Current("user_ID") = zhanghao
.Current("computer_ID") = ComputerId
.Current("login_time") = Date.now
.Current("refresh_time") = Date.now
.Current("state") = 1
.Current.save
End With
Else
With Tables("用户登录状态表")
Tables("用户登录状态表").filter = filter1
.AddNew
.Current("Num") = idx
.Current("user_ID") = zhanghao
.Current("computer_ID") = ComputerId
_datenow = Date.now '全局变量
.Current("login_time") = _datenow ’ _datenow为全局变量,格式:date
.Current("refresh_time") = _datenow
.Current("state") = 1
.Current.save
End With
For Each dr11 As Row In Tables("用户登录状态表").rows
If dr11("login_time") <> _datenow
dr11("state") = 0
dr11.save
End If
Next
End If
2、在项目的beforecloseproject事件中加入以下代码:
Dim dr As DataRow = DataTables("用户登录状态表").SQLFind("Num = '" & _login_num & "'")
If dr IsNot Nothing Then
dr.Delete
dr.Save
End If
Dim drs As List(of DataRow) = DataTables("用户登录状态表").SQLSelect("user_ID = '" & _username & "'") ’ _username全局变量,记录输入的账号时的用户名,此时可直接使用。
If drs IsNot Nothing Then
For Each dr1 As DataRow In drs
If dr1("state") = "0" Then
dr1.Delete
dr1.Save()
End If
Next
End If
3、在项目的计划中添加如下代码:计划的名称为:查询用户登录状态 我设置的时间间隔是30秒
Dim dr As DataRow = DataTables("用户登录状态表").SQLFind("Num = '" & _login_num & "'")
If dr IsNot Nothing Then
If dr("state") = "1" Then
dr("refresh_time") = Date.now
dr.Save
Else
MyTimers("查询用户登录状态").Enabled = False '防止不停跳出提示窗口
Messagebox.show("尊敬的:" & _username & " 您好, 您的账号在其它地方登录, 系统将被强行退出, 如有异常, 请联系管理员 !","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
Syscmd.Project.Exit(False)
End If
End If
[此贴子已经被作者于2019/4/26 10:49:54编辑过]