form1.frm

未完成的聊天软件

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5505
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   8460
   LinkTopic       =   "Form1"
   ScaleHeight     =   5505
   ScaleWidth      =   8460
   StartUpPosition =   3  '窗口缺省
   Begin VB.Timer Timer1 
      Left            =   3960
      Top             =   3240
   End
   Begin MSWinsockLib.Winsock tcpserver 
      Index           =   0
      Left            =   4560
      Top             =   3240
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      LocalPort       =   1001
   End
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   5160
      Top             =   3120
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      MaskColor       =   12632256
      _Version        =   393216
   End
   Begin VB.Data Data1 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   375
      Left            =   480
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   ""
      Top             =   6000
      Width           =   1935
   End
   Begin VB.TextBox Textout 
      BackColor       =   &H00E0E0E0&
      Height          =   1575
      Left            =   120
      TabIndex        =   3
      Top             =   3840
      Width           =   5775
   End
   Begin VB.Frame Frame2 
      Caption         =   "服务器状态："
      Height          =   1575
      Left            =   6000
      TabIndex        =   2
      Top             =   3840
      Width           =   2415
      Begin VB.Label txtonline 
         Caption         =   "上线："
         Height          =   255
         Left            =   120
         TabIndex        =   11
         Top             =   1080
         Width           =   1335
      End
      Begin VB.Label txtport 
         Caption         =   "端口："
         Height          =   255
         Left            =   120
         TabIndex        =   10
         Top             =   720
         Width           =   1335
      End
      Begin VB.Label txtip 
         Caption         =   "地址："
         Height          =   255
         Left            =   120
         TabIndex        =   9
         Top             =   360
         Width           =   2295
      End
   End
   Begin MSComctlLib.ListView users 
      Height          =   3735
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   5775
      _ExtentX        =   10186
      _ExtentY        =   6588
      View            =   3
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   14737632
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin VB.Frame Frame1 
      Caption         =   "服务器控制："
      Height          =   3615
      Left            =   6000
      TabIndex        =   0
      Top             =   120
      Width           =   2415
      Begin VB.CommandButton Command5 
         Caption         =   "Command5"
         Height          =   375
         Left            =   240
         TabIndex        =   8
         Top             =   2880
         Width           =   975
      End
      Begin VB.CommandButton Command4 
         Caption         =   "Command4"
         Height          =   375
         Left            =   240
         TabIndex        =   7
         Top             =   2280
         Width           =   975
      End
      Begin VB.CommandButton Command3 
         Caption         =   "Command3"
         Height          =   375
         Left            =   240
         TabIndex        =   6
         Top             =   1680
         Width           =   975
      End
      Begin VB.CommandButton Command2 
         Caption         =   "Command2"
         Height          =   375
         Left            =   240
         TabIndex        =   5
         Top             =   1080
         Width           =   975
      End
      Begin VB.CommandButton Command1 
         Caption         =   "Command1"
         Height          =   375
         Left            =   240
         TabIndex        =   4
         Top             =   480
         Width           =   975
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command2_Click()
userpsw = "abcsa10#617883"
i = 1
While Mid(userpsw, i, 1) <> "#"
i = i + 1
user = Mid(userpsw, 1, i - 1)
psw = Mid(userpsw, i + 1)
Wend
Data1.RecordSource = "select userpassword from users where username='abcsa'"
Data1.Refresh
MsgBox Data1.Recordset.Fields("userpassword"), vbInformation, "提示"
If Data1.Recordset.RecordCount = 0 Then
   MsgBox "用户不存在", vbInformation, "提示"
ElseIf psw <> Data1.Recordset.Fields("userpassword") Then
  MsgBox "失败/", vbInformation, "提示"
Else
 MsgBox "成功啦", vbInformation, "提示"
End If
End Sub

Private Sub Form_Load()
num = 0
numonline = 0
Data1.Connect = "Access"
Data1.DatabaseName = App.Path + "\date\users.mdb"
tcpserver(0).Close
tcpserver(0).Protocol = sckTCPProtocol
tcpserver(0).LocalPort = 1001 '将 LocalPort 属性设置为一个整数
 tcpserver(0).Listen
 txtip.Caption = "地址:" & tcpserver(0).LocalIP
  txtport.Caption = "端口:" & tcpserver(0).LocalPort
 txtonline.Caption = "上线:" & numonline & "台"
Dim clmX As ColumnHeader '标题栏
Dim itmX As ListItem '列表项目
Dim Counter As Long '计数器
Dim Fname As String '读取文件名
Dim dname As String '增强列表框完整路径名称
  users.View = lvwReport
  users.ColumnHeaders.Add , , "头像", 800, 0
  users.ColumnHeaders.Add , , "昵称", 1200, 0
  users.ColumnHeaders.Add , , "级别", 600, 0
  users.ColumnHeaders.Add , , "ip地址", 2000, 0
  users.ColumnHeaders.Add , , "端口", 800, 0
  users.ColumnHeaders.Add , , "上线时间", 1200, 0
  users.ColumnHeaders.Add , , "通道号", 400, 0
  users.ListItems.Clear '清除过期的列表项目
 users.ListItems.Add , "users"
users.ListItems(1).ListSubItems.Add , "端口", 4000

End Sub


Private Sub tcpserver_ConnectionRequest(Index As Integer, ByVal requestID As Long)
If Index = 0 Then
num = num + 1
numonline = numonline + 1
Load tcpserver(num)
tcpserver(num).LocalPort = 0
tcpserver(num).Accept requestID
txtonline.Caption = "上线:" & numonline & "台"
End If
End Sub

Private Sub tcpserver_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim sdata As String
Dim sname As String
Dim userpsw As String
Dim user As String
Dim psw As String
Dim snd As String
Dim strsend As String
tcpserver(Index).GetData sdata
Textout.Text = Textout.Text + sdata
sname = Left(sdata, 4)
Select Case sname
Case "use:"
userpsw = Mid(sdata, 5)
i = 1
While Mid(userpsw, i, 1) <> "#"
i = i + 1
user = Mid(userpsw, 1, i - 1)
psw = Mid(userpsw, i + 1)
Wend
Data1.RecordSource = "select users.userpassword from users where users.username='user'"
Data1.Refresh
MsgBox "收到命令", vbInformation, "提示"
If Data1.Recordset.RecordCount = 0 Then
  strsend = "snbk:no" '返回用户不存在
  tcpserver(Index).SendData strsend
ElseIf psw <> Data1.Recordset.Fields("userpassword") Then
        strsend = "snbk:no"  '返回密码错误
 tcpserver(Index).SendData strsend
Else
 strsend = "snbk:yes"  '返回用户密码正确
 tcpserver(Index).SendData strsend
End If

Case "snd:"
MsgBox "收到信息", vbInformation, "提示"
Case "con:"
MsgBox "收到命令", vbInformation, "提示"
End Select
End Sub