📄 server.frm
字号:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.1#0"; "RICHTX32.OCX"
Begin VB.Form Server
BorderStyle = 4 'Fixed ToolWindow
Caption = "校园及时通服务器"
ClientHeight = 2910
ClientLeft = 5190
ClientTop = 3705
ClientWidth = 4515
Icon = "server.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2910
ScaleMode = 0 'User
ScaleWidth = 4515
Visible = 0 'False
Begin VB.Timer Send_IP
Interval = 5000
Left = 75
Top = 90
End
Begin MSWinsockLib.Winsock Sock_IP
Left = 75
Top = 600
_ExtentX = 741
_ExtentY = 741
_Version = 327681
Protocol = 1
End
Begin VB.Timer Timer3
Interval = 60000
Left = 3675
Top = 225
End
Begin VB.CommandButton SYSETc
Caption = "系统设置"
Height = 270
Left = 3390
TabIndex = 17
ToolTipText = "单击可进入系统设置"
Top = 2670
Width = 1185
End
Begin VB.ListBox online
BackColor = &H00800000&
ForeColor = &H00C0C0FF&
Height = 2745
IntegralHeight = 0 'False
Left = 3420
TabIndex = 16
ToolTipText = "按Ctrl+F12可在后台运行"
Top = 0
Width = 1110
End
Begin VB.CommandButton Command3
Caption = "关于我"
Height = 285
Left = 3420
TabIndex = 15
ToolTipText = "关于作者"
Top = 2655
Width = 1170
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 510
Index = 0
Left = 1575
Picture = "server.frx":0442
ScaleHeight = 480
ScaleWidth = 480
TabIndex = 3
Top = 1290
Visible = 0 'False
Width = 510
End
Begin VB.Timer Timer2
Interval = 60000
Left = 1935
Top = 645
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 1000
Left = 2040
Top = 30
End
Begin MSWinsockLib.Winsock connect1
Index = 0
Left = 1290
Top = 675
_ExtentX = 741
_ExtentY = 741
_Version = 327681
LocalPort = 7777
End
Begin MSWinsockLib.Winsock listen
Left = 1245
Top = 75
_ExtentX = 741
_ExtentY = 741
_Version = 327681
LocalPort = 7777
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 510
Index = 3
Left = 1065
Picture = "server.frx":0884
ScaleHeight = 480
ScaleWidth = 480
TabIndex = 19
Top = 1290
Visible = 0 'False
Width = 510
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 510
Index = 2
Left = 555
Picture = "server.frx":0CC6
ScaleHeight = 480
ScaleWidth = 480
TabIndex = 18
Top = 1305
Visible = 0 'False
Width = 510
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 510
Index = 1
Left = 2115
Picture = "server.frx":1108
ScaleHeight = 480
ScaleWidth = 480
TabIndex = 2
Top = 1365
Visible = 0 'False
Width = 510
End
Begin VB.CommandButton Command4
Caption = "设管理员密码"
Height = 285
Left = 3420
TabIndex = 20
Top = 2390
Width = 1230
End
Begin VB.CommandButton Command5
Caption = "资料管理"
Height = 285
Left = 3420
TabIndex = 22
Top = 2115
Width = 1170
End
Begin VB.CommandButton Command2
Caption = "设置前景色"
Height = 285
Left = 3420
TabIndex = 13
ToolTipText = "设置前景色"
Top = 1845
Width = 1170
End
Begin RichTextLib.RichTextBox Reco
Height = 2025
Left = -45
TabIndex = 21
Top = -30
Width = 3480
_ExtentX = 6138
_ExtentY = 3572
_Version = 327681
Enabled = -1 'True
ReadOnly = -1 'True
ScrollBars = 2
MousePointer = 1
TextRTF = $"server.frx":154A
End
Begin VB.CheckBox C4
Caption = "自动侦测"
Height = 255
Left = 3360
Style = 1 'Graphical
TabIndex = 23
ToolTipText = "自动侦测用户是否掉线"
Top = 1035
Width = 1215
End
Begin VB.ComboBox t1
Height = 300
ItemData = "server.frx":17D4
Left = 3420
List = "server.frx":17E1
TabIndex = 14
ToolTipText = "项目框"
Top = 1290
Width = 1230
End
Begin VB.CommandButton reset
Caption = "系统重置(&R)"
Height = 390
Left = -30
TabIndex = 4
ToolTipText = "重新初始化,此举会使所有在线用户重新连接"
Top = 1980
Width = 1245
End
Begin VB.CommandButton Command1
Caption = "设置背景色"
Height = 285
Left = 3420
TabIndex = 12
ToolTipText = "设置背景色"
Top = 1575
Width = 1170
End
Begin VB.CheckBox C3
Caption = "后台运行"
Height = 255
Left = 3360
Style = 1 'Graphical
TabIndex = 11
ToolTipText = "启动后在后台运行"
Top = 765
Width = 1215
End
Begin VB.CheckBox C2
Caption = "记录密谈"
Height = 255
Left = 3345
Style = 1 'Graphical
TabIndex = 10
ToolTipText = "是否允许查看二人世界聊天记录"
Top = 495
Width = 1215
End
Begin VB.CheckBox C1
Caption = "自动加载"
Height = 255
Left = 3360
Style = 1 'Graphical
TabIndex = 9
ToolTipText = "Windows启动后自动加载"
Top = 240
Width = 1215
End
Begin VB.CommandButton smag
Caption = "系统广播(&S)"
Height = 390
Left = 2250
TabIndex = 1
ToolTipText = "发送广播"
Top = 1980
Width = 1245
End
Begin VB.TextBox Text1
BackColor = &H00404000&
ForeColor = &H00C0C0FF&
Height = 360
Left = -15
MultiLine = -1 'True
OLEDropMode = 2 'Automatic
TabIndex = 0
ToolTipText = "系统消息发送框"
Top = 2340
Width = 3435
End
Begin VB.Label sb
AutoSize = -1 'True
Caption = "正在侦听"
Height = 180
Index = 3
Left = 2250
TabIndex = 8
Top = 2700
Width = 720
End
Begin VB.Label sb
AutoSize = -1 'True
Caption = "状态:"
Height = 180
Index = 2
Left = 1800
TabIndex = 7
Top = 2700
Width = 450
End
Begin VB.Label sb
AutoSize = -1 'True
Caption = "0"
Height = 180
Index = 1
Left = 930
TabIndex = 6
Top = 2700
Width = 90
End
Begin VB.Label sb
AutoSize = -1 'True
Caption = "在线人数"
Height = 180
Index = 0
Left = 60
TabIndex = 5
Top = 2700
Width = 720
End
Begin VB.Image I2
Height = 570
Left = 1545
MouseIcon = "server.frx":1805
MousePointer = 99 'Custom
Picture = "server.frx":1B0F
Stretch = -1 'True
ToolTipText = "小巧形式"
Top = 1905
Visible = 0 'False
Width = 555
End
Begin VB.Image I1
Height = 570
Left = 1545
MouseIcon = "server.frx":1E19
MousePointer = 99 'Custom
Picture = "server.frx":2123
Stretch = -1 'True
ToolTipText = "扩展形式"
Top = 1905
Width = 555
End
Begin VB.Menu l
Caption = "menu"
Visible = 0 'False
Begin VB.Menu clearreco
Caption = "清除记录(&C)"
End
End
Begin VB.Menu see
Caption = "menu2"
Visible = 0 'False
Begin VB.Menu up
Caption = "前台运行(&U)"
End
Begin VB.Menu qqw
Caption = "-"
End
Begin VB.Menu aboutme
Caption = "关于我(&A)"
End
Begin VB.Menu endserver
Caption = "终止服务(&X)"
End
End
Begin VB.Menu q
Caption = "menu1"
Visible = 0 'False
Begin VB.Menu Seeip
Caption = "查看 IP"
End
Begin VB.Menu Tc
Caption = "踢出该用户"
End
End
End
Attribute VB_Name = "Server"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const EM_LINESCROLL = &HB6
Const EM_GETLINECOUNT = &HBA
Dim Endchr As String * 4
Private Declare Function SendMessageBynum Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal ProcessID As Long, ByVal ServiceFlags As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
'Private Const NIM_ADD = &H0
'Private Const NIM_MODIFY = &H1
'Private Const NIM_DELETE = &H2
'Private Const WM_MOUSEMOVE = &H200
'Private Const NIF_MESSAGE = &H1
'Private Const NIF_ICON = &H2
'Private Const NIF_TIP = &H4
Dim Connected As Integer '共占用过的WINSOCK数
Dim a As Integer
Dim Onlineuser As Integer, Commandf As Integer, Unb As Integer '在线人数 和 命令数字
Dim Sendmag As String, Mag As String, fname As String
Dim t As NOTIFYICONDATA
Dim rtn As String
Dim cc As ChooseColor
Public allow As Boolean, RunMode As Boolean, sf As Boolean, Ifexit As Boolean, SysM As Boolean, bCancel As Boolean
Public rw As Workspace '数据库工作空间
Public rs As Database '数据库对象
Public rc As Recordset '结果集
Private Type tInteger
aint As Integer
End Type
Private Type t2Byte
lByte As Byte
hByte As Byte
End Type
Private ii As tInteger
Private bb As t2Byte
Private Sub ProcessMessages()
Dim Message As Msg
Do While Not bCancel
WaitMessage
If PeekMessage(Message, Me.hwnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
Call up_Click
End If
DoEvents
Loop
End Sub
Private Sub aboutme_Click()
Readme.Show
End Sub
Private Sub C1_Click()
If Me.Visible = True Then Text1.SetFocus
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -