Ah, danke inc.
also ich habe hier den Code nochmal angehängt, wenn du den Kopierst und in PB einfügst, haste du meine Nummerierung.
Ich habe als Test einmal eine ganz normale Send/Receive-networkfile Anwendung geschrieben.
Außerdem habe ich einen Video in 20 MB Pakete gespalten und versucht das erste Paket zu öffnen.
Code: Alles auswählen
; DshowMedia.pbi v1.1 for Purebasic v4, 2006 by Inc.
; EnableExplicit
#MaxWcharBuffer = 1024 ; In bytes!, Needed for media-filename and renderer-names
#S_OK = 0
#OATRUE = -1
#OAFALSE = 0
#CLSCTX_INPROC_SERVER = $01
#CLSCTX_INPROC_HANDLER = $02
#CLSCTX_LOCAL_SERVER = $04
#CLSCTX_REMOTE_SERVER = $10
#CLSCTX_ALL = #CLSCTX_INPROC_SERVER|#CLSCTX_INPROC_HANDLER|#CLSCTX_LOCAL_SERVER|#CLSCTX_REMOTE_SERVER
#CLSCTX_INPROC = #CLSCTX_INPROC_SERVER|#CLSCTX_INPROC_HANDLER
#CLSCTX_SERVER = #CLSCTX_INPROC_SERVER|#CLSCTX_LOCAL_SERVER|#CLSCTX_REMOTE_SERVER
#MAX_FILTER_NAME = 128
#WM_GRAPHEVENT = #WM_USER+1
#EC_COMPLETE = 1
#VMRMode_Windowed = $1
#VMRMode_Windowless = $2
#VMRMode_Renderless = $4
Enumeration ; Supported Dshow renderers
#Default ; Default system renderers in case of audio and video
#VMR9_Windowed
#VMR9_Windowless
#VMR7_Windowed
#VMR7_Windowless
#OldVideoRenderer
#OverlayMixer
#WaveOutRenderer
EndEnumeration
Enumeration ; MediaState
#State_Stopped
#State_Paused
#State_Running
EndEnumeration
Enumeration ; MediaSeeking
#AM_SEEKING_NoPositioning
#AM_SEEKING_AbsolutePositioning
EndEnumeration
Structure Dshow_Interfaces
pGraphBuilder.IGraphBuilder
pControl.IMediaControl
pEvent.IMediaEventEx
pWindow.IVideoWindow
pAudio.IBasicAudio
pVideo.IBasicVideo2
pSeeking.IMediaSeeking
EndStructure
CompilerIf Defined(FILTER_INFO, #PB_Structure) = #False
Structure FILTER_INFO ; an official Dshow structure - actually missing in PB
achName.w[#MAX_FILTER_NAME]
*pGraph.IFilterGraph
EndStructure
CompilerEndIf
CompilerIf Defined(IEnumFilters, #PB_Interface) = #False
Interface IEnumFilters
QueryInterface(a, b)
AddRef()
Release()
Next(a, b, c)
Skip(a)
Reset()
Clone(a)
EndInterface
CompilerEndIf
Macro FAILED(Status)
Status < 0
EndMacro
Macro SUCCEEDED(Status)
Status >= 0
EndMacro
Procedure.l L(*pWideChar, string.s) ; Ansi->Unicode
PokeS(*pWideChar, string, Len(string), #PB_Unicode)
ProcedureReturn *pWideChar
EndProcedure
Macro DEFINE_GUID(Name, l, w1, w2, b1, b2, b3, b4, b5, b6, b7, b8)
Global Name.GUID
Name\Data1 = l
Name\Data2 = w1
Name\Data3 = w2
Name\Data4[0] = b1
Name\Data4[1] = b2
Name\Data4[2] = b3
Name\Data4[3] = b4
Name\Data4[4] = b5
Name\Data4[5] = b6
Name\Data4[6] = b7
Name\Data4[7] = b8
EndMacro
DEFINE_GUID(CLSID_FilterGraph, $E436EBB3, $524F, $11CE, $9F, $53, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IGraphBuilder, $56A868A9, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IMediaControl, $56A868B1, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IMediaEventEx, $56A868C0, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IMediaSeeking, $36B73880, $C2C8, $11CF, $8B, $46, $00, $80, $5F, $6C, $EF, $60)
DEFINE_GUID(IID_IVideoWindow, $56A868B4, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IBasicAudio, $56A868B3, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IBasicVideo, $56A868B5, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IMediaSeeking, $36B73880, $C2C8, $11CF, $8B, $46, $00, $80, $5F, $6C, $EF, $60)
DEFINE_GUID(IID_IBaseFilter, $56A86895, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(CLSID_VideoMixingRenderer9, $51B4ABF3, $748F, $4E3B, $A2, $76, $C8, $28, $33, $0E, $92, $6A)
DEFINE_GUID(IID_IVMRFilterConfig9, $5A804648, $4F66, $4867, $9C, $43, $4F, $5C, $82, $2C, $F1, $B8)
DEFINE_GUID(IID_IVMRWindowlessControl9, $8F537D09, $F85E, $4414, $B2, $3B, $50, $2E, $54, $C7, $99, $27)
DEFINE_GUID(CLSID_VideoMixingRenderer, $B87BEB7B, $8D29, $423F, $AE, $4D, $65, $82, $C1, $01, $75, $AC)
DEFINE_GUID(IID_IVMRFilterConfig, $9E5530C5, $7034, $48B4, $BB, $46, $0B, $8A, $6E, $FC, $8E, $36)
DEFINE_GUID(IID_IVMRWindowlessControl, $0EB1088C, $4DCD, $46F0, $87, $8F, $39, $DA, $E8, $6A, $51, $B7)
DEFINE_GUID(CLSID_OverlayMixer, $CD8743A1, $3736, $11D0, $9E, $69, $00, $C0, $4F, $D7, $C1, $5B)
DEFINE_GUID(CLSID_VideoRenderer, $70E102B0, $5556, $11CE, $97, $C0, $00, $AA, $00, $55, $59, $5A)
DEFINE_GUID(CLSID_AudioRender, $E30629D1, $27E5, $11CE, $87, $5D, $00, $60, $8C, $B7, $80, $66)
DEFINE_GUID(TIME_FORMAT_MEDIA_TIME, $7B785574, $8C82, $11CF, $BC, $0C, $00, $AA, $00, $AC, $74, $F6)
Procedure InitMedia()
Protected a, b, c, d, e, f, *p.Dshow_Interfaces
*p = AllocateMemory(SizeOf(Dshow_Interfaces))
If *p
CoInitialize_(0)
If Not CoCreateInstance_(@CLSID_FilterGraph, #Null, #CLSCTX_INPROC_SERVER, @IID_IGraphBuilder, @*p\pGraphBuilder) = #S_OK
Debug "Error: Couldn't initialize the GraphBuilder Interface"
ProcedureReturn #False
Else
a = *p\pGraphBuilder\QueryInterface(@IID_IMediaControl, @*p\pControl)
b = *p\pGraphBuilder\QueryInterface(@IID_IMediaEventEx, @*p\pEvent)
c = *p\pGraphBuilder\QueryInterface(@IID_IVideoWindow, @*p\pWindow)
d = *p\pGraphBuilder\QueryInterface(@IID_IBasicAudio, @*p\pAudio)
e = *p\pGraphBuilder\QueryInterface(@IID_IBasicVideo, @*p\pVideo)
f = *p\pGraphBuilder\QueryInterface(@IID_IMediaSeeking, @*p\pSeeking)
If SUCCEEDED(a) And SUCCEEDED(b) And SUCCEEDED(c) And SUCCEEDED(d) And SUCCEEDED(e) And SUCCEEDED(f) ; Quick check
ProcedureReturn *p
Else
Debug "Error: Query of at least one of the needed Interfaces failed"
ProcedureReturn #False
EndIf
EndIf
Else
Debug "Error: Memory allocation while initializing media failed"
EndIf
EndProcedure
Procedure LoadMedia(*p.Dshow_Interfaces, filename.s, Parent=0, VidRenderer=0, AudRenderer=0)
Protected pVmr.IBaseFilter, pVidRend.IBaseFilter, pAudR.IBaseFilter, pFilter.IBaseFilter
Protected pEnum.IEnumFilters, pVMRCnfg.IVMRFilterConfig, pWc.IVMRWindowlessControl
Protected VMR.b, pIndividualRenderer, RendName.s, pFltrCnfg, pWndCntrl, vw, vh, cFetched
Protected FilterInfo.FILTER_INFO, *pWc = AllocateMemory(#MaxWcharBuffer)
If *p
If VidRenderer
If VidRenderer = #VMR9_Windowed Or VidRenderer = #VMR9_Windowless
pIndividualRenderer = @CLSID_VideoMixingRenderer9 : RendName = "Video Mixing Renderer 9"
ElseIf VidRenderer = #VMR7_Windowed Or VidRenderer = #VMR7_Windowless
pIndividualRenderer = @CLSID_VideoMixingRenderer : RendName = "Video Mixing Renderer"
ElseIf VidRenderer = #OverlayMixer
pIndividualRenderer = @CLSID_OverlayMixer : RendName = "Overlay Mixer"
ElseIf VidRenderer = #OldVideoRenderer
pIndividualRenderer = @CLSID_VideoRenderer : RendName = "Old Video Renderer"
EndIf
If CoCreateInstance_(pIndividualRenderer, #Null, #CLSCTX_INPROC, @IID_IBaseFilter, @pVidRend) = #S_OK
If *p\pGraphBuilder\AddFilter(pVidRend, L(*pWc, RendName)) = #S_OK
VMR = #False
If VidRenderer = #VMR9_Windowed Or VidRenderer = #VMR9_Windowless
pFltrCnfg = @IID_IVMRFilterConfig9
pWndCntrl = @IID_IVMRWindowlessControl9
VMR = #True
ElseIf VidRenderer = #VMR7_Windowed Or VidRenderer = #VMR7_Windowless
pFltrCnfg = @IID_IVMRFilterConfig
pWndCntrl = @IID_IVMRWindowlessControl
VMR = #True
EndIf
If VMR
If pVidRend\QueryInterface(pFltrCnfg, @pVMRCnfg) = #S_OK
pVMRCnfg\SetRenderingPrefs(1)
If VidRenderer = #VMR9_Windowed Or VidRenderer = #VMR7_Windowed
pVMRCnfg\SetRenderingMode(#VMRMode_Windowed)
ElseIf VidRenderer = #VMR9_Windowless Or VidRenderer = #VMR7_Windowless
pVMRCnfg\SetRenderingMode(#VMRMode_Windowless)
If pVidRend\QueryInterface(@pWndCntrl, @pWc) = #S_OK And Parent
pWc\SetVideoClippingWindow(Parent)
pWc\Release()
EndIf
EndIf
pVMRCnfg\Release()
Else
Debug "Error: Getting Interface for VMR Config failed"
EndIf
EndIf
Else
Debug "Error: Adding Individual video render filter failed"
EndIf
Else
Debug "Error: Couldn't Create Instance of individual video renderer"
EndIf
EndIf
If AudRenderer = #WaveOutRenderer
RendName = "AudioWaveOut Renderer"
If CoCreateInstance_(@CLSID_AudioRender, #Null, #CLSCTX_INPROC, @IID_IBaseFilter, @pAudR) = #S_OK
If *p\pGraphBuilder\AddFilter(pAudR, L(*pWc, RendName)) = #S_OK
Else
Debug "Error: Adding Individual audio render filter failed"
EndIf
Else
Debug "Error: Couldn't Create Instance of individual audio renderer"
EndIf
EndIf
If *p\pGraphBuilder\RenderFile(L(*pWc, filename), #Null) = #S_OK
If Parent
*p\pVideo\get_SourceWidth(@vw) : *p\pWindow\put_width(vw)
*p\pVideo\get_SourceHeight(@vh) : *p\pWindow\put_Height(vh)
*p\pWindow\put_Left(0)
*p\pWindow\put_Top(0)
*p\pWindow\put_Owner(Parent)
*p\pWindow\put_WindowStyle(#WS_CHILD| #WS_CLIPSIBLINGS)
*p\pWindow\put_Visible(#OATRUE)
EndIf
If *p\pEvent\SetNotifyWindow(GetForegroundWindow_(), #WM_GRAPHEVENT, *p) = #S_OK
If *p\pEvent\SetNotifyFlags(0) <> #S_OK
EndIf
Else
Debug "Info: Media notification callback has not been applied"
EndIf
If *p\pGraphBuilder\EnumFilters(@pEnum) = #S_OK
Debug " "
Debug "--------- Filtergraph ---------"
While pEnum\Next(1, @pFilter, @cFetched) = #S_OK
pFilter\QueryFilterInfo(@FilterInfo)
Debug PeekS(@FilterInfo\achName, #MAX_FILTER_NAME, #PB_Unicode)
If FilterInfo\pGraph <> #Null
FilterInfo\pGraph\Release()
EndIf
pFilter\Release();
Wend
Debug "--------------------------------------"
Debug " "
Else
Debug "Error: Could not enumerate filters"
EndIf
*p\pSeeking\SetTimeFormat(@TIME_FORMAT_MEDIA_TIME)
ProcedureReturn #True
Else
Debug "Error: Rendering file failed"
ProcedureReturn #False
EndIf
FreeMemory(*pWc)
Else
Debug "Fatal Error: The given handle of the media object hasn't been initialized!"
ProcedureReturn #False
EndIf
EndProcedure
Procedure PlayMedia(*p.Dshow_Interfaces)
If *p
ProcedureReturn *p\pControl\run()
EndIf
EndProcedure
Procedure PauseMedia(*p.Dshow_Interfaces)
If *p
ProcedureReturn *p\pControl\pause()
EndIf
EndProcedure
Procedure MediaSeek(*p.Dshow_Interfaces, pos.q)
Protected duration.q
If *p : pos * 10000
*p\pSeeking\GetDuration(@duration)
ProcedureReturn *p\pSeeking\SetPositions(@pos, #AM_SEEKING_AbsolutePositioning,@duration, #AM_SEEKING_NoPositioning)
EndIf
EndProcedure
Procedure MediaStop(*p.Dshow_Interfaces)
If *p
ProcedureReturn *p\pControl\stop()
EndIf
EndProcedure
Procedure MediaLenght(*p.Dshow_Interfaces)
Protected duration.q
If *p
*p\pSeeking\GetDuration(@duration)
ProcedureReturn duration/10000 ; result in ms
EndIf
EndProcedure
Procedure MediaWidth(*p.Dshow_Interfaces)
Protected vw.l
If *p
*p\pVideo\get_SourceWidth(@vw)
ProcedureReturn vw
EndIf
EndProcedure
Procedure MediaHeight(*p.Dshow_Interfaces)
Protected vh.l
If *p : *p\pVideo\get_SourceHeight(@vh)
ProcedureReturn vh
EndIf
EndProcedure
Procedure MediaPosition(*p.Dshow_Interfaces)
Protected pos.q
If *p : *p\pSeeking\GetCurrentPosition(@pos)
ProcedureReturn pos/10000 ; result in ms
EndIf
EndProcedure
Procedure MediaState(*p.Dshow_Interfaces)
Protected pfs.l
If *p
*p\pControl\GetState(10,@pfs)
ProcedureReturn pfs
EndIf
EndProcedure
Procedure FreeMedia(*p.Dshow_Interfaces)
Protected pfs.l
If *p
*p\pControl\GetState(10,@pfs)
If Not pfs = #State_Stopped
*p\pControl\stop()
EndIf
*p\pSeeking\Release()
*p\pVideo\Release()
*p\pAudio\Release()
*p\pWindow\Release()
*p\pEvent\Release()
*p\pControl\Release()
*p\pGraphBuilder\Release()
FreeMemory(*p)
CoUninitialize_()
ProcedureReturn #True
EndIf
EndProcedure
Procedure.f MediaFPS(*p.Dshow_Interfaces) ; return .f cause we just need float precision
Protected avgTimePerFrame.d
If *p
*p\pVideo\get_AvgTimePerFrame(@avgTimePerFrame)
If avgTimePerFrame > 0
ProcedureReturn 1/avgTimePerFrame
Else
ProcedureReturn #False
EndIf
EndIf
EndProcedure
Procedure CaptureCurrMediaImage(*p.Dshow_Interfaces, ResultingImgNo.l)
Protected DataSize.l, *pImg.BITMAPINFOHEADER, res.b
If *p : res = #False
If IsImage(ResultingImgNo) = 0
If *p\pVideo\GetCurrentImage(@DataSize, #Null) = #S_OK
*pImg = AllocateMemory(DataSize)
If *pImg
If *p\pVideo\GetCurrentImage(@DataSize, *pImg) = #S_OK
If CreateImage(ResultingImgNo, *pImg\biWidth, *pImg\biHeight, *pImg\biBitCount)
If SetDIBits_(0, ImageID(ResultingImgNo), 0, *pImg\biHeight, *pImg+*pImg\biSize, *pImg, #DIB_RGB_COLORS)
res = #True
EndIf
EndIf
Else
Debug "Info: Capturing current image not possible"
EndIf
FreeMemory(*pImg)
Else
Debug "Error: Allocating ImgBuffer memory failed"
EndIf
Else
Debug "Error: Couldn't measure needed imagebuffer - or actual media contains no videostream"
EndIf
Else
Debug "Error: ImageNumer already valid"
EndIf
If res : ProcedureReturn #True : EndIf
EndIf
EndProcedure
Procedure OnMediaEvent(*p.Dshow_Interfaces)
Protected EventCode.l, Param1.l, Param2.l
If *p
While *p\pEvent\GetEvent(@EventCode, @Param1, @Param2, 0) <> #E_ABORT
Select EventCode
Case #EC_COMPLETE
*p\pControl\stop() ; If an #EC_COMPLETE notify occurs we do change the media state to stopped
Debug "... end has been reached."
EndSelect
*p\pEvent\FreeEventParams(EventCode, Param1, Param2)
Wend
EndIf
EndProcedure
Procedure.s MediaTime2String(time.l)
Protected ti.s, SS, MM, HH, ms
ms = time%1000
SS = Int(time / 1000) : While SS > 59:SS-60:Wend
MM = Int(time / 1000 / 60) : While MM > 59:MM-60:Wend
HH = Int(time / 1000 / 60 / 60) : While HH > 59:HH-60:Wend
ti.s =RSet(StrU(HH,2),2,"0")+":"+RSet(StrU(MM,2),2,"0")+":"+RSet(StrU(SS,2),2,"0")+":"+RSet(StrU(ms,2),3,"0")
ProcedureReturn ti.s
EndProcedure
Procedure MediaGetVolume(*p.Dshow_Interfaces) ; from -100db to 0db
Protected db.l
If *p
*p\pAudio\get_Volume(@db)
ProcedureReturn db/100
EndIf
EndProcedure
Procedure MediaPutVolume(*p.Dshow_Interfaces, db.l) ; from -100db to 0db
If *p
If db > -85 And db < 1 ; dont change -85 to -101 as it will mess up WaveOut. A bug in the API ?
Delay(10) : *p\pAudio\put_Volume(db*100)
EndIf
EndIf
EndProcedure
Procedure MediaPutBalance(*p.Dshow_Interfaces, bal.l) ; -100 to +100
If *p
*p\pAudio\put_balance(bal*100)
EndIf
EndProcedure
Procedure MediaGetBalance(*p.Dshow_Interfaces) ; from -100 to +100
Protected bal
If *p
*p\pAudio\get_balance(@bal)
ProcedureReturn Int(bal/100)
EndIf
EndProcedure
; DisableExplicit
; Mini example v1.1 for DshowMedia.pbi for Purebasic v4, 2006 by Inc.
CompilerIf #PB_Compiler_Debugger = #False
MessageRequester("Info","Please run this example using the debugger and see its output while choosing a media file")
End
CompilerEndIf
hwnd = OpenWindow(0,20,20,352,288,"PB native Dshow example", #PB_Window_ScreenCentered|#PB_Window_SystemMenu )
hMedia = InitMedia()
If hMedia
File.s = OpenFileRequester("Choose media file","","All Files (*.*)|*.*",0)
If File
If LoadMedia(hMedia, File, hwnd, #VMR7_Windowed, #WaveOutRenderer)
mWidth = MediaWidth(hMedia) : mHeight = MediaHeight(hMedia)
If mWidth = 0 : mWidth = #PB_Ignore :EndIf
If mHeight = 0 : mHeight = #PB_Ignore :EndIf
ResizeWindow(0, #PB_Ignore, #PB_Ignore, mWidth, mHeight)
PlayMedia(hMedia)
Debug "lenght = "+MediaTime2String(MediaLenght(hMedia))+" (hh:mm:ss:ms)"
fps.f = MediaFPS(hMedia)
If fps ; Does media contain Videodata?
Debug "FPS = "+StrF(fps,3)
Debug "Width = "+Str(MediaWidth(hMedia))
Debug "Height = "+Str(MediaHeight(hMedia))
EndIf
Debug "playing ..."
Debug " "
Debug "esc = exit"
Debug "c = capture current image to C:/"
Debug "left/right keys = step forward/backward in 5% steps"
Debug "up/down keys = alter volume in 2db steps"
Debug " "
Repeat
Delay(5)
;Debug MediaTime2String(MediaPosition(hMedia)) ;- #### Uncomment this for watching continous counter ###
ev = WindowEvent()
If ev = #WM_KEYDOWN
wParam = EventwParam()
If wParam = #VK_ESCAPE
MediaPutVolume(hMedia,0)
FreeMedia(hMedia)
End
ElseIf wParam = #VK_C
If CaptureCurrMediaImage(hMedia, 99)
SaveImage(99, "G:/MyImage"+Str(im)+".bmp",#PB_ImagePlugin_BMP)
FreeImage(99)
im+1
Debug "Image "+Str(im)+" safed to C:/"
EndIf
ElseIf wParam = #VK_LEFT
MediaSeek(hMedia, MediaPosition(hMedia)-Int(MediaLenght(hMedia)/20)) ; 5% steps
ElseIf wParam = #VK_RIGHT
MediaSeek(hMedia, MediaPosition(hMedia)+Int(MediaLenght(hMedia)/20)) ; 5% steps
ElseIf wParam =#VK_UP
MediaPutVolume(hMedia, MediaGetVolume(hMedia)+2)
ElseIf wParam = #VK_DOWN
MediaPutVolume(hMedia ,MediaGetVolume(hMedia)-2)
EndIf
ElseIf ev = #WM_GRAPHEVENT
OnMediaEvent(EventlParam())
EndIf
Until ev = #PB_Event_CloseWindow
MediaPutVolume(hMedia,0) ; '0' means 0db = maxVolume --> this is necessary! Otherwise the system sound device will keep the vol state even when appl. has been closed.
FreeMedia(hMedia)
End
EndIf
Else
FreeMedia(hMedia)
End
EndIf
EndIf
