lanchat.frm

一款师生对话的变成系统,有兴趣的人可以下来看看参考

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form LanChat 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "师生对话[学生]"
   ClientHeight    =   4305
   ClientLeft      =   3750
   ClientTop       =   3120
   ClientWidth     =   6120
   Icon            =   "LanChat.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   4305
   ScaleWidth      =   6120
   Begin VB.CommandButton Command2 
      Caption         =   "隐藏"
      Height          =   300
      Left            =   5280
      TabIndex        =   10
      Top             =   60
      Width           =   735
   End
   Begin VB.TextBox C3 
      Alignment       =   1  'Right Justify
      Enabled         =   0   'False
      Height          =   270
      Left            =   1920
      TabIndex        =   9
      Top             =   90
      Width           =   375
   End
   Begin VB.ComboBox C2 
      Height          =   300
      ItemData        =   "LanChat.frx":044A
      Left            =   3840
      List            =   "LanChat.frx":046F
      TabIndex        =   7
      Text            =   "你好！"
      Top             =   60
      Width           =   1335
   End
   Begin VB.ComboBox C1 
      Height          =   300
      ItemData        =   "LanChat.frx":050D
      Left            =   2760
      List            =   "LanChat.frx":055F
      TabIndex        =   4
      Text            =   "师"
      Top             =   60
      Width           =   615
   End
   Begin VB.TextBox Text2 
      ForeColor       =   &H00000000&
      Height          =   3255
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   3
      Top             =   960
      Width           =   5895
   End
   Begin VB.CommandButton Command1 
      Caption         =   "发送"
      Height          =   375
      Left            =   5280
      TabIndex        =   2
      ToolTipText     =   "按F1键也可以发送！"
      Top             =   480
      Width           =   735
   End
   Begin VB.TextBox Text1 
      ForeColor       =   &H00000000&
      Height          =   375
      Left            =   120
      TabIndex        =   1
      ToolTipText     =   "不能说“空话”。按F1键也可以发送！"
      Top             =   480
      Width           =   5055
   End
   Begin MSWinsockLib.Winsock SockAcep 
      Left            =   0
      Top             =   960
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Label Label4 
      Caption         =   "使用序列："
      Height          =   255
      Left            =   1080
      TabIndex        =   8
      Top             =   120
      Width           =   975
   End
   Begin VB.Label Label3 
      Caption         =   "常用："
      Height          =   195
      Left            =   3360
      TabIndex        =   6
      Top             =   120
      Width           =   855
   End
   Begin VB.Label Label2 
      Caption         =   "给："
      Height          =   195
      Left            =   2400
      TabIndex        =   5
      Top             =   120
      Width           =   375
   End
   Begin VB.Label Label1 
      Caption         =   "状态：OFF"
      ForeColor       =   &H000000FF&
      Height          =   195
      Left            =   80
      TabIndex        =   0
      Top             =   120
      Width           =   855
   End
End
Attribute VB_Name = "LanChat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Dim M, S As String
Dim IndexNum As Integer

Dim Link As Boolean



Private Sub C1_Click()
S = C1.Text
End Sub

Private Sub C1_KeyDown(KeyCode As Integer, Shift As Integer)
MsgBox " 对不起！你不能更改此设置！  ", 16:
C1.Text = S
Text1.SetFocus
End Sub

Private Sub C2_Click()
Text1.Text = Text1.Text & C2.Text: Text1.SetFocus
End Sub





Private Sub Command1_Click()
On Error GoTo SSSS
Dim OKYES As Integer
If Text1.Text = "" Then MsgBox "  别说“空话”！  ", 16: Text1.SetFocus: Exit Sub
If M = Text1.Text Then OKYES = MsgBox("你说了重复的话，确实要重复吗？", 33 + 256)
If OKYES = 2 Then Text1.SetFocus: Exit Sub
If Text1.Text <> "" Then
If Link = False Then MsgBox "  不能与主机连接！", 16: Exit Sub
SockAcep.SendData "0" & IndexNum & "：" & Text1.Text & TranStr(C1.Text, 2): Text1.SelStart = 0: Text1.SelLength = Len(Text1.Text)
Text2.Text = "0" & IndexNum & "：" & Text1.Text & "[" & Time & "]" & Chr(13) & Chr(10) & Text2.Text
End If
M = Text1.Text
Exit Sub
SSSS:
SockAcep_Close
End Sub

Private Sub Command2_Click()
Me.Visible = False
End Sub

Private Sub Form_Load()
If Left(Right(SockAcep.LocalIP, 4), 1) = "." Then IndexNum = Right(SockAcep.LocalIP, 3)
If Left(Right(SockAcep.LocalIP, 3), 1) = "." Then IndexNum = Right(SockAcep.LocalIP, 2)
If Left(Right(SockAcep.LocalIP, 2), 1) = "." Then IndexNum = Right(SockAcep.LocalIP, 1)
C3.Text = IndexNum
SockAcep.LocalPort = 3000 + 50 * IndexNum
SockAcep.Listen
Link = False
S = "师"
Me.Caption = "师生对话[" & IndexNum & "]"

End Sub



Private Sub SockAcep_Close()
SockAcep.Close
SockAcep.Listen
Label1.Caption = "状态：OFF":: Label1.ForeColor = RGB(255, 0, 0): Link = False
End Sub

Private Sub SockAcep_ConnectionRequest(ByVal requestID As Long)
On Error GoTo DDDD
SockAcep.Close
SockAcep.Accept requestID
SockAcep.SendData Right("0" & C3.Text, 2) & "：OK师": Label1.Caption = "状态：OK!": Label1.ForeColor = RGB(0, 255, 0): Link = True
Exit Sub
DDDD:
SockAcep_Close
End Sub

Private Sub SockAcep_DataArrival(ByVal bytesTotal As Long)
Dim Acep As String
Me.Visible = True
SockAcep.GetData Acep
If Right(Acep, 10) = "CloseM7802" Then
MsgBox "程序被关闭！"
SockAcep.Close:: Unload Me: Exit Sub
End If

If Right(Acep, 10) = "CloseW7806" Then
SockAcep.Close: ExitWindowsEx 1, 1: Exit Sub
End If
Text2.Text = Acep & "[" & Time & "]" & Chr(13) & Chr(10) & Text2.Text

End Sub
Private Function TranStr(SourceStr As String, Lengths As Integer) As String
Dim Slength, i, J, K As Integer
Dim GG, ff As Boolean
J = 0
Slength = Len(SourceStr)
For i = 1 To Slength
If Asc(Right(Left(SourceStr, i), 1)) > 255 Or Asc(Right(Left(SourceStr, i), 1)) < 0 Then J = J + 1
K = K + 1
If K + J = Lengths Then GG = True: Exit For
If K + J > Lengths Then ff = True: Exit For
Next i
If GG = True Then
 TranStr = Left(SourceStr, K)
   Else
     If ff = True Then
       SourceStr = Left(SourceStr, K - 1)
       TranStr = TranStr(SourceStr, Lengths)
     Else
      Slength = Slength + J
      If Slength <= Lengths Then TranStr = SourceStr & String(Lengths - Slength, " ")
End If
End If
End Function

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 112 Then Command1_Click '按F1键也可以发送！
End Sub