frmlogin.frm

计算机网络与通信的知识

   End
   Begin VB.Shape Shape1 
      BackStyle       =   1  'Opaque
      BorderColor     =   &H80000007&
      BorderWidth     =   2
      FillColor       =   &H00FF0000&
      FillStyle       =   0  'Solid
      Height          =   1695
      Left            =   120
      Top             =   120
      Width           =   2895
   End
End
Attribute VB_Name = "frmLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim blnNewUser As Boolean           '是否新用户
Dim blnSendComplete As Boolean      '发送完成标志
Dim intTime As Integer              '计算连接超时
'============================
'  新用户选择
'============================
Private Sub chkNewUser_Click()
blnNewUser = Not blnNewUser
If blnNewUser Then
    Me.Height = 7200
Else
    Me.Height = 4500
End If
End Sub

'============================
'  关闭按钮
'============================
Private Sub cmdExit_Click()
Unload Me
End Sub
'==============================
' 用户登录 或 新用户注册
'==============================
Private Sub cmdLogin_Click()
Dim strTp As String, strSex As String

'输入验证

If blnNewUser Then   '新用户注册
    If TxtLenError(txtName, 6, "呢称") Then Exit Sub
    If VerifyComdDiv(txtName, "呢称") Then Exit Sub
    
    If TxtLenError(txtPwd1, 6, "新密码") Then Exit Sub
    If VerifyComdDiv(txtPwd1, "新密码") Then Exit Sub
    
    If TxtLenError(txtFancy, 10, "爱好") Then Exit Sub
    If VerifyComdDiv(txtFancy, "爱好") Then Exit Sub
    
    If StrComp(Trim(txtPwd1.Text), Trim(txtPwd2.Text)) <> 0 Then
        MsgBox "密码不符！请重新输入！", 16, "ICQ客户"
        txtPwd1.Text = ""
        txtPwd2.Text = ""
        txtPwd1.SetFocus
        Exit Sub
    End If
Else       '用户登录
    If Not IsNumeric(txtAccount.Text) Then
        MsgBox "非法的用户号！", 16, "ICQ客户"
        txtAccount.Text = ""
        txtAccount.SetFocus
        Exit Sub
    End If
    If TxtLenError(txtPwd, 6, "密码") Then Exit Sub
    If VerifyComdDiv(txtPwd, "密码") Then Exit Sub
End If
'连接服务器
MousePointer = 11
If wskClient.State <> sckClosed Then wskClient.Close
wskClient.RemoteHost = Trim(txtSerIP.Text)
wskClient.RemotePort = 1001
Timer1.Enabled = False
intTime = 0
Timer1.Enabled = True
wskClient.Connect
Do
    DoEvents
Loop Until wskClient.State = sckConnected Or intTime > LINK_MAX_TIME
Timer1.Enabled = False
If wskClient.State <> sckConnected Then  '连接失败
    MsgBox "连接失败或超时，请检查与ICQ服务器的网络连接！", 16, "ICQ客户"
    MousePointer = 0
    If wskClient.State <> sckClosed Then wskClient.Close
    Exit Sub
End If
blnSendComplete = False
If blnNewUser Then
        '新用户注册
    strSex = "男"
    If optWoman.Value Then strSex = "女"
    strTp = "'" + Trim(txtName.Text) + "'," + _
            "'" + Trim(txtPwd1.Text) + "'," + _
            "'" + strSex + "'," + _
            "'" + Trim(txtFancy.Text) + "'"
    wskClient.SendData "1" + strCommandDiv + _
                        ClientRegister + strCommandDiv + _
                        strTp + strCommandDiv + "0"
Else
        '用户登录
    wskClient.SendData "1" + strCommandDiv + _
                        ClientLogin + strCommandDiv + _
                        Trim(txtPwd.Text) + strCommandDiv + _
                        Trim(txtAccount.Text)
End If
Do
    DoEvents
Loop Until blnSendComplete
End Sub


'============================
'  载入 窗体
'============================
Private Sub Form_Load()
Dim ctlTp As Control
Me.Height = 4500
chkNewUser.Value = 0
blnNewUser = False
For Each ctlTp In Me.Controls
    If TypeOf ctlTp Is TextBox Then ctlTp.Text = ""
Next
    '获取登录初始化信息
GetLoginMsg
txtSerIP.Text = strLoginIP
txtAccount.Text = strLoginAccount
txtPwd.Text = strLoginPwd
wskClient.RemotePort = 1001
Timer1.Enabled = False
End Sub
'============================
'  卸载 窗体
'============================
Private Sub Form_Unload(Cancel As Integer)
WskClientExit   '向服务器发退出命令，关闭WskClient
End Sub

Private Sub Timer1_Timer()
intTime = intTime + 1
End Sub

'============================
'  服务器返回命令字符串
'============================
Private Sub wskClient_DataArrival(ByVal bytesTotal As Long)
Dim strCmdResult As String, strCmdResultFlag As String * 1, strCmdString As String
Dim wdnTp As WordNode
Dim intTp As Integer, lngTp As Long

On Error GoTo WSKCLIENT_ERR
wskClient.GetData strCmdResult, vbString
strCmdResultFlag = Mid(strCmdResult, 1, CmdResultFlagNum)   '得到服务器返回命令结果标志
strCmdString = Mid(strCmdResult, CmdResultFlagNum + 1)        '得到服务器返回命令结果内容

Select Case strCmdResultFlag
    Case UserOnline, UserNoExist, UserPwdErr, UserNoRegister  '登录或注册失败
        DispMessage strCmdResultFlag
        If wskClient.State <> sckClosed Then wskClient.Close
    Case UserLogin  '登录成功
        DispMessage strCmdResultFlag
        strLoginIP = txtSerIP.Text
        strLoginAccount = txtAccount.Text
        strLoginPwd = txtPwd.Text
        SetLoginMsg  '保存登录时的用户号、密码、IP地址
        Me.Hide
        frmMain.Show
    Case UserRegisterAccount  '接收到用户注册号
        MsgBox "OK！恭喜您注册成功！您的用户号为：" + strCmdString + " 请牢记！以后您将用其进行登录！", 48, "ICQ客户"
        strLoginIP = txtSerIP.Text
        strLoginAccount = strCmdString
        strLoginPwd = txtPwd1.Text
        SetLoginMsg  '保存注册时的用户号、密码、IP地址
        Me.Hide
        frmMain.Show
    Case UserSendString   '接收到服务器转发来的字符串
        lngTp = 1
        For intTp = 1 To 3   '解析服务器返回的转发字符串
            wdnTp = GetInString(strCmdString, lngTp, CmdResultDiv)
            Select Case intTp
                Case 1
                    strCmdResult = wdnTp.strGet   '字符串内容
                Case 2
                    strRecvAccount = wdnTp.strGet   '发送方的用户号
                Case 3
                    strRecvName = wdnTp.strGet      '发送方呢称
            End Select
            lngTp = wdnTp.lngNextStart
        Next intTp
        If Not blnRecvMsgFrmLoad Then
            intDispMsgFlag = 2
            frmMessage.Show
        Else
            If intDispMsgFlag = 1 Then
                intDispMsgFlag = 3
                frmMessage.DispForm
            End If
        End If
        Beep
        frmMessage.labRecvAccount.Caption = strRecvAccount
        frmMessage.labRecvName.Caption = strRecvName
        frmMessage.txtRecv.Text = frmMessage.txtRecv.Text + strRecvName + "：" + strCmdResult + vbCrLf
        frmMessage.txtRecv.SelStart = Len(frmMessage.txtRecv.Text) - 1
    Case UserNotOnline
        MsgBox "用户 " + frmMessage.labSendName.Caption + "/" + frmMessage.labSendAccount.Caption + _
               " 不在线！", 16, "ICQ客户"
    Case UserOnlineRst
        strOnlineUser = strCmdString
        frmOnlineUser.Show 1, frmMain
    Case UserUpdatePwd
        MsgBox "OK！您的密码成功修改！", 48, "ICQ客户"
    Case UserNoUpdatePwd
        MsgBox "抱歉！密码修改失败！", 16, "ICQ客户"
End Select
MousePointer = 0
Exit Sub
WSKCLIENT_ERR:
    wskClientErr
End Sub

'===================================
' WinSock 发送完成事件
'===================================
Private Sub wskClient_SendComplete()
blnSendComplete = True
End Sub
'===================================
' 客户端退出ICQ网络系统（自定义）
'===================================
Private Sub WskClientExit()
If wskClient.State = sckConnected Then
    blnSendComplete = False
    On Error GoTo WSKCLIENT_ERR
    wskClient.SendData "1" + strCommandDiv + ClientExit + strCommandDiv + "0" + strCommandDiv + "0"
    Do
        DoEvents
    Loop Until blnSendComplete
    wskClient.Close
End If
Exit Sub
WSKCLIENT_ERR:
    wskClientErr
End Sub
'===================================
' 客户端显示登录或注册服务器的结果（自定义）
'===================================
Private Sub DispMessage(ByVal strCmdResultFlag As String)
Dim strTp As String
Select Case strCmdResultFlag
    Case UserOnline
        MsgBox "用户" + txtAccount.Text + "已在线！不允许重复登录！", 16, "ICQ客户"
    Case UserNoExist
        MsgBox "用户" + txtAccount.Text + "不存在！", 16, "ICQ客户"
    Case UserPwdErr
        MsgBox "用户" + txtAccount.Text + "密码不符！", 16, "ICQ客户"
    Case UserLogin
       MsgBox "用户" + txtAccount.Text + "登录成功！", 48, "ICQ客户"
    Case UserNoRegister
       MsgBox "抱歉！注册失败！", 16, "ICQ客户"
End Select
End Sub