vb6基于ffmpeg实现的直播推拉流demo

早年给群友做了一个直播推拉流的demo，玩具，真的是玩具，仅供玩笑。

首先需要一个推流端，把视频文件或者桌面窗口，或者摄像头的视频流推给直播服务器，

这里用的是vb6采用cmd命令行调用的方式，非常简陋的实现了个控制端，实际上是 ffmpeg 在工作。

然后需要一个播放器来从直播服务器拉取直播流。

Option Explicit
Const HTCAPTION = 2
Const WM_NCLBUTTONDOWN = &HA1
Dim chanXian$
Dim srv_ip$
'Private Const GWL_STYLE = (-16)
Dim has_Called As Boolean
Dim Ajax As New cAjax
Dim Pid_ffmpeg As Long
Dim HomeWanIp$
Const web_port = ":80"

Const outFormat = "rtmp"
Const outUrl = "rtmp://175.6.245.228:1935/live/room"

'Const outFormat = "rtsp"
'Const outUrl = "rtsp://live.a-vi.com/stream0.sdp"


Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long

Private Sub Form_Load()
    label_state.Caption = "正在链接服务器"
    '    chanXian = getReg("cx_name")
    '    srv_ip = getReg("srv_ip")
    '    If chanXian = Empty Or srv_ip = Empty Then
    '        Unload Me
    '        Form1_clt.Show
    '        Exit Sub
    '    End If
    '    Wsk.RemoteHost = srv_ip
    ShowMsg "准备就绪"
    Dump App.LogMode
    Text1.Text = "rtsp://admin:PDYGTG@192.168.0.9:554/h264/ch1/main/av_stream"
    '    Text1.Text = App.Path & "\demo.mp4"
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 Then
        Dim ReturnVal As Long
        x = ReleaseCapture()
        ReturnVal = SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
    End If
End Sub

Private Sub Form_Resize()
    If Me.WindowState <> 1 Then
        With mainFrame
            .Left = 60
            .Width = Me.ScaleWidth - 120
        End With
    End If
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call Label7_Click
End Sub

Private Sub label_state_Click()
    MsgBox "输入推流内容点击“立即推流”按钮即可"
End Sub

Private Sub Label1_Click()
    Form1_clt.Show
End Sub

Private Sub Label2_Click()
    Me.WindowState = 1
End Sub

Private Sub Label3_Click()
    Unload Me
    End
End Sub


Private Sub Label4_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Call Form_MouseDown(Button, Shift, x, y)
End Sub

Private Sub Label6_Click()
    Call Label7_Click
End Sub

Private Sub Label7_Click()
    '    Wsk_send "cancel." & chanXian
    Shell "taskkill /f /pid " & Pid_ffmpeg
    has_Called = False
    Label7.Caption = Label7.Tag
    Label6.BackColor = &HCCCCCC
End Sub

Private Sub Label8_Click()
    If has_Called = True Then Exit Sub
    '    获取推流地址
    Dim home_ip$
    '    Call Ajax.GetData(url:="http://api.a-vi.com/Home/getWanIp")
    '    HomeWanIp = Trim(Ajax.Res("ip"))
    HomeWanIp = "live.a-vi.com"
    '    Wsk_send "call." & chanXian
    Dim url$
    url = App.Path & "\ffmpeg.exe -stream_loop -1  -re -i "
    url = url & Trim(Text1.Text) & " -c copy -bufsize 1024000 -f "
    url = url & outFormat & " " & outUrl
    '    url = url & HomeWanIp & ":554/stream0.sdp"
    If App.LogMode = 0 Then
        Pid_ffmpeg = Shell(url, vbNormalFocus)
    Else
        Pid_ffmpeg = Shell(url, vbHide)
    End If
    '"ffmpeg.exe -stream_loop -1  -re -i a.mp4 -c copy -bufsize 1024000 -f rtsp rtsp://192.168.168.1:554/stream0.sdp"
    Dump url
    has_Called = True
    Label7.Caption = "正在推流，可点击这里取消..."
    Label6.BackColor = &H8080FF
End Sub
'Private Function Wsk_send(ByVal s$) As Boolean
'    If Wsk.State = 7 Then
'        Wsk.SendData s
'        Wsk_send = True
'    End If
'End Function
Private Sub Label9_Click()
    Call Label8_Click
End Sub

Private Sub Label9_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Label8.BackColor = &HCCCCCC
End Sub

Private Sub Label9_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Label8.BackColor = &HC0C000
End Sub

Private Sub Timer1_Timer()
    '    If Wsk.State = 0 Then
    '        ShowMsg "正在连接服务器"
    '        Wsk.Connect
    '    End If
    '由于你的服务器没有web接口实时获取在线观众，此处可忽略
    If has_Called = True Then
        Label14.Visible = True
        Label13.Visible = True
        Call Ajax.GetData("http://" & HomeWanIp & web_port & "/api/v1/pushers")
        '        Dump Ajax.Res("total")
        If CInt(Ajax.Res("total")) = 0 Then
            '            Call Label7_Click
        Else
            Label14.Caption = Ajax.Res("rows")(0)("onlines")
            Text2.Text = Ajax.Res("rows")(0)("url")
            Text2.Visible = True
            Text3.Visible = True
        End If
    Else
        Label14.Visible = False
        Label13.Visible = False
        Text2.Text = ""
        Text2.Visible = False
        Text3.Visible = False
    End If
End Sub
Private Sub ShowMsg(ByVal s$)
    label_state.Caption = s & "...使用帮助"
End Sub