⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmplayer.frm

📁 KTV管理系统,实现了基本的日常操作.程序有不完善之处,请自修升级修改.
💻 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 + -