200分但求屏幕广播源程序或方法思路

Windows Media 编码器 7.1
一种易于使用的、强大的制作工具，内容开发商可使用此工具将直播内容和预先录制的音频、视频和计算机屏幕图像转换为 Windows Media 格式以进行直播和点播。
http://www.microsoft.com/windows/windowsmedia/download/default.asp
现在假设Z是服务器端，a，b，c是客户端
1。将视频音频广播到局域网内所有机器----
    可以通过socket将视频音频文件传到局域网内所有机器，然后在局域网的机器上使用
    shell之类的函数，让局域网内所有机器能看到！
    如果是视频音频点播方式的话，建议使用asp或jsp作成b/s模式。
----2。将服务器的屏幕图象及鼠标位置广播到局域网内所有机器-----
    首先截屏[注：getdc(0)是不能将鼠标给截下来的，需要另外使用方法，后面会说到！]
    然后将截屏后的图片保存为bmp，然后转成jpg，再通过socket传到局域网内所有机器，
    然后在局域网的机器上使用shell之类的函数显示就好了！
-----'以下程序的功能是将屏幕保存成jpg文件
Public Function Get_Desktop(ByVal theFile As String, SetSx As Integer, SetSy As Integer) As Boolean    Dim hdc As Long, sx As Integer, sy As Integer

    picCopy.AutoRedraw = True
    hdc = GetDC(0)
    sx = Screen.Width / Screen.TwipsPerPixelX
    sy = Screen.Height / Screen.TwipsPerPixelY

    If SetSx = 0 Or SetSy = 0 Then SetSx = sx: SetSy = sy

    picCopy.Width = SetSx * Screen.TwipsPerPixelX
    picCopy.Height = SetSy * Screen.TwipsPerPixelY

    SetStretchBltMode picCopy.hdc, 3
    StretchBlt picCopy.hdc, 0, 0, SetSx, SetSy, hdc, 0, 0, sx, sy, vbSrcCopy
    ReleaseDC 0, hdc
    picCopy.Picture = picCopy.Image
    Dim p As New aDIBSection
    p.CreateFromPicture picCopy.Picture
    SaveJPG p, theFile, 75
    picCopy.Width = 1
    picCopy.Height = 1
    picCopy.AutoRedraw = False
    Get_Desktop = True
End Function
'抓取屏幕的同时获取鼠标的窗体程序部分
Option ExplicitConst uID = 9998
Const uMessage = WM_USER + 100Sub SetPicture()
   picCopy.Visible = True
   If picCopy.Width <= Picture1.ScaleWidth Then
       picCopy.Left = (Picture1.ScaleWidth - picCopy.Width) / 2
   Else
       picCopy.Left = 0
       HScroll1.Min = 0
       HScroll1.Value = 0
       HScroll1.Max = picCopy.Width - Picture1.ScaleWidth
       HScroll1.SmallChange = IIf(HScroll1.Max \ 100 > 0, HScroll1.Max \ 100, 1)
       HScroll1.LargeChange = IIf(HScroll1.Max \ 10 > 0, HScroll1.Max \ 10, 1)
   End If   If picCopy.Height <= Picture1.ScaleHeight Then
       picCopy.Top = (Picture1.ScaleHeight - picCopy.Height) / 2
   Else
       picCopy.Top = 0
       VScroll1.Min = 0
       VScroll1.Value = 0
       VScroll1.Max = picCopy.Height - Picture1.ScaleHeight
       VScroll1.SmallChange = IIf(VScroll1.Max \ 100 > 0, VScroll1.Max \ 100, 1)
       VScroll1.LargeChange = IIf(VScroll1.Max \ 10 > 0, VScroll1.Max \ 10, 1)
   End If
End Sub
Private Sub Form_Load()
    On Error GoTo ErrMsg

    SetKeyboardHook Me.hWnd, WM_USER

    prevWndProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
    SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf WndProc    MsgBox "Ö»Òª°´ÏÂF7,¼´¿É×¥È¡ÆÁÄ»."

    Dim nid As NOTIFYICONDATA

    nid.cbSize = Len(nid)
    nid.hWnd = Me.hWnd
    nid.uID = uID
    nid.uFlags = NIF_ICON + NIF_TIP + NIF_MESSAGE
    nid.hIcon = Me.Icon
    nid.szTip = "ÆÁÄ»×¥È¡³ÌÐò" + Chr(0)
    nid.uCallbackMessage = uMessage
    Shell_NotifyIcon NIM_ADD, nid

    Me.WindowState = vbMinimized

    Exit Sub
ErrMsg:
    MsgBox "ÓûÖ´ÐÐ±¾³ÌÐò,ÇëÏÈ½« KeybHook.dll ¸´ÖÆµ½ Windows ËùÔÚÂ·¾¶!"
    End
End SubPrivate Sub Form_Resize()
    On Error Resume Next

    If Me.WindowState = vbMinimized Then
        Me.Hide
        Exit Sub
    Else
        Picture1.Width = Me.ScaleWidth - VScroll1.Width
        Picture1.Height = Me.ScaleHeight - HScroll1.Height
        VScroll1.Left = Picture1.Width
        HScroll1.Top = Picture1.Height
        VScroll1.Height = Picture1.Height
        HScroll1.Width = Picture1.Width
        SetPicture
    End If
End SubPrivate Sub Form_Unload(Cancel As Integer)
    ReleaseKeyboardHook
    SetWindowLong Me.hWnd, GWL_WNDPROC, prevWndProc

    Dim nid As NOTIFYICONDATA

    nid.cbSize = Len(nid)
    nid.hWnd = Me.hWnd
    nid.uID = uID
    Shell_NotifyIcon NIM_DELETE, nid

End SubPrivate Sub HScroll1_Change()
    picCopy.Left = -HScroll1.Value
End SubPrivate Sub mActiveWindow_Click()
    mScreen.Checked = False
    mActiveWindow.Checked = True
End SubPublic Sub Capture()
    Dim hDC As Long, hWnd As Long
    Dim Width As Single, Height As Single
    Dim sx As Integer, sy As Integer, r As RECT

    hWnd = GetForegroundWindow()
    If mScreen.Checked Or hWnd = 0 Then
        hDC = GetDC(0)
        Width = Screen.Width
        Height = Screen.Height

    Else
        hDC = GetWindowDC(hWnd)
        GetWindowRect hWnd, r
        Width = (r.Right - r.Left) * Screen.TwipsPerPixelX
        Height = (r.Bottom - r.Top) * Screen.TwipsPerPixelY
    End If

    picCopy.Width = Width
    picCopy.Height = Height

    picCopy.AutoRedraw = True

    sx = Width \ Screen.TwipsPerPixelX
    sy = Height \ Screen.TwipsPerPixelY
    BitBlt picCopy.hDC, 0, 0, sx, sy, hDC, 0, 0, vbSrcCopy

    Dim p As POINTAPI, info As ICONINFO, pic As Object
    Dim oldScaleMode As Integer, CursorName As String

    GetCursorPos p

    If mCursor(1).Checked Then CursorName = "Normal"
    If mCursor(2).Checked Then CursorName = "Hand"
    If mCursor(3).Checked Then CursorName = "Cross"
    If mCursor(4).Checked Then CursorName = "Wait"

    If CursorName <> "" Then
        Set pic = LoadResPicture(CursorName, vbResCursor)
        GetIconInfo pic.Handle, info
        oldScaleMode = picCopy.ScaleMode
        picCopy.ScaleMode = vbPixels

        If mScreen.Checked Then
            picCopy.PaintPicture pic, p.x - info.xHotspot, p.y - info.yHotspot
        Else
            picCopy.PaintPicture pic, p.x - r.Left - info.xHotspot, _
                                      p.y - r.Top - info.yHotspot
        End If
        picCopy.ScaleMode = oldScaleMode
    End If

    picCopy.AutoRedraw = False    If mScreen.Checked Then
        ReleaseDC 0, hDC
    Else
        ReleaseDC hWnd, hDC
    End If

    SetPicture
End Sub
如果有疑问请给我发消息!
接上面的!Private Sub mCursor_Click(Index As Integer)
    Dim i As Integer

    For i = 0 To 4
        mCursor(i).Checked = False
    Next
    mCursor(Index).Checked = True
End SubPrivate Sub mSaveFile_Click()
   On Error Resume Next
   With CommonDialog1
      .DialogTitle = "´æ´¢ÎÄ¼þ"
      .Filter = "Î»Í¼(*.bmp)|*.bmp"
      .CancelError = True
      .ShowOpen
      If Err.Number <> cdlCancel Then
         SavePicture picCopy.Picture, .FileName
      End If
   End With
End SubPrivate Sub mScreen_Click()
    mScreen.Checked = True
    mActiveWindow.Checked = False
End SubPrivate Sub VScroll1_Change()
    picCopy.Top = -VScroll1.Value
End Sub'抓取屏幕的同时获取鼠标的模块程序部分
Option ExplicitPublic Const GWL_WNDPROC = (-4)
Public Const WM_USER = &H400
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_LBUTTONUP = &H202Public Const NIM_ADD = 0
Public Const NIM_MODIFY = 1
Public Const NIM_DELETE = 2Public Const NIF_MESSAGE = 1
Public Const NIF_ICON = 2
Public Const NIF_TIP = 4Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End TypeType NOTIFYICONDATA
       cbSize As Long
       hWnd As Long
       uID As Long
       uFlags As Long
       uCallbackMessage As Long
       hIcon As Long
       szTip As String * 64
End TypeType POINTAPI
        x As Long
        y As Long
End TypeType ICONINFO
        fIcon As Long
        xHotspot As Long
        yHotspot As Long
        hbmMask As Long
        hbmColor As Long
End TypeDeclare Function GetIconInfo Lib "user32" (ByVal hIcon As Long, piconinfo As ICONINFO) As Long
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As LongDeclare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As LongDeclare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long
Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Declare Function BringWindowToTop Lib "user32" (ByVal hWnd As Long) As Long
Declare Function GetForegroundWindow Lib "user32" () As LongDeclare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongDeclare Function SetKeyboardHook Lib "KeybHook" (ByVal hwndPost As Long, ByVal Msg As Long) As Long
Declare Function ReleaseKeyboardHook Lib "KeybHook" () As LongPublic prevWndProc As LongFunction WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If Msg = WM_USER Then
        If wParam = vbKeyF7 And (lParam And &H80000000) <> 0 Then
            Form1.Capture
            Form1.picCopy.Refresh
            Form1.WindowState = vbNormal
            Form1.Show
        End If
    ElseIf Msg = WM_USER + 100 Then
        If lParam = WM_LBUTTONDBLCLK Then
            Form1.WindowState = vbNormal
            Form1.Show
        ElseIf lParam = WM_LBUTTONUP Then
            Form1.PopupMenu Form1.mTarget
        End If
    End If
    WndProc = CallWindowProc(prevWndProc, hWnd, Msg, wParam, lParam)
End Function如果有疑问请给我发消息!
我也作了个相似的程序.

调试易

200分但求屏幕广播源程序或方法思路

解决方案 »