专家坐堂-UserLogging事件已经success，但是还是没登录成功~Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  UserLogging事件已经success，但是还是没登录成功~  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=124874)

--  作者：huangxueyao
--  发布时间：2018/9/15 11:49:00
--  UserLogging事件已经success，但是还是没登录成功~

Try

Dim cmd As New SQLCommand
cmd.ConnectionName= gs_strActiveConnLog
cmd.CommandText="Sel ect a.工号,a.账号,a.部门ID,a.用户名称,b.部门名称 from 用户名表 a left join 公司部门表 b on a.部门ID=b.部门编号"
Dim dt As DataTable=cmd.ExecuteReader
Dim st As String = e.UserName.Split(".")(0) & "." & e.UserName.Split(".")(1)
Dim dr1 As DataRow= dt.Find("部门名称=\'" & e.UserName.Split(".")(0) & "\' and 用户名称=\'" & e.UserName.Split(".")(1) & "\'")
If dr1 IsNot Nothing Then
PopMessage(e.UserName & "正在尝试登陆,已查询到用户信息!","提示", PopIconEnum.Infomation, 5)
e.Success = True \'允许用户登录
If dt.DataRows.Count>0 Then
\'添加所有同事为好友
For Each dr As DataRow In dt.DataRows
\'If (dr("部门名称") & "." & dr("用户名称")) <> e.UserName Then \'如果不是登录者本人
If (dr("部门名称") & "." & dr("用户名称")) <> st Then \'如果不是登录者本人
If e.Buddies.Contains(dr("部门名称") & "." & dr("用户名称") & "." & dr("账号"))=False Then
e.Buddies.Add(dr("部门名称") & "." & dr("用户名称") & "." & dr("账号"))
End If
End If
Next
End If
Else
PopMessage(e.UserName & "正在尝试登陆,但未能在数据库查询到相关数据,登录失败!","提示", PopIconEnum.Infomation, 5)
e.Success = False \'拒绝用户登录
e.Message= Functions.Execute("Xml发送信息","用户不存在!请重新确认用户名称!")
End If
Catch ex As Exception
e.Success = False
e.Message=Functions.Execute("Xml发送信息","服务器端错误:" & ex.Message)
End Try

症状如下：
1、代码已经执行到红色部分，也就是e.Success = True，但是UserLoged事件还是不会触发。这个是怎么回事？
2、我的UserName是由部门名称+用户名称+用户ID构成，在别的项目已经测试成功没问题的，而且当前也正常运行的。

--  作者：有点蓝
--  发布时间：2018/9/15 13:47:00
--

我测试帮助的例子没有问题。

UserLoged事件写了什么代码？

--  作者：huangxueyao
--  发布时间：2018/9/15 13:51:00
--

If Forms("主界面").Opened Then
Dim tb As Table = Forms("主界面").Controls("tblUser").Table
Try
Dim cmd As New SQLCommand
cmd.ConnectionName= gs_strActiveConnLog
cmd.CommandText="Sel ect a.工号,a.账号,a.部门ID,a.用户名称,b.部门名称 from 用户名表 a left join 公司部门表 b on a.部门ID=b.部门编号 where b.部门名称=\'" & e.UserName.Split(".")(0) & "\' and a.用户名称=\'" & e.UserName.Split(".")(1) & "\'"
Dim dt As DataTable=cmd.ExecuteReader
If dt.DataRows.Count > 0 Then
Dim dr As DataRow= dt.DataRows(0)
Dim tr As Row= tb.AddNew
For Each tc As Col In tb.Cols
If dt.DataCols.contains(tc.Name) Then
tr(tc.Name)=dr(tc.Name)
End If
Next
tr("上线时间")=Date.Now()
End If
tb.DataTable.AcceptChanges
PopMessage(e.UserName & "登陆成功!","提示", PopIconEnum.Infomation, 5)
Catch ex As Exception
MessageBox.Show(ex.Message,"错误提示",MessageBoxButtons.OK,MessageBoxIcon.Error)
End Try
End If

--  作者：huangxueyao
--  发布时间：2018/9/15 14:08:00
--
这个问题已经困扰我很多天了，项目已经在试运行，之前在局域网的时候，一直没问题。后来部署到服务器后，既有内部局域网访问，又有外网客户端访问，内部局域网都没有问题，可以正常登录，但是外网客户端有部分不能登录，有部分可以。

一开始还以为是服务器配置、客户端电脑，网络等问题，现在已经追踪到上面说的这个问题，服务器明明是可以收到客户端的登录信息的，但是就是无法登录。

我的是高开版，也不存在数量限制问题。

--  作者：有点蓝
--  发布时间：2018/9/15 14:52:00
--
msgbo("这里能不能弹出提示？")
If Forms("主界面").Opened Then
msgbo("2——这里能不能弹出提示？")
Dim tb As Table = Forms("主界面").Controls("tblUser").Table
Try
Dim cmd As New SQLCommand
……

如果是外网，有可能会产生NAT穿透的问题。

--  作者：huangxueyao
--  发布时间：2018/9/17 9:36:00
--
客户端收到的消息是服务器在规定时间内没有响应，
NAT穿透怎么解决？

--  作者：有点甜
--  发布时间：2018/9/17 9:43:00
--

以下是引用huangxueyao在2018/9/17 9:36:00的发言：
客户端收到的消息是服务器在规定时间内没有响应，
NAT穿透怎么解决？

1、如果提示【服务器在规定时间内没有响应】说明你客户端里面的代码有问题。加入msgbox，看服务器端那里能否弹出（UserLogging和UserLogged都加入msgbox测试）

2、把try catch去掉，避免一些错误没有被显示出来。

--  作者：huangxueyao
--  发布时间：2018/9/18 13:55:00
--
甜版，确实如您所说，客户端收到的消息是【服务器在规定时间内无回复】，然后服务器端在UserLogging事件中能执行到一楼说的位置，说明服务器是能够收到客户端的请求信息的，但是在UserLogged事件就没有反应。

客户端的代码有问题的话，也难解，因为是同样的客户端，有一些人可以，有一些人不可以。

--  作者：有点甜
--  发布时间：2018/9/18 14:36:00
--

1、把try catch去掉，避免一些错误没有被显示出来；

2、测试msgbox能否弹出，如果可以弹出，去掉msgbox以及UserLoged事件代码测试；

Try
    Dim cmd As New SQLCommand
    cmd.ConnectionName= gs_strActiveConnLog
    cmd.CommandText="Sel ect a.工号,a.账号,a.部门ID,a.用户名称,b.部门名称 from 用户名表 a left join 公司部门表 b on a.部门ID=b.部门编号"
    Dim dt As DataTable=cmd.ExecuteReader
    Dim st As String = e.UserName.Split(".")(0) & "." & e.UserName.Split(".")(1)
    Dim dr1 As DataRow= dt.Find("部门名称=\'" & e.UserName.Split(".")(0) & "\' and 用户名称=\'" & e.UserName.Split(".")(1) & "\'")
    If dr1 IsNot Nothing Then
        PopMessage(e.UserName & "正在尝试登陆,已查询到用户信息!","提示", PopIconEnum.Infomation, 5)
        e.Success = True \'允许用户登录
        If dt.DataRows.Count>0 Then
            \'添加所有同事为好友
            For Each dr As DataRow In dt.DataRows
                \'If (dr("部门名称") & "." & dr("用户名称")) <> e.UserName Then \'如果不是登录者本人
                If (dr("部门名称") & "." & dr("用户名称")) <> st Then \'如果不是登录者本人
                    If e.Buddies.Contains(dr("部门名称") & "." & dr("用户名称") & "." & dr("账号"))=False Then
                        e.Buddies.Add(dr("部门名称") & "." & dr("用户名称") & "." & dr("账号"))
                    End If
                End If
            Next
        End If
msgbox(123)
    Else
        PopMessage(e.UserName & "正在尝试登陆,但未能在数据库查询到相关数据,登录失败!","提示", PopIconEnum.Infomation, 5)
        e.Success = False \'拒绝用户登录
        e.Message= Functions.Execute("Xml发送信息","用户不存在!请重新确认用户名称!")
    End If
Catch ex As Exception
    e.Success = False
    e.Message=Functions.Execute("Xml发送信息","服务器端错误:" & ex.Message)
End Try
msgbox(456)

3、如果还是有问题，请尝试使用casestudy里面的qqserver以及qqclient，在不能正常连上的电脑里测试

--  作者：huangxueyao
--  发布时间：2018/9/18 20:41:00
--
1、测试自己的项目，在UserLogging和UserLogged都加入msgbox测试，但是情况还是老样子，能登陆的就能登陆，不行的就是去到logging事件，去不了logged事件。
2、按照版主意见，直接用casestudy里面的qqserver以及qqclient进行测试，在有问题的客户端那里，还是一样，收到【服务器在规定时间内未响应】的消息。

此主题相关图片如下：tim截图20180918203607.png

求帮忙~