📄 herochat_form.frm
字号:
Begin MSWinsockLib.Winsock SockSent
Index = 20
Left = 0
Top = 120
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin MSWinsockLib.Winsock SockSent
Index = 21
Left = 0
Top = 120
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin MSWinsockLib.Winsock SockSent
Index = 22
Left = 0
Top = 120
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin MSWinsockLib.Winsock SockSent
Index = 23
Left = 0
Top = 120
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin MSWinsockLib.Winsock SockSent
Index = 24
Left = 0
Top = 120
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin MSWinsockLib.Winsock SockSent
Index = 25
Left = 0
Top = 120
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin MSWinsockLib.Winsock SockSent
Index = 26
Left = 0
Top = 120
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin MSWinsockLib.Winsock SockSent
Index = 27
Left = 0
Top = 120
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin MSWinsockLib.Winsock SockSent
Index = 28
Left = 0
Top = 120
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin MSWinsockLib.Winsock SockSent
Index = 29
Left = 0
Top = 120
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin MSWinsockLib.Winsock SockSent
Index = 30
Left = 0
Top = 120
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.Timer Timer2
Interval = 100
Left = 840
Top = 120
End
Begin VB.Menu clearit
Caption = "清空(&C)"
Begin VB.Menu clear0
Caption = "清空全部"
End
Begin VB.Menu clear1
Caption = "清空公告"
End
Begin VB.Menu clear2
Caption = "清空聊天记录"
End
Begin VB.Menu clear3
Caption = "清空个人聊天记录"
End
End
Begin VB.Menu saveit
Caption = "保存(&S)"
Begin VB.Menu saveall
Caption = "保存聊天记录"
End
Begin VB.Menu saveone
Caption = "保存个人聊天记录"
End
End
Begin VB.Menu aboutme
Caption = "关于(&A)"
End
Begin VB.Menu exit
Caption = "退出(&E)"
End
End
Attribute VB_Name = "HeroChat_Server"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim YLinkN(1 To 24), YnowN(1 To 24), REQUEST, ExitAble As Boolean
Dim WHOTALK(1 To 24) As Boolean
Dim SingleTalk, M As Integer
Private Sub aboutme_Click()
'菜单“关于”
About.Show
End Sub
Private Sub AllChat_Change()
'自动保存聊天记录
If Len(AllChat.Text) > 30000 Then
Open App.Path & "\Chat" & Date & "-" & Left("0" & Time, 2) & "-" & M & ".txt" For Output As #1 ' 打开文件。
Print #1, AllChat.Text
M = M + 1
Close #1 ' 关闭文件
AllChat.Text = ""
End If
End Sub
Private Sub C_Click(Index As Integer)
'选中对话的对象
If Option2.Value = True Then WHOTALK(Index) = (C(Index).Value = Checked)
If Option3.Value = True And C(Index).Value = Checked Then M = Index
End Sub
Private Sub CL_Click()
'常用短语
Talk.Text = CL.Text
Talk.SetFocus
End Sub
Private Sub clear0_Click()
'菜单-清空所有记录
Talk.Text = ""
AllReport.Text = ""
AllChat.Text = ""
SinChat.Text = ""
End Sub
Private Sub clear1_Click()
'菜单-清空公告
AllReport.Text = ""
End Sub
Private Sub clear2_Click()
'菜单-清空全部聊天记录
AllChat.Text = ""
End Sub
Private Sub clear3_Click()
'清空个人聊天记录
SinChat.Text = ""
End Sub
Private Sub Command1_Click()
'停止连接
Command2.Enabled = True
REQUEST = Flase
Command1.Enabled = False
End Sub
Private Sub Command2_Click()
'请求连接
Command1.Enabled = True
REQUEST = True
Command2.Enabled = False
End Sub
Private Sub saveall_Click()
'保存聊天记录
Open App.Path & "\Chat" & Date & "-" & Left("0" & Time, 2) & "-" & M & ".txt" For Output As #1 ' 打开文件。
Print #1, AllChat.Text
M = M + 1
Close #1 ' 关闭文件
MsgBox "保存完毕！", vbInformation, "提示"
End Sub
Private Sub Sendit_Click()
'发送消息按钮
On Error GoTo SDSD
If Talk.Text <> "" Then
Dim I As Integer
For I = 1 To 24
If YLinkN(I) = True And C(I) = Checked Then
DoEvents
Sleep (50)
SockSent(I).SendData "服：" & "[" & Time & "]" & Chr(13) & Chr(10) & Talk.Text
SinChat.Text = "服：" & Talk.Text & "[" & Time & "]" & Chr(13) & Chr(10) & SinChat.Text
'AllChat.Text = "服：" & Talk.Text & "[" & Time & "]" & Chr(13) & Chr(10) & AllChat.Text
AllChat.Text = "服：" & Talk.Text & Chr(13) & Chr(10) & AllChat.Text
End If
Next I
Talk.SelStart = 0: Talk.SelLength = Len(Talk.Text)
End If
Exit Sub
SDSD:
YLinkN(I) = False: L(I).Caption = Right("0" & I, 2) & ":" & "离线": L(I).ForeColor = RGB(255, 0, 0): C(I).Enabled = False
End Sub
Private Sub saveone_Click()
'保存个人聊天记录
Open App.Path & "\Chat" & Date & "-" & Left("0" & Time, 2) & "-" & M & ".txt" For Output As #1 ' 打开文件。
Print #1, SinChat.Text
M = M + 1
Close #1 ' 关闭文件
MsgBox "保存完毕！", vbInformation, "提示"
End Sub
Private Sub Command6_Click()
'中断所有连接
Command2.Enabled = True
REQUEST = False
Command1.Enabled = False
For I = 1 To 24
YLinkN(I) = False: L(I).ForeColor = RGB(255, 0, 0): L(I).Caption = Right("0" & I, 2) & ":" & "离线": C(I).Enabled = False
SockSent(I).Close
Next I
End Sub
Private Sub exit_Click()
'退出
Command1_Click
Unload Me
End Sub
Private Sub Form_Load()
'程序启动
SingleTalk = 1: ExitAble = False: M = 0
Dim I As Integer
For I = 1 To 24
YLinkN(I) = False: L(I).ForeColor = RGB(255, 0, 0): L(I).Caption = Right("0" & I, 2) & ":" & "离线": C(I).Enabled = False
Next I
REQUEST = True
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'程序退出
Command1_Click
'If ExitAble <> True Then ExitAble = True: Cancel = 2
Unload Me
End Sub
Private Sub Option1_Click()
'单选按钮-所有用户
Dim I As Integer
For I = 1 To 24
C(I).Value = Checked
Next I
End Sub
Private Sub Option2_Click()
'单选按钮-在线用户
Dim I As Integer
For I = 1 To 24
If C(I).Enabled = True Then C(I).Value = Checked
If C(I).Enabled = False Then C(I).Value = Unchecked
Next I
End Sub
Private Sub Option3_Click()
'单选按钮-去消所选
Dim I As Integer
For I = 1 To 24
C(I).Value = Unchecked
Next I
End Sub
Private Sub SinChat_Change()
'自动保存聊天记录
If Len(SinChat.Text) > 30000 Then
Open App.Path & "\Chat" & Date & "-" & Left("0" & Time, 2) & "-" & M & ".txt" For Output As #1 ' 打开文件。
Print #1, SinChat.Text
M = M + 1
Close #1 ' 关闭文件
SinChat.Text = ""
End If
End Sub
Private Sub SockSent_Close(Index As Integer)
'连接结束
SockSent(Index).Close
YLinkN(Index) = False: L(Index).Caption = Right("0" & Index, 2) & ":" & "离线": L(Index).ForeColor = RGB(255, 0, 0): C(Index).Enabled = False
'SockSent(Index).Connect
End Sub
Private Sub SockSent_DataArrival(Index As Integer, ByVal bytesTotal As Long)
'接收信息
'On Error GoTo SSSS
Dim SourceL, DistanceR As String
Dim AcepData As String
SockSent(Index).GetData AcepData
YLinkN(Index) = True
DistanceR = Right(AcepData, 2)
SourceL = Left(AcepData, 2)
If Right(AcepData, 15) = "herochat_online" Then
AllReport.Text = Left(AcepData, Len(AcepData) - 15) & "[" & Time & "]" & Chr(13) & Chr(10) & AllReport.Text
If GetFileAttributes(App.Path & "\Global.wav") <> -1 Then
Playsound (App.Path & "\Global.wav")
End If
For I = 1 To 24
If YLinkN(I) = True Then
DoEvents
Sleep (50)
SockSent(I).SendData AcepData
End If
Next I
L(Index).Caption = Right("0" & Index, 2) & ":" & "在线": L(Index).ForeColor = RGB(0, 0, 255): C(Index).Enabled = True
Label1(Index).Caption = Left(Right(AcepData, Len(AcepData) - 3), Len(AcepData) - 21)
Exit Sub
End If
If Right(DistanceR, 1) = "服" Then
'SinChat.Text = SourceL & Right(Left(AcepData, Len(AcepData) - 1), Len(AcepData) - 3) & "[" & Time & "]" & Chr(13) & Chr(10) & SinChat.Text
'AllChat.Text = SourceL & Right(Left(AcepData, Len(AcepData) - 1), Len(AcepData) - 3) & "[" & Time & "]" & Chr(13) & Chr(10) & AllChat.Text
SinChat.Text = SourceL & Right(Left(AcepData, Len(AcepData) - 1), Len(AcepData) - 3) & Chr(13) & Chr(10) & SinChat.Text
AllChat.Text = SourceL & Right(Left(AcepData, Len(AcepData) - 1), Len(AcepData) - 3) & Chr(13) & Chr(10) & AllChat.Text
If GetFileAttributes(App.Path & "\msg.wav") <> -1 Then
Playsound (App.Path & "\msg.wav")
End If
Else
'AllChat.Text = SourceL & " to " & DistanceR & ":" & Right(Left(AcepData, Len(AcepData) - 2), Len(AcepData) - 4) & "[" & Time & "]" & Chr(13) & Chr(10) & AllChat.Text
AllChat.Text = SourceL & " 和 " & DistanceR & "说" & Right(Left(AcepData, Len(AcepData) - 2), Len(AcepData) - 5 - Len(Label1(Index).Caption)) & Chr(13) & Chr(10) & AllChat.Text
If GetFileAttributes(App.Path & "\msg.wav") <> -1 Then
Playsound (App.Path & "\msg.wav")
End If
If YLinkN(DistanceR) = True Then SockSent(DistanceR).SendData Left(AcepData, Len(AcepData) - 2)
'转发消息
End If
L(Index).Caption = Right("0" & Index, 2) & ":" & "在线": L(Index).ForeColor = RGB(0, 0, 255): C(Index).Enabled = True
Exit Sub
SSSS:
'YLinkN(DistanceR) = False: L(DistanceR).Caption = Right("0" & DistanceR, 2) & ":" & "离线": L(DistanceR).ForeColor = RGB(255, 0, 0): C(DistanceR).Enabled = False
End Sub
Private Sub Timer1_Timer()
'定时器，检测连接请求
If REQUEST = False Then Exit Sub
On Error GoTo GGGG
If YLinkN(1) = False Then SockSent(1).Close: SockSent(1).RemoteHost = "192.168.0.1": SockSent(1).RemotePort = 3050: SockSent(1).Connect: Label1(1).Caption = ""
If YLinkN(2) = False Then SockSent(2).Close: SockSent(2).RemoteHost = "192.168.0.2": SockSent(2).RemotePort = 3100: SockSent(2).Connect: Label1(2).Caption = ""
If YLinkN(3) = False Then SockSent(3).Close: SockSent(3).RemoteHost = "192.168.0.3": SockSent(3).RemotePort = 3150: SockSent(3).Connect: Label1(3).Caption = ""
If YLinkN(4) = False Then SockSent(4).Close: SockSent(4).RemoteHost = "192.168.0.4": SockSent(4).RemotePort = 3200: SockSent(4).Connect: Label1(4).Caption = ""
If YLinkN(5) = False Then SockSent(5).Close: SockSent(5).RemoteHost = "192.168.0.5": SockSent(5).RemotePort = 3250: SockSent(5).Connect: Label1(5).Caption = ""
If YLinkN(6) = False Then SockSent(6).Close: SockSent(6).RemoteHost = "192.168.0.6": SockSent(6).RemotePort = 3300: SockSent(6).Connect: Label1(6).Caption = ""
If YLinkN(7) = False Then SockSent(7).Close: SockSent(7).RemoteHost = "192.168.0.7": SockSent(7).RemotePort = 3350: SockSent(7).Connect
If YLinkN(8) = False Then SockSent(8).Close: SockSent(8).RemoteHost = "192.168.0.8": SockSent(8).RemotePort = 3400: SockSent(8).Connect
If YLinkN(9) = False Then SockSent(9).Close: SockSent(9).RemoteHost = "192.168.0.9": SockSent(9).RemotePort = 3450: SockSent(9).Connect
If YLinkN(10) = False Then SockSent(10).Close: SockSent(10).RemoteHost = "192.168.0.10": SockSent(10).RemotePort = 3500: SockSent(10).Connect
'If YLinkN(11) = False Then SockSent(11).Close: SockSent(11).RemoteHost = "192.168.0.11": SockSent(11).RemotePort = 3550: SockSent(11).Connect
'If YLinkN(12) = False Then SockSent(12).Close: SockSent(12).RemoteHost = "192.168.0.12": SockSent(12).RemotePort = 3600: SockSent(12).Connect
'If YLinkN(13) = False Then SockSent(13).Close: SockSent(13).RemoteHost = "192.168.0.13": SockSent(13).RemotePort = 3650: SockSent(13).Connect
'If YLinkN(14) = False Then SockSent(14).Close: SockSent(14).RemoteHost = "192.168.0.14": SockSent(14).RemotePort = 3700: SockSent(14).Connect
'If YLinkN(15) = False Then SockSent(15).Close: SockSent(15).RemoteHost = "192.168.0.15": SockSent(15).RemotePort = 3750: SockSent(15).Connect
'If YLinkN(16) = False Then SockSent(16).Close: SockSent(16).RemoteHost = "192.168.0.16": SockSent(16).RemotePort = 3800: SockSent(16).Connect
'If YLinkN(17) = False Then SockSent(17).Close: SockSent(17).RemoteHost = "192.168.0.17": SockSent(17).RemotePort = 3850: SockSent(17).Connect
'If YLinkN(18) = False Then SockSent(18).Close: SockSent(18).RemoteHost = "192.168.0.18": SockSent(18).RemotePort = 3900: SockSent(18).Connect
'If YLinkN(19) = False Then SockSent(19).Close: SockSent(19).RemoteHost = "192.168.0.19": SockSent(19).RemotePort = 3950: SockSent(19).Connect
'If YLinkN(20) = False Then SockSent(20).Close: SockSent(20).RemoteHost = "192.168.0.20": SockSent(20).RemotePort = 4000: SockSent(20).Connect
'If YLinkN(21) = False Then SockSent(21).Close: SockSent(21).RemoteHost = "192.168.0.21": SockSent(21).RemotePort = 4050: SockSent(21).Connect
'If YLinkN(22) = False Then SockSent(22).Close: SockSent(22).RemoteHost = "192.168.0.22": SockSent(22).RemotePort = 4100: SockSent(22).Connect
'If YLinkN(23) = False Then SockSent(23).Close: SockSent(23).RemoteHost = "192.168.0.23": SockSent(23).RemotePort = 4150: SockSent(23).Connect
'If YLinkN(24) = False Then SockSent(24).Close: SockSent(24).RemoteHost = "192.168.0.24": SockSent(24).RemotePort = 4200: SockSent(24).Connect
If ExitAble = True Then Unload Me
GGGG:
End Sub
Private Sub Timer2_Timer()
'程序中显示的时间
T.Caption = Right("0" & Time, 8)
End Sub
Private Function LenStr(Source As String) As String
'转换信息
Dim SLength, I, J As Integer
Dim GG As Boolean
GG = False
J = 0
SLength = Len(Source)
For I = 1 To SLength
If Asc(Right(Left(Source, I), 1)) > 255 Or Asc(Right(Left(Source, I), 1)) < 0 Then LenStr = Left(Source, J): GG = True: Exit For
J = J + 1
Next I
If GG = False Then LenStr = Source
End Function
Public Sub Playsound(WavFile As String)
'播放声音
On Error Resume Next
Call sndPlaySound(WavFile$, SND_FLAG)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -