mdtv.bas

vb环境制作的网络电视播放其

Attribute VB_Name = "Module1"

Public aPath As String
Public mType As Integer '媒体类型,1=windows,2=real
Public fName As String '媒体文件名
Public fLen As Integer '媒体文件名长度

Public mmC As FilgraphManager '媒体控制对象
Public mmP As IMediaPosition '媒体位置对象
Public mLen As Long '媒体文件长度
Public mPos As Long '媒体文件位置

Public fName1 As String '电视
Public fName2 As String '电台
Public fNameb As String '本地

Public tName As String '显示媒体名称
Public tURL As String '显示媒体地址
Public Pos As Long '媒体位置

Public vZooms As Single '垂直缩放比例
Public PlayFlag As Integer '本地播放模式1,2,=0网络
Public Num As Integer '本地文件数

Public Type POINTAPI
        X As Long
        Y As Long
End Type

Public FileList() As String
'自定义类型
Type DlgFileInfo
    iCount As Long
    sPath As String
    sFile() As String
End Type

Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public 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
Public Const WM_CLOSE = &H10


'加密解密
Function TxtDoXor(iTxt As String, iOption As Integer) As String
  For lngI = 1 To Len(iTxt)
    intC = Asc(Mid(iTxt, lngI, 1))
    Mid(iTxt, lngI, 1) = Chr(intC Xor iOption)
  Next lngI
  TxtDoXor = iTxt
End Function

Function sLen(TestStr) As Integer
  sLen = LenB(StrConv(TestStr, vbFromUnicode))
End Function
'窗体最前
Function SetFormTop(iForm As Form, iFlag As Boolean)
  If iFlag = True Then
    SetWindowPos iForm.hwnd, -1, 0, 0, 0, 0, 3
  Else
    SetWindowPos iForm.hwnd, -2, 0, 0, 0, 0, 3
  End If
End Function

'打开多个文件，供openmf调用
Function GetDlgSelectFileInfo(strFilename As String) As DlgFileInfo
Dim sPath, tmpStr As String
Dim sFile() As String
Dim iCount As Integer
Dim i As Integer
On Error GoTo ErrHandle
sPath = CurDir()
tmpStr = Right$(strFilename, Len(strFilename) - Len(sPath))
If Left$(tmpStr, 1) = Chr$(0) Then
  '选择了多个文件(表现为第一个字符为空格)
  For i = 1 To Len(tmpStr)
    If Mid$(tmpStr, i, 1) = Chr$(0) Then
      iCount = iCount + 1
      ReDim Preserve sFile(iCount) As String
    Else
      sFile(iCount) = sFile(iCount) & Mid$(tmpStr, i, 1)
    End If
  Next i
Else
  '只选择了一个文件(注意：根目录下的文件名除去路径后没有"\"）
  iCount = 1
  ReDim Preserve sFile(iCount)
  If Left$(tmpStr, 1) = "\" Then tmpStr = Right$(tmpStr, Len(tmpStr) - 1)
  sFile(iCount) = tmpStr
End If
GetDlgSelectFileInfo.iCount = iCount
ReDim GetDlgSelectFileInfo.sFile(iCount)
If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
GetDlgSelectFileInfo.sPath = sPath
For i = 1 To iCount
   GetDlgSelectFileInfo.sFile(i) = sFile(i)
Next i
Exit Function
ErrHandle:
End Function

'打开多个文件，请先放置一个CommonDialog
Function OpenMf(CommonDialog1 As CommonDialog, FileType As String) As Long
Dim N As Long
Dim DlgInfo As DlgFileInfo
Dim cI As Long
On Error GoTo exitopenmf
With CommonDialog1
  .CancelError = True
  .MaxFileSize = 32767
  .Flags = cdlOFNHideReadOnly Or cdlOFNAllowMultiselect Or cdlOFNExplorer Or cdlOFNNoDereferenceLinks
  .Filter = FileType
  .ShowOpen
   DlgInfo = GetDlgSelectFileInfo(.FileName)
  .FileName = ""
End With
tt = DlgInfo.iCount
N = 0
For cI = 1 To DlgInfo.iCount
  If FileLen(DlgInfo.sPath & DlgInfo.sFile(cI)) > 0 Then
    N = N + 1
    ReDim Preserve FileList(1 To N)
    FileList(N) = DlgInfo.sPath & DlgInfo.sFile(cI)
  End If
Next
OpenMf = N
Exit Function
exitopenmf:
End Function
'本地播放
Public Sub LocalPlay()
Load Form3
Form3.Left = Screen.Width * 2
Form3.Top = Screen.Height * 2
Form3.Visible = True
If Form3.List1.ListCount = 0 Then
  Unload Form3
  PlayFlag = 1
  SaveSetting App.Title, App.EXEName, "PlayFlag", "1"
  Exit Sub
End If
tName = Form3.List1.List(Pos)
p = InStr(1, tName, "\", vbTextCompare)
While p > 0
  tName = Mid$(tName, p + 1)
  p = InStr(1, tName, "\", vbTextCompare)
Wend
For i = Len(tName) To 1 Step -1
  If Mid$(tName, i, 1) = "." Then
    p = i: Exit For
  End If
Next
If p > 1 Then
  tName = Left$(tName, p - 1)
End If
tURL = Form3.List1.List(Pos)
SaveSetting App.Title, App.EXEName, "Name", tName
SaveSetting App.Title, App.EXEName, "Url", tURL
SaveSetting App.Title, App.EXEName, "Idx", CStr(Pos)
If Form3.Option1.Visible = True Then
  PlayFlag = 1
ElseIf Form3.Option1.Visible = True Then
  PlayFlag = 2
End If
SaveSetting App.Title, App.EXEName, "PlayFlag", PlayFlag
On Error Resume Next
Form3.Hide
Form1.LblLeft.Enabled = False
Form1.LblRight.Enabled = False
Form1.Refresh
Form1.wmp.Controls.stop
Form1.rm.DoStop
Form1.Pv(0).Visible = False
Form1.Pv(1).Visible = False
If Form4.Visible = True Then Unload Form4
If Form5.Visible = True Then Unload Form5
mPos = 0: mLen = 0
Form1.LblCs.Caption = "【" + tName + "】"
Form1.Ps.Cls
Form1.Refresh
If MediaType(tURL) = 1 Then
  mType = 1
  SaveSetting App.Title, App.EXEName, "mType", "1"
  Form1.wmp.URL = tURL
  Form1.wmp.Controls.play
  Form1.Pv(0).Visible = True
ElseIf MediaType(tURL) = 2 Then
  mType = 2
  SaveSetting App.Title, App.EXEName, "mType", "2"
  Form1.rm.Source = tURL
  Form1.rm.DoPlay
  Form1.Pv(1).Visible = True
ElseIf MediaType(tURL) = 3 Then
  mType = 3
  SaveSetting App.Title, App.EXEName, "mType", "3"
  Form1.Top = -Form1.Height + 60
  Form1.LblCs.Caption = "【" + tName + "】 Flash "
  Form4.Caption = tName
  Form4.Show
  Form4.swf.LoadMovie 0, tURL
  Form4.swf.play
ElseIf MediaType(tURL) = 4 Then
  mType = 4
  SaveSetting App.Title, App.EXEName, "mType", "4"
  Form1.Top = -Form1.Height + 60
  Form1.LblCs.Caption = "【" + tName + "】 DVD "
  Form5.Caption = tName
  Form5.Show
  Form5.Amv.FileName = tURL
  Form5.Amv.Run
End If
Unload Form3
End Sub
'列表框滚动条
Function ListHScroll(iList As ListBox, HScrollValue As Integer)
  SendMessage iList.hwnd, &H194, HScrollValue, 0
End Function
'判断本地媒体类型
Function MediaType(iFn) As Integer
  If sLen(iFn) = 0 Then Exit Function
  For i = sLen(iFn) To 1 Step -1
    If Mid$(iFn, i, 1) = "." Then
      ext = Mid$(iFn, i + 1)
      Exit For
    End If
  Next
  MediaType = 0
  ext = UCase(ext)
  If ext = "VOB" Then 'DVD
    MediaType = 4
  ElseIf ext = "SWF" Then  'Flash
    MediaType = 3
  ElseIf InStr(1, ext, "R", vbTextCompare) > 0 Then
    MediaType = 2 'Real
  Else 'Media
    MediaType = 1
  End If
End Function

'获取媒体文件长度
Function GetMediaLen(tFn) As Long
  On Error Resume Next
  Set mmC = New FilgraphManager
  Call mmC.RenderFile(tFn)
  Set mmP = mmC
  GetMediaLen = mmP.duration
  Set mmC = Nothing
End Function