📄 frmplayer.frm
字号:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Object = "{22D6F304-B0F6-11D0-94AB-0080C74C7E95}#1.0#0"; "MSDXM.OCX"
Begin VB.Form frmPlayer
BackColor = &H80000008&
BorderStyle = 0 'None
ClientHeight = 7620
ClientLeft = 0
ClientTop = 0
ClientWidth = 10260
Icon = "frmPlayer.frx":0000
LinkTopic = "Form1"
ScaleHeight = 7620
ScaleWidth = 10260
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
WindowState = 2 'Maximized
Begin MSWinsockLib.Winsock tcpServer
Index = 0
Left = 4200
Top = 2040
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin MSAdodcLib.Adodc Adodc1
Height = 375
Left = 6960
Top = 120
Visible = 0 'False
Width = 2055
_ExtentX = 3625
_ExtentY = 661
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
Caption = "Adodc1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin MediaPlayerCtl.MediaPlayer WMPlayer1
Height = 2775
Left = 2520
TabIndex = 0
Top = 1920
Width = 3735
AudioStream = -1
AutoSize = 0 'False
AutoStart = -1 'True
AnimationAtStart= -1 'True
AllowScan = -1 'True
AllowChangeDisplaySize= -1 'True
AutoRewind = 0 'False
Balance = 0
BaseURL = ""
BufferingTime = 5
CaptioningID = ""
ClickToPlay = -1 'True
CursorType = 0
CurrentPosition = -1
CurrentMarker = 0
DefaultFrame = ""
DisplayBackColor= 0
DisplayForeColor= 16777215
DisplayMode = 0
DisplaySize = 4
Enabled = -1 'True
EnableContextMenu= -1 'True
EnablePositionControls= -1 'True
EnableFullScreenControls= 0 'False
EnableTracker = -1 'True
Filename = ""
InvokeURLs = -1 'True
Language = -1
Mute = 0 'False
PlayCount = 1
PreviewMode = 0 'False
Rate = 1
SAMILang = ""
SAMIStyle = ""
SAMIFileName = ""
SelectionStart = -1
SelectionEnd = -1
SendOpenStateChangeEvents= -1 'True
SendWarningEvents= -1 'True
SendErrorEvents = -1 'True
SendKeyboardEvents= 0 'False
SendMouseClickEvents= 0 'False
SendMouseMoveEvents= 0 'False
SendPlayStateChangeEvents= -1 'True
ShowCaptioning = 0 'False
ShowControls = 0 'False
ShowAudioControls= 0 'False
ShowDisplay = 0 'False
ShowGotoBar = 0 'False
ShowPositionControls= 0 'False
ShowStatusBar = 0 'False
ShowTracker = 0 'False
TransparentAtStart= 0 'False
VideoBorderWidth= 0
VideoBorderColor= 0
VideoBorder3D = 0 'False
Volume = -600
WindowlessVideo = 0 'False
End
End
Attribute VB_Name = "frmPlayer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Num As Integer
Dim flag As Boolean
Dim NumOnline As Integer
Dim clientName(1 To 5)
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Const EWX_SHUTDOWN = 1
Private Sub Form_Load()
Num = 0
NumOnline = 0
tcpServer(0).LocalPort = 5000
tcpServer(0).Listen
With Adodc1
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\data\song.mdb;Persist Security Info=False"
.CommandTimeout = 30
.CommandType = adCmdText
.CursorLocation = adUseClient
End With
WMPlayer1.Left = 0
WMPlayer1.Top = 0
WMPlayer1.Width = Screen.Width
WMPlayer1.Height = Screen.Height
End Sub
Private Sub Form_Unload(Cancel As Integer)
WMPlayer1.Stop
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
End If
Dim s As String
s = "ready"
tcpServer(serverN).SendData s
End Sub
Private Sub tcpServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim s As String
Dim s1 As String
Dim ss As String
serverN = Index
'tcpServer(Index).GetData s
s = "N0003000001"
'分析数据判断是系统命令还是发送的曲目编号
ss = Left$(s, 1)
s = Mid$(s, 6, Len(s) - 4)
On Error Resume Next
If ss = "N" Then '歌曲编号
Adodc1.RecordSource = "select 位置 from songlist where 编号='" & s & "'"
Adodc1.Refresh
If Adodc1.Recordset.RecordCount <> 0 Then
WMPlayer1.FileName = Adodc1.Recordset.Fields("位置")
WMPlayer1.Play
Else
'向操作台发出没有曲止信息
s1 = "Err001"
tcpServer(Index).SendData s1
End If
ElseIf ss = "S" Then
Select Case s
Case Is = "pause"
WMPlayer1.Pause
Case Is = "play"
WMPlayer1.Play
Case Is = "stop"
WMPlayer1.Stop
Case Is = "shutdown"
ExitWindowsEx EWX_SHUTDOWN, 0
'关闭服务器
Case Is = "close"
'断开连接
tcpServer(serverN).Close
End Select
End If
End Sub
Private Sub WMPlayer1_EndOfStream(ByVal Result As Long)
Dim s As String
s = "ready"
tcpServer(serverN).SendData s
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -