eine Frage an die Freaks, die sich mit DshowMedia beschäftigen.
ich möchte ein Video innerhalb eines Programms ohne jegliche Benutzereingabe mehrfach wiedergeben.
Als Beispiel habe ich hier mal eine Schleife produziert.
Mir ist aber aufgefallen, dass der Speicher nach FreeMedia() nicht wieder freigegeben wird.
Zu beobachten im Taskmanager.
Was mache ich verkehrt bzw. gibt es dafür eine Lösung?
.
Debug "... end has been reached."
.
Code: Alles auswählen
; DshowMedia.pbi v1.1 for Purebasic v4, 2006 by Inc.
; EnableExplicit
; http://forums.purebasic.com/german/viewtopic.php?f=3&t=21119&hilit=DshowMedia&sid=266af683d8b079683e33ba7d6ebc66e2&start=40
; http://home.arcor.de/ffvfw/DshowMedia_Example.pb
; http://home.arcor.de/ffvfw/DshowMedia.pbi
; http://www.purebasic.fr/english/viewtopic.php?f=14&t=22824&hilit=directshow
Global VideoEnde
#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."
VideoEnde=1
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
Procedure ResizeVideo(*p.Dshow_Interfaces, new_w, new_h)
If *p
*p\pWindow\put_Width(new_w)
*p\pWindow\put_Height(new_h)
EndIf
EndProcedure
; DisableExplicit
; -------------------------------------------------------------------------------------------
; VideoBeispiel: www.tecbib.de/misc/reiten.avi
; 3,8MB ca. 15 Sek.
Global dl.b = 0
Global hwnd
Global hMedia
Global File.s = "C:\Test\reiten.avi"
Procedure StartFilm(*f)
Shared mutex
LockMutex(mutex)
hwnd = OpenWindow(0,20,20,500,500,"PB native Dshow example", #PB_Window_SystemMenu |#PB_Window_SizeGadget )
hMedia = InitMedia()
If hMedia
;File.s = "C:\Test\reiten.avi"
If File
If LoadMedia(hMedia, File, hwnd, #VMR7_Windowed, #WaveOutRenderer)
ResizeVideo(hMedia, 500, 500)
PlayMedia(hMedia)
EndIf
Else
FreeMedia(hMedia)
End
EndIf
EndIf
Repeat
Delay(5)
If OnMediaEvent(hMedia)
;VideoEnde = 1
;MediaStop(hMedia) ; ????
;FreeMedia(hMedia) ; ????
EndIf
Until VideoEnde = 1
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.
a= FreeMedia(hMedia)
dl=dl+1
VideoEnde = 0
UnlockMutex(Mutex)
EndProcedure
Procedure ct_StartFilm()
sf = CreateThread(@StartFilm(),1)
EndProcedure
mutex = CreateMutex()
For w = 1 To 3
ct_startfilm()
Next
Repeat
Delay(100)
Until dl=3
Delay(1000)
MessageRequester ("Film", "Ende")
End