📄 frmserver1.frm
字号:
Picture = "frmServer1.frx":32FA6
Key = ""
EndProperty
BeginProperty ListImage23 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":332C0
Key = ""
EndProperty
BeginProperty ListImage24 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":335DA
Key = ""
EndProperty
BeginProperty ListImage25 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":338F4
Key = ""
EndProperty
BeginProperty ListImage26 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":33C0E
Key = ""
EndProperty
BeginProperty ListImage27 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":33F28
Key = ""
EndProperty
BeginProperty ListImage28 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":34242
Key = ""
EndProperty
BeginProperty ListImage29 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":3455C
Key = ""
EndProperty
BeginProperty ListImage30 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":34876
Key = ""
EndProperty
BeginProperty ListImage31 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":34B90
Key = ""
EndProperty
BeginProperty ListImage32 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":34EAA
Key = ""
EndProperty
BeginProperty ListImage33 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":351C4
Key = ""
EndProperty
BeginProperty ListImage34 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":354DE
Key = ""
EndProperty
BeginProperty ListImage35 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":357F8
Key = ""
EndProperty
BeginProperty ListImage36 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":35B12
Key = ""
EndProperty
BeginProperty ListImage37 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":35E2C
Key = ""
EndProperty
BeginProperty ListImage38 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":36146
Key = ""
EndProperty
BeginProperty ListImage39 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":36460
Key = "Web"
EndProperty
BeginProperty ListImage40 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":3677A
Key = ""
EndProperty
BeginProperty ListImage41 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":36A94
Key = ""
EndProperty
BeginProperty ListImage42 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":36DAE
Key = ""
EndProperty
BeginProperty ListImage43 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":370C8
Key = "vbAccelerator"
EndProperty
BeginProperty ListImage44 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":373E2
Key = ""
EndProperty
BeginProperty ListImage45 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":375BC
Key = ""
EndProperty
BeginProperty ListImage46 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmServer1.frx":3790E
Key = ""
EndProperty
EndProperty
End
Begin VB.Label lblIPAddress
BackColor = &H00404040&
BorderStyle = 1 'Fixed Single
Caption = "Label1"
ForeColor = &H0000FF00&
Height = 330
Left = -4620
TabIndex = 5
Top = 2760
Width = 1515
End
Begin VB.Label lblDataReceived
Caption = "接收的消息列表："
ForeColor = &H00800000&
Height = 255
Left = -4650
TabIndex = 4
Top = 1080
Width = 1815
End
Begin VB.Label lblDataToSend
Caption = "键入消息到发送："
ForeColor = &H00800000&
Height = 255
Left = -4650
TabIndex = 3
Top = 0
Width = 1815
End
Begin VB.Menu MnuSysMenu
Caption = "系统菜单(&S)"
Visible = 0 'False
Begin VB.Menu MnuStart
Caption = "计费(&J) ^ 对终端计算机开始计费"
End
Begin VB.Menu MnuStop
Caption = "停止(&S) ^ 终端计算机结帐"
End
Begin VB.Menu MnuLine03
Caption = "-"
End
Begin VB.Menu MnuMessage
Caption = "消息(&M) ^ 发送消息到终端计算机"
End
Begin VB.Menu MnuChangeComputer
Caption = "换机(&C) ^ 终端及费用对调"
End
Begin VB.Menu MnuCustomer
Caption = "消费(&X) ^ 副食品系列"
End
Begin VB.Menu MnuLine01
Caption = "-"
End
Begin VB.Menu MnuRestart
Caption = "重启(&R) ^ 重新启动终端计算机"
End
Begin VB.Menu MnuShutdown
Caption = "关机(&U) ^ 关 闭 当前计算机"
End
Begin VB.Menu MnuLine02
Caption = "-"
End
Begin VB.Menu MnuLock
Caption = "锁定(&L) ^ 锁定当前服务器桌面"
End
End
End
Attribute VB_Name = "frmServer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const WM_SYSCOMMAND = &H112
Private Const SC_CLOSE = &HF060
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private WithEvents m_cMenu As cPopupMenu
Attribute m_cMenu.VB_VarHelpID = -1
Private WithEvents m_cMenu1 As cPopupMenu
Attribute m_cMenu1.VB_VarHelpID = -1
Private Const mcWEBSITE As Long = -&H8000&
Private Type tActiveSocket
Connected As Boolean
ClientIPAddress As String
ClientName As String
End Type
Dim IniFileName As String
Dim intClient As Integer '客户机数
Private gActiveSockets() As tActiveSocket
Private Const FormSpace = 50
Dim imgMove As Boolean
Private Sub Avi1_DblClick(Button As Integer, ShiftState As Integer, x As Single, y As Single)
If Button = 1 Then '左键时
ShellEx "http://www.donghua.com"
End If
End Sub
Private Sub chkClipBoard_Click()
'保留设置
SaveSetting App.EXEName, "Config", "ToClipBoard", chkClipBoard.Value
End Sub
Private Sub chkTop_Click()
If chkTop.Value Then
Dim retVal As Long
retVal = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE)
Else
retVal = SetWindowPos(Me.hwnd, -2, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE)
End If
If retVal = 0 Then Exit Sub '错误时退出
'保留设置
SaveSetting App.EXEName, "Config", "TopSet", chkTop.Value
End Sub
Private Sub cmdConfig_Click()
Dim NiceN As String
NiceN = InputBox(" 请 输 入 你 的 友 好 名" & vbCrLf & vbCrLf & " 例如：杨过、小龙女 ", "输入框", NME)
If NiceN = "" Then Exit Sub
'存入注册表中
SaveSetting App.EXEName, "Config", "NiceName", NiceN
NME = NiceN
'Me.Caption = "在线聊天服务器 [ " + NME + " ] "
End Sub
Private Sub cmdReplay_Click()
On Error GoTo Err_Replay
SM_TEXT = sendJH & "MESAGE" & txtSend
' 发送命令
cmdSendData.Value = True
' 选定发送的内容
txtSend = ""
txtSend.SetFocus
Exit Sub
Err_Replay:
MsgBox "回复错误! " & vbCrLf & vbCrLf & Err.Description, vbCritical
End Sub
Private Sub cmdSendData_Click()
Dim ArrayIndex As Integer
For ArrayIndex = 1 To UBound(gActiveSockets)
If gActiveSockets(ArrayIndex).Connected Then
sktTCPChatServer(ArrayIndex).SendData SM_TEXT '执行发送命令
DoEvents
End If
Next ArrayIndex
End Sub
Private Sub Form_Initialize()
IniFileName = File
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case 13 '回车结帐
KeyCode = 0
If tbToolBar.Buttons(4).Enabled = True Then
Call MnuStop_Click
End If
Case 106 '关闭计算机 *
KeyCode = 0
Call MnuShutdown_Click
Case 107 '消费记录 +
KeyCode = 0
If tbToolBar.Buttons(4).Enabled = True Then
If FCT = True Then Unload frmCustomer
Load frmCustomer
frmCustomer.Show 1
End If
Case 110 '发送消息 .
KeyCode = 0
If tbToolBar.Buttons(4).Enabled = True Then
Call MnuMessage_Click
End If
Case 111 '重启 /
KeyCode = 0
Call MnuRestart_Click
Case 109
frmInfo.Show 1
End Select
End Sub
Private Sub Form_Load()
On Error GoTo Err_D
Screen.MousePointer = 11
If Val(GetSetting(App.EXEName, "Config", "WindowState")) = 0 Then
Me.left = Val(GetSetting(App.EXEName, "Config", "Left", 1000))
Me.tOp = Val(GetSetting(App.EXEName, "Config", "Top", 200))
Me.Height = Val(GetSetting(App.EXEName, "Config", "Height", 5000))
Me.Width = Val(GetSetting(App.EXEName, "Config", "Width", 8000))
Me.WindowState = 0
Else
Me.WindowState = 2
Me.left = 0
Me.tOp = 0
End If
NME = GetSetting(App.EXEName, "Config", "NiceName")
chkTop.Value = Val(GetSetting(App.EXEName, "Config", "TopSet"))
chkClipBoard.Value = Val(GetSetting(App.EXEName, "Config", "ToClipBoard"))
If chkTop.Value = vbChecked Then
Dim retVal As Long
retVal = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE)
End If
If Trim(NME) = "" Then
NME = sktTCPChatServer(0).LocalIP
End If
ReDim gActiveSockets(0)
sktTCPChatServer(0).LocalPort = 1600
sktTCPChatServer(0).Listen
lblIPAddress.Caption = "主机IP： " & sktTCPChatServer(0).LocalIP
sbWinsockStatus.Panels(1) = "主机名: " & sktTCPChatServer(0).LocalHostName
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -