Chip 2002 November/Chip_2002-11_cd1.bin/zkuste/vbasic/Data/Utils/WME71SDK.exe/RCDATA/CABINET/frmstationmanager.frm

Text File | 2001-04-17 | 29KB | 1,097 lines

VERSION 5.00
Object = "{C4941F47-8BC1-49D3-9989-2B7826F26AE6}#1.0#0"; "MSPShell.dll"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmStationManager
   Caption         =   "Windows Media Station Manager Sample"
   ClientHeight    =   5760
   ClientLeft      =   1350
   ClientTop       =   1725
   ClientWidth     =   9645
   Icon            =   "frmStationManager.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   5760
   ScaleWidth      =   9645
   Begin MSPROPSHELLLibCtl.MSPropShell StationStat
      Height          =   3255
      Left            =   0
      OleObjectBlob   =   "frmStationManager.frx":000C
      TabIndex        =   8
      Top             =   2400
      Width           =   8295
   End
   Begin VB.Timer tmrStn
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   8640
      Top             =   2160
   End
   Begin VB.CommandButton cmdExit
      Cancel          =   -1  'True
      Caption         =   "E&xit"
      Height          =   375
      Left            =   8400
      TabIndex        =   7
      Top             =   3600
      Width           =   1215
   End
   Begin VB.CommandButton cmdStop
      Caption         =   "S&top"
      Height          =   375
      Left            =   8400
      TabIndex        =   6
      Top             =   3120
      Width           =   1215
   End
   Begin VB.CommandButton cmdStart
      Caption         =   "&Start"
      Height          =   375
      Left            =   8400
      TabIndex        =   5
      Top             =   2640
      Width           =   1215
   End
   Begin VB.CommandButton cmdPlaylist
      Caption         =   "&Playlist..."
      Default         =   -1  'True
      Height          =   375
      Left            =   8400
      TabIndex        =   4
      Top             =   1560
      Width           =   1215
   End
   Begin VB.CommandButton cmdRemove
      Caption         =   "&Remove"
      Height          =   375
      Left            =   8400
      TabIndex        =   3
      Top             =   1080
      Width           =   1215
   End
   Begin VB.CommandButton cmdChange
      Caption         =   "&Change..."
      Height          =   375
      Left            =   8400
      TabIndex        =   2
      Top             =   600
      Width           =   1215
   End
   Begin VB.CommandButton cmdAdd
      Caption         =   "&New Station..."
      Height          =   375
      Left            =   8400
      TabIndex        =   1
      Top             =   120
      Width           =   1215
   End
   Begin MSComctlLib.ListView lvwStation
      Height          =   2175
      Left            =   0
      TabIndex        =   0
      Top             =   120
      Width           =   8295
      _ExtentX        =   14631
      _ExtentY        =   3836
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   4
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         Key             =   "Name"
         Text            =   "Name"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         SubItemIndex    =   1
         Key             =   "Playlist"
         Text            =   "Playlist"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         SubItemIndex    =   2
         Key             =   "Status"
         Text            =   "Status"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         SubItemIndex    =   3
         Key             =   "URL"
         Text            =   "URL"
         Object.Width           =   2540
      EndProperty
   End
End
Attribute VB_Name = "frmStationManager"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public StnCol As New Collection
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nsize As Long) As Long

Private Sub cmdAdd_Click()

    On Error GoTo error_handler

    Dim EncoderStn As New StnMgrEnc

    Dim Success As Boolean

    Dim EncoderName As String

    EncoderStn.EncInit

    Set frmNewStation.StationMgrEnc = EncoderStn

    frmNewStation.Show 1

    EncoderName = EncoderStn.EncName

    If EncoderName = "" Then

        Set EncoderStn = Nothing

        Exit Sub

    End If

    StnCol.Add EncoderStn, EncoderName

    Populate_list (EncoderName)

    cmdChange.Enabled = True

    cmdRemove.Enabled = True

    cmdPlaylist.Enabled = True

    cmdStart.Enabled = True

    cmdStop.Enabled = True

    Exit Sub

error_handler:
    MsgBox "Error Adding New Station", vbCritical

End Sub

Private Sub cmdChange_Click()

    On Error GoTo error_handler


    Dim SelItem As String

    Dim StnCls As StnMgrEnc
    Dim EncName As String





    SelItem = lvwStation.SelectedItem.Text

    Set StnCls = StnCol(SelItem)

    EncName = StnCls.EncName

    Set frmNewStation.StationMgrEnc = StnCls

    frmNewStation.txtName.Text = EncName
    frmNewStation.optAudio.Enabled = False
    frmNewStation.optVideo.Enabled = False

    frmNewStation.Show 1


    EncName = StnCls.EncName

    If lvwStation.SelectedItem.Text <> EncName Then

        lvwStation.SelectedItem.Text = EncName

        StnCol.Remove SelItem

        StnCol.Add StnCls, EncName
    End If

    Exit Sub

error_handler:

    MsgBox "Error Changing the properties of the station", vbCritical

End Sub

Private Sub cmdExit_Click()

    Unload Me

    End

End Sub

Private Sub cmdPlaylist_Click()

    On Error GoTo error_handler

    Dim Name As String
    Dim StnPlay As StnMgrEnc



    Name = lvwStation.SelectedItem.Text


    Set StnPlay = StnCol.Item(Name)

    Set frmPlaylist.StnMgr = StnPlay

    frmPlaylist.Caption = "Playlist for Station" & Name

    frmPlaylist.Show 1

    Exit Sub

error_handler:

    MsgBox "Error Reteriving The playlist For the Station", vbCritical

End Sub

Private Sub cmdRemove_Click()

    On Error GoTo error_handler

    Dim SelItem As String

    If lvwStation.ListItems.Count = 0 Then

        Exit Sub

    End If

    SelItem = lvwStation.SelectedItem.Text

    StnCol.Remove (SelItem)

    lvwStation.ListItems.Remove lvwStation.SelectedItem.Index

    If lvwStation.ListItems.Count = 0 Then

        cmdChange.Enabled = False

        cmdRemove.Enabled = False

        cmdPlaylist.Enabled = False

        cmdStart.Enabled = False

        cmdStop.Enabled = False

    End If

    Exit Sub

error_handler:
    MsgBox "Error Removing From The List", vbExclamation


End Sub

Private Sub cmdStart_Click()
    On Error GoTo error_handler

    Dim SelItem As String

    Dim Enc As WMEncoder
    Dim StnCls As New StnMgrEnc

    Dim MaxCnt As Integer
    Dim PlayCnt As Integer


    Dim PrfCol As IWMEncProfileCollection


    Dim prf As IWMEncProfile
    Dim PrfName As String


    Dim SrcGrpCol As IWMEncSourceGroupCollection

    Dim SrcGrpCurr As IWMEncSourceGroup

    Dim SrcGrpNext As IWMEncSourceGroup


    Dim PpgMain As New WMEncMonMainPage

    If lvwStation.SelectedItem.ListSubItems.Item("Playlist") = "0 Items" Then
        MsgBox "Please Add Items In the play List", vbCritical, "Error- Starting"
        Exit Sub
    End If

    If lvwStation.SelectedItem.ListSubItems.Item("Status") = "Running" Then
        MsgBox "The Station Has Already Been started", vbExclamation, "Error- Starting"
        Exit Sub
    End If


    SelItem = lvwStation.SelectedItem.Text

    Set StnCls = StnCol.Item(SelItem)

    Set Enc = StnCls.ExistEnc

    Set SrcGrpCol = Enc.SourceGroupCollection

    Set SrcGrpCurr = SrcGrpCol.Add("Current")

    Process_SrcGrp SelItem, SrcGrpCurr

    PrfName = StnCls.EncPrfName

    Set PrfCol = Enc.ProfileCollection


    If StnCls.LstStop = 0 Then

        For Each prf In PrfCol

            If UCase(prf.Name) = UCase(PrfName) Then

                SrcGrpCurr.Profile = prf

                Exit For

            End If

        Next

    End If


    SrcGrpCol.Active = SrcGrpCurr

    PlayCnt = StnCls.PlaylistPos

    PlayCnt = PlayCnt + 1

    StnCls.PlaylistPos = PlayCnt

    MaxCnt = StnCls.MaxBound

    If MaxCnt > 1 And MaxCnt <> PlayCnt Then

        Set SrcGrpNext = SrcGrpCol.Add("Next")


        Process_SrcGrp SelItem, SrcGrpNext

        If StnCls.LstStop = 0 Then

            For Each prf In PrfCol

                If UCase(prf.Name) = UCase(PrfName) Then

                    SrcGrpNext.Profile = prf

                    Exit For

                End If

            Next

        End If

    Else

        StnCls.LstStop = 1

    End If

    Enc.AutoStop = False

    StationStat.AddObject Enc

    StationStat.AddPage PpgMain



    Enc.Start

    lvwStation.SelectedItem.ListSubItems.Item("Playlist").Text = PlayCnt & " of " & MaxCnt & " items"

    If Enc.RunState = WMENC_ENCODER_RUNNING Then

         lvwStation.SelectedItem.ListSubItems.Item("Status") = "Running"

         cmdChange.Enabled = False
         cmdRemove.Enabled = False

    End If

    tmrStn.Enabled = True

    Exit Sub

error_handler:

    MsgBox "Error Starting The Station", vbCritical
End Sub

Private Sub cmdStop_Click()

    On Error GoTo error_handler

    Dim SelItem As String
    Dim MaxCnt As Integer

    Dim Encoder As WMEncoder
    Dim StnCls As StnMgrEnc


    Dim SrcGrpCol As IWMEncSourceGroupCollection

    If lvwStation.SelectedItem.ListSubItems.Item("Status") = "Stopped" Then
        MsgBox "Station Already stopped", vbExclamation
        Exit Sub
    End If

    SelItem = lvwStation.SelectedItem.Text

    Set StnCls = StnCol(SelItem)

    Set Encoder = StnCls.ExistEnc

    MaxCnt = StnCls.MaxBound

    Encoder.Stop

    StnCls.Stat = 0

    Set SrcGrpCol = Encoder.SourceGroupCollection

    If MaxCnt > 1 Then

        SrcGrpCol.Remove (0)

        SrcGrpCol.Remove (0)

    Else

        SrcGrpCol.Remove (0)

    End If

    lvwStation.SelectedItem.ListSubItems.Item("Status") = "Stopped"

    tmrStn.Enabled = False

    cmdChange.Enabled = True
    cmdRemove.Enabled = True

    Exit Sub

error_handler:
    MsgBox "Error Stopping The Station", vbCritical


End Sub

Private Sub Form_Load()
    On Error GoTo error_handler

    Dim I As Integer

    Dim StnCls As New StnMgrEnc

    For I = 1 To 4
        lvwStation.ColumnHeaders.Item(I).Width = lvwStation.Width / 4
    Next

    If lvwStation.ListItems.Count = 0 Then
        cmdChange.Enabled = False
        cmdRemove.Enabled = False
        cmdPlaylist.Enabled = False
        cmdStart.Enabled = False
        cmdStop.Enabled = False
    End If

    Exit Sub

error_handler:
    MsgBox "Error Starting The Station Manager", vbCritical
    End

End Sub

Function Populate_list(EncName As String) As Boolean

    On Error GoTo error_handler

    Dim Cnt As Integer

    Dim CmpName As String
    Dim Ret As Long
    Dim Prt As Long

    Dim Prt1 As String
    Dim StnEnc As StnMgrEnc
    Dim Enc As WMEncoder
    Dim Brdcst As IWMEncBroadcast

    For Each StnEnc In StnCol
        If StnEnc.EncName = EncName Then
            Set Enc = StnEnc.ExistEnc
            Exit For
        End If
     Next

    Set Brdcst = Enc.Broadcast

    Prt = Brdcst.PortNumber(WMENC_PROTOCOL_HTTP)

    Prt1 = CStr(Prt)

    CmpName = "unknown"

    Cnt = lvwStation.ListItems.Count + 1

    Ret = GetComputerName(CmpName, 20)

    Trim (CmpName)

    CmpName = CmpName & ":" & Prt1

    CmpName = "http://" & CmpName

    lvwStation.ListItems.Add Cnt, , EncName

    lvwStation.ListItems(Cnt).ListSubItems.Add , "Playlist", "0 Items"

    lvwStation.ListItems(Cnt).ListSubItems.Add , "Status", "Stopped"

    lvwStation.ListItems(Cnt).ListSubItems.Add , "URL", CmpName


    lvwStation.FullRowSelect = True

    Set lvwStation.SelectedItem = lvwStation.ListItems(1)

    Set lvwStation.DropHighlight = lvwStation.ListItems(1)

    Exit Function

error_handler:

    MsgBox "Error Adding The Station To The List", vbCritical

End Function
Private Sub lvwStation_Click()

    On Error GoTo error_handler

    Dim PpgMain As New WMEncMonMainPage

    Dim SelItem As String

    Dim StnCls As StnMgrEnc

    Dim Enc As WMEncoder

    Set lvwStation.DropHighlight = lvwStation.SelectedItem

    lvwStation.FullRowSelect = True

    If lvwStation.SelectedItem.ListSubItems.Item("Status") = "Running" Then

        SelItem = lvwStation.SelectedItem.Text

        Set StnCls = StnCol(SelItem)

        Set Enc = StnCls.ExistEnc

        StationStat.AddPage PpgMain

        StationStat.AddObject Enc

    Else

        cmdChange.Enabled = True
        cmdRemove.Enabled = True

    End If

    Exit Sub

error_handler:
    MsgBox "Error Selecting The required Station"
End Sub


Public Sub Process_SrcGrp(SelItem As String, SrcGrp As IWMEncSourceGroup)
    On Error GoTo error_handler

    Dim ProcStn As StnMgrEnc

    Dim Cnt As Integer
    Dim FileInAud As String
    Dim FileInVid As String
    Dim Dur As String
    Dim UpLimit As Integer
    Dim pos As Integer

    Dim AudSrc As IWMEncSource
    Dim VidSrc As IWMEncSource


    Set ProcStn = StnCol.Item(SelItem)

    pos = ProcStn.PlaylistPos

    UpLimit = ProcStn.MaxBound

    If pos >= UpLimit Then

         ProcStn.LstStop = 1

         Exit Sub

    End If

    pos = pos + 1

    ProcStn.AllElem FileInVid, FileInAud, Dur, pos

    If ProcStn.VideoOpt = 0 Then

        Set AudSrc = SrcGrp.AddSource(WMENC_AUDIO)

        If Dur = "-" Then
            FileInAud = "FILE://" & FileInAud
            AudSrc.SetInput FileInAud

        Else

            AudSrc.SetInput FileInAud
        End If

    Else

        Set AudSrc = SrcGrp.AddSource(WMENC_AUDIO)

        Set VidSrc = SrcGrp.AddSource(WMENC_VIDEO)

        If Dur = "-" Then

            FileInAud = "FILE://" & FileInAud

            FileInVid = "FILE://" & FileInVid

            AudSrc.SetInput FileInAud

            VidSrc.SetInput FileInVid
        Else

            FileInAud = "DEVICE://" & FileInAud

            If FileInVid = "Screen Capture" Then
                FileInVid = "ScreenCap://"
            Else
                FileInVid = "DEVICE://" & FileInVid
            End If

            AudSrc.SetInput FileInAud

            VidSrc.SetInput FileInVid
        End If

    End If

    Exit Sub

error_handler:

    MsgBox "Error In Assigning Sourcegroups", vbCritical

End Sub

Private Sub tmrStn_Timer()

    On Error GoTo error_handler

    Dim StnTmr As StnMgrEnc

    Dim Cnt As Integer
    Dim MaxCnt As Integer

    Dim I As Integer
    Dim SelItem As String

    Dim PlayCnt As Integer

    Dim FileInAud As String
    Dim FileInVid As String
    Dim Dur As String

    Dim SrcGrp As IWMEncSourceGroup
    Dim SrcGrpN As IWMEncSourceGroup
    Dim SrcGrpCol As IWMEncSourceGroupCollection
    Dim AudioSrc As IWMEncSource
    Dim VideoSrc As IWMEncSource

    Dim Enc As WMEncoder



    Cnt = lvwStation.ListItems.Count

    For I = 1 To Cnt
        If lvwStation.ListItems(I).ListSubItems.Item("Status") = "Running" Then

            SelItem = lvwStation.ListItems.Item(I).Text

            Set StnTmr = StnCol.Item(SelItem)

            PlayCnt = StnTmr.PlaylistPos

            MaxCnt = StnTmr.MaxBound

            StnTmr.PlayElem FileInVid, FileInAud, Dur

            If Dur = "-" And StnTmr.Stat = 1 And StnTmr.LstStop = 1 Then

               lvwStation.ListItems(I).ListSubItems.Item("Status") = "Stopped"

               StnTmr.PlaylistPos = 0

               Set Enc = StnTmr.ExistEnc

               Set SrcGrpCol = Enc.SourceGroupCollection

               Enc.Stop

               StnTmr.LstStop = 0

               StnTmr.Stat = 0

               If MaxCnt > 1 Then

                  SrcGrpCol.Remove (0)

                  SrcGrpCol.Remove (0)

               Else

                  SrcGrpCol.Remove (0)

               End If

               cmdChange.Enabled = True
               cmdRemove.Enabled = True

            End If

            If Dur = "-" And StnTmr.Stat = 1 And StnTmr.LstStop <> 1 Then

                Set Enc = StnTmr.ExistEnc

                Set SrcGrpCol = Enc.SourceGroupCollection

                Set SrcGrp = SrcGrpCol.Active

                If SrcGrp.Name = "Current" Then

                    For Each SrcGrpN In SrcGrpCol

                        If SrcGrpN.Name = "Next" Then

                            StnTmr.Stat = 0

                            PlayCnt = PlayCnt + 1

                            StnTmr.PlaylistPos = PlayCnt

                            lvwStation.ListItems(I).ListSubItems.Item("Playlist").Text = PlayCnt & " of " & MaxCnt & " items"

                            SrcGrpCol.Active = SrcGrpN

                            Enc.Start

                            Exit For
                        End If

                    Next

                    If StnTmr.VideoOpt = 0 Then

                        NewInput SrcGrp, 0, SelItem

                    Else

                        NewInput SrcGrp, 1, SelItem

                    End If


                Else



                    For Each SrcGrpN In SrcGrpCol

                        If SrcGrpN.Name = "Current" Then

                            StnTmr.Stat = 0

                            PlayCnt = PlayCnt + 1

                            StnTmr.PlaylistPos = PlayCnt

                            lvwStation.ListItems(I).ListSubItems.Item("Playlist").Text = PlayCnt & " of " & MaxCnt & " items"

                            SrcGrpCol.Active = SrcGrpN

                            Enc.Start

                            Exit For

                        End If

                    Next
                    If StnTmr.VideoOpt = 0 Then

                        NewInput SrcGrp, 0, SelItem

                    Else

                        NewInput SrcGrp, 1, SelItem

                    End If


                End If

            End If

            If Dur = "0" And StnTmr.LstStop = 1 Then

                lvwStation.ListItems(I).ListSubItems.Item("Status") = "Stopped"

                StnTmr.PlaylistPos = 0

                Set Enc = StnTmr.ExistEnc

                Set SrcGrpCol = Enc.SourceGroupCollection

                Enc.Stop

                StnTmr.LstStop = 0

                StnTmr.Stat = 0

                If MaxCnt > 1 Then

                    SrcGrpCol.Remove (0)

                    SrcGrpCol.Remove (0)

                Else

                    SrcGrpCol.Remove (0)

                End If

                cmdChange.Enabled = True
                cmdRemove.Enabled = True

            Else  'replaced "End If" here

                If Dur = "0" And StnTmr.LstStop <> 1 Then

                    Set Enc = StnTmr.ExistEnc

                    Set SrcGrpCol = Enc.SourceGroupCollection

                    Set SrcGrp = SrcGrpCol.Active

                    If SrcGrp.Name = "Current" Then


                        For Each SrcGrpN In SrcGrpCol

                            If SrcGrpN.Name = "Next" Then


                                PlayCnt = PlayCnt + 1

                                StnTmr.PlaylistPos = PlayCnt

                                lvwStation.ListItems(I).ListSubItems.Item("Playlist").Text = PlayCnt & " of " & MaxCnt & " items"

                                SrcGrpCol.Active = SrcGrpN

                                Enc.Start

                                Exit For

                            End If

                        Next

                        If StnTmr.VideoOpt = 0 Then

                            NewInput SrcGrp, 0, SelItem

                        Else

                            NewInput SrcGrp, 1, SelItem

                        End If


                    Else



                        For Each SrcGrpN In SrcGrpCol

                            If SrcGrpN.Name = "Current" Then

                                PlayCnt = PlayCnt + 1

                                StnTmr.PlaylistPos = PlayCnt

                                lvwStation.ListItems(I).ListSubItems.Item("Playlist").Text = PlayCnt & " of " & MaxCnt & " items"

                                SrcGrpCol.Active = SrcGrpN

                                Enc.Start

                                Exit For

                            End If

                        Next

                        If StnTmr.VideoOpt = 0 Then

                            NewInput SrcGrp, 0, SelItem

                        Else

                            NewInput SrcGrp, 1, SelItem

                        End If

                    End If
                End If
            End If 'this is new
        End If
    Next

    Exit Sub

error_handler:
MsgBox "Error Processing Input", vbCritical

End Sub



Public Sub NewInput(SrcGrp As IWMEncSourceGroup, Video As Integer, SelItem As String)
    On Error GoTo error_handler

    Dim ProcStn As StnMgrEnc

    Dim pos As Integer

    Dim UpLimit As Integer

    Dim FileInAud As String

    Dim FileInVid As String

    Dim Dur As String

    Dim AudioSrc As IWMEncSource
    Dim VideoSrc As IWMEncSource

    Set ProcStn = StnCol.Item(SelItem)

    pos = ProcStn.PlaylistPos

    UpLimit = ProcStn.MaxBound

    If pos >= UpLimit Then

         ProcStn.LstStop = 1

         Exit Sub

    End If

    pos = pos + 1

    ProcStn.AllElem FileInVid, FileInAud, Dur, pos

    If Video = 0 Then
        Set AudioSrc = SrcGrp.Source(WMENC_AUDIO, 0)
        If Dur = "-" Then

            FileInAud = "FILE://" & FileInAud

            AudioSrc.SetInput FileInAud

        Else

            AudioSrc.SetInput FileInAud

        End If
    Else

        Set AudioSrc = SrcGrp.Source(WMENC_AUDIO, 0)

        Set VideoSrc = SrcGrp.Source(WMENC_VIDEO, 0)

        If Dur = "-" Then

            FileInAud = "FILE://" & FileInAud

            FileInVid = "FILE://" & FileInVid

            AudioSrc.SetInput FileInAud

            VideoSrc.SetInput FileInVid
        Else
            FileInAud = "DEVICE://" & FileInAud

            If FileInVid = "Screen Capture" Then
                FileInVid = "ScreenCap://"
            Else
                FileInVid = "DEVICE://" & FileInVid
            End If

            AudioSrc.SetInput FileInAud

            VideoSrc.SetInput FileInVid
        End If
    End If

    Exit Sub

error_handler:

MsgBox "Eroor In The Playlist Elements", vbCritical

End Sub