主题：[分享]狐表自定义用户登录的问题和对策2

1、如果甲以甲的用户名登录，乙也用甲的用户名登录，显然是不合理的，因此，需要增加一张登录管理表，含四列内容，在登录窗口代码中进行控制，点“登录”后的代码如下：

'考虑用户切换,从登录管理表中删除本机当前已登录用户再切换,在退出系统的菜单按钮代码前和关闭项目事件前的代码中也同样适用,只是删除 if ...和 end if 两行，并增加保存命令：DataTables("登录管理").save()，保证用户登录记录删除成功。在登录窗口的“退出”按钮中也要增加该保存命令。
Dim i As Integer
If _username IsNot Nothing Then
    MainTable=Tables("登录管理")
    With CurrentTable
        i = .Findrow("登录用户= '" & _username & "'",0,False)
        If i>-1 Then
            .Rows(i).Delete()
        End If
    End With
End If

'登录处理
Dim UserName As String = e.Form.Controls("UserName").Value
Dim cmd As New SQLCommand
Dim dt As DataTable
Dim dr0,dr1 As DataRow
cmd.C
If UserName = ""  Then
    Messagebox.show("请选择用户!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
    Return
End If
cmd.CommandText = "Select * From {项目经理管理} Where [项目经理] = '" & UserName & "'"
If cmd.CommandText  = ""  Then
    Messagebox.show("用户名错!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
    Return
End If
dt = cmd.ExecuteReader
dr1 = dt.DataRows(0)
If e.Form.Controls("PassWord").Value = dr1("用户密码") Then
    _UserName = UserName
    _UserRoles = dr1("用户角色")
    If _UserRoles ="实体会计" Or  _UserRoles ="实体领导" Then
        _UserGroup = dr1("实体名称")
    End If
    e.Form.Close
Else
    Messagebox.show("密码错误!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
    Return
End If
FileSys.WriteAllText("d:\项目管理系统\数据文件\用户登录.txt",_username,False, Encoding.Default)

'判断同名用户是否已经登录,并作相应处理
With DataTables("登录管理")
    dr0 = .Find("登录用户= '" & _username & "'")
'已登录的处理
    If dr0 IsNot Nothing Then
        Dim name As String=dr0("电脑名称")
        Dim IP As String=dr0("登录地址")
        Dim rq As Date=dr0("登录时间")
        MessageBox.Show("该用户已登录, 请确认或联系管理员或开发者!" & vbcrlf & "其电脑名称是 " & name & vbcrlf & "其登录地址是 " & IP & vbcrlf & "其登录时间是 " & rq,"错误",MessageBoxButtons.ok,MessageBoxIcon.Error)
        Syscmd.Project.Exit(False) '退出系统
    End If
'未登录的处理
    Dim HostName As String
    HostName=System.Net.Dns.GetHostName '获得本机的机器名
    Dim IPAdress As System.Net.IPAddress
    IPAdress=System.Net.Dns.GetHostByName(HostName).AddressList.GetValue(0) '获得本机的IP
    Dim dt2 As Date
    cmd.CommandText = "Select GetDate()"
    dt2 = cmd.ExecuteScalar()'服务器的日期和时间
    dr0 = .AddNew()
    dr0("登录用户")=_username
    dr0("电脑名称")=HostName
    dr0("登录地址")=IPAdress.ToString
    dr0("登录时间")=dt2
    .save()
End With

2、项目文件路径如果不是想象的那样，会导致权限控制失效，需在BeforeOpenProject事件中增加下列代码。其中.foxdb和.foxex文件路径不同。

Dim s As String = FileSys.GetParentPath(e.File)
If e.file<>"D:\项目管理系统\设计资料\项目管理系统.foxdb" Then
    If s<>"D:\项目管理系统\数据文件\project" Then
        e.cancel=True
        e.HideSplashForm = True
        MessageBox.Show("项目文件安装路径错误, 请更正后重试!","警告",MessageBoxButtons.ok,MessageBoxIcon.warning)
    End If
End If

3、屏幕字体不能用125％显示，否则会出错。

希望大家多多交流心得。