Windows Pro 7
Create a Video Library with an Embedded Windows Media Player
I have close to 400 video clips in my home movie library. In order to quickly locate any given video I have added certain words into the file names. Even so, locating specific files is clumsy from the Explorer window and playing a clip requires starting an external application and flipping back and forth between Explorer and the media player. That's why I decided to embed the media player directly in the application.
Given a choice, I would have preferred to embed vlc Media Player, however, extensive searching on a procedure to do this proved fruitless. I followed the youtube videos to the letter and got only errors when trying to add the vlc control to my form. As such I was reduced to using Windows Media Player (which supports fewer formats).
I am going to present my application in four parts
- Introduction to Alternate Data Streams
- Comment text interface code
- Embedding Windows Media Player
- Adding the functionality
You can only store so much information in a file name before it becomes unwieldy. A better approach would be to store a few useful tags such as date/time, location and names in the file name, then store more descriptive text in a file comment. While Windows provides the capability of adding comments to files, this is available for only certain file types, and the comments cannot be manipulated via code. This is where Alternate Data Streams come in handy.
1. Introduction to Alternate Data Streams
If you've ever run a downloaded program and seen the dialog box titled Open File - Security Warning and the question Do you want to run this file? then you've come across an NTFS Alternate Data Stream (henceforth ADS). The downloaded file may have a name like
but hidden in the directory entry for that file is an ADS named
This is a sort of hidden file which can contain anything that a regular file contains. A file can contain any number of alternate data streams as long as each has a unique name. The contents can be text, jpg or avi data, or even executable code. In this case it is just text and if you do
cat < newApp-setup.exe:Zone.Identifier
It is the presence of this ADS with the given text that results in the warning. I am going to create an ADS named :comment and use it to store a comment for each file. The bad news is that you cannot manipulate ADS using native vb.net I/O calls. The good news is that it is easily done using the Scripting.FileSystemObject. More on this in part 2.
2. Comment text interface code
Because I use the comment ADS in other applications I created a separate module containing the interface code. Let's put a little code at the start of the module
Const ADSPART As String = ":comment" Private fso As New Scripting.FileSystemObject Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal filename As String) As Long
ADSPART just defines the name of the ADS part of the file name.
fso is the Scripting.FileSystemObject. In order to use this you will have to add a COM reference to Microsoft Scripting Runtime.
The Kernel32 function DeleteFile is required to delete an existing ADS as for some strange reason this cannot be done via the FileScriptingObject which is capable of manipulating other ADS aspects..
The first function we are going to add will determine if a file has a comment ADS.
''' <summary> ''' Returns true if the given file has a non-blank comment, False otherwise. ''' </summary> ''' <param name="filename">Fully qualified name of file to check</param> ''' <returns>True if a comment exists, false otherwise</returns> ''' <remarks></remarks> Public Function HasComment(filename As String) As Boolean Return Trim(GetComment(filename)) <> "" End Function
In this case, if an ADS is present but empty I also return False. The next function retrieves a comment from a file.
''' <summary> ''' Returns the comment (if it exists) from the given file. ''' </summary> ''' <param name="filename">Fully qualified name of file</param> ''' <returns>The comment</returns> ''' <remarks></remarks> Public Function GetComment(filename As String) As String 'Returns the comment for the given file, or the null string if not present. 'If there is a null ADS then the ADS is removed. Dim ads As String = filename & ADSPART Dim comment As String = "" If fso.FileExists(ads) Then Dim tso As Scripting.TextStream = fso.OpenTextFile(ads) If Not tso.AtEndOfStream Then comment = tso.ReadAll tso.Close() Else DeleteComment(filename) End If End If Return comment End Function
The first step is to create the name of the ADS by appending ":comment" to the file name. If the ADS exists and can be read then we return the text. If there is a problem reading it then I just delete it because it's of no use if it's not readable.
The next function sets a file comment. Because I have already decided that a null comment is useless, if the comment text is null then I delete any existing comment ADS.
''' <summary> ''' Sets the comment for a file ''' </summary> ''' <param name="filename">Fully qualified name of file</param> ''' <param name="comment">Comment text (null to delete comment)</param> ''' <remarks></remarks> Public Sub SetComment(filename As String, comment As String) Dim ads As String = filename & ADSPART If Not fso.FileExists(filename) Then Exit Sub If comment = "" Then DeleteComment(filename) Else Dim tso As Scripting.TextStream = fso.OpenTextFile(ads, Scripting.IOMode.ForWriting, True) tso.Write(Trim(comment)) tso.Close() End If End Sub
Lastly, let's have a function to delete any existing comment ADS.
''' <summary> ''' Delete a file comment ''' </summary> ''' <param name="filename">Fully qualified name of file</param> ''' <remarks></remarks> Public Sub DeleteComment(filename As String) Dim ads As String = filename & ADSPART If Not fso.FileExists(ads) Then Exit Sub DeleteFile(ads) End Sub
Aside from some header comments and the Module and End Module statements, the module is complete.
3. Embedding Windows Media Player
To add a Windows Media Player control to your form you must do the following:
- Right click on the vb.net toolbox
- Select Choose Items... from the context menu
- Select the Com Components tab
- Select Windows Media Player
- Click OK
You will see Windows Media Player added to the Common Controls section of the toolbox. You can drag and drop the control onto your form just like any other control. But before you do that, let's create some other controls first.
Start a new project and size the new form to 800, 600. Add a SplitContainer.
Add a listbox control named lbxFiles to the left panel and set the Dock property to Fill.
Add a Panel control to the right panel and set the Dock property to Top. Set the height of the panel to 32.
Add two button controls to the left side of the panel and name them btnAll and btnAny. Set the button widths to 33 and set the button text to All and Any.
Add a textbox control named txtWords to the right of btnAny and let it fill the remaining width of the panel. Anchor it to Top, Left & Right.
Add a textbox control named txtComment to the bottom of the right panel. Make it MultiLine and Dock it to Bottom. Set the height to around 87 (actual height may vary depending on the font).
Now you can drag and drop a Windows Media Player control named wmp to the middle of the right panel and set Dock to Fill.
Your form should now look like
The way to play a video in the control is
- tell the control the fully qualified file name of the media file
(optional) tell the player to fill the window
wmp.URL = SomeFileName
wmp.stretchToFit = True
The video starts to play automatically when loaded. By setting the stretchToFit property, resizing the window will automatically resize the video as well. As a bonus, you can toggle the video between windowed and full screen view by double clicking. No extra coding is required.
4. Adding the functionality
Now lets add the rest of the bells and whistles. To make the typing a little easier lets add
Imports WMPLib Imports AxWMPLib Imports System.IO.Path
Also, let's add a few globals.
Public Version As String = "Version 2.0.0" 'default path for videos Private Root As String = "E:\Home Movies" Private fldBrowser As New FolderBrowserDialog 'array of valid video files for Windows Media Player Private FileMask() As String = "*.avi *.mp4 *.mkv *.divx *.mpg *.mov *.mp4 *.mpeg".Split 'key = unqualified file name 'val = fully qualified file name Private FileList As New Dictionary(Of String, String) 'key = unqualified file name 'val = comment Private Comments As New Dictionary(Of String, String) 'set this to true during file renaming Private Renaming As Boolean = False 'set true to play video on selection Private AutoPlay As Boolean = True Private CurrFull As String = "" 'current fully qualified file name Private CurrFile As String = "" 'current unqualified file name
FileList will contain the unqualified and fully qualified file names of all media files in the current folder (defined by Root).
Comments will contain the unqualified file names and the comment (if any) associated with each file.
CurrFull and CurrFile could just as easily be retrieved from lbxFiles and FileListbut I prefer a simpler way to refer to them rather than lbxFiles.SelectedItem.blah.blah.blah.
I also like to bring the application up in (more or less) the state that I left it so I define a few Settings variables.
LastRoot - the last used media folder
LastLocn - the last screen location of this app
LastSize - the last size of the app window
LastSplit - the last size of the split container left panel
AutoPlay - the last state of the autoplay option
The main form is named frmMain and has the following properties set
KeyPreview = True Text = "Home Movie Viewer"
Event handlers for frmMain are
Private Sub frmMain_Load(sender As Object, e As System.EventArgs) Handles Me.Load 'load last used settings With My.Settings Me.Location = .LastLocn Me.Size = .LastSize Me.Root = .LastRoot Me.AutoPlay = .AutoPlay SplitContainer1.SplitterDistance = .LastSplit End With 'set folder browser dialog defaults If My.Computer.FileSystem.DirectoryExists(Root) Then fldBrowser.SelectedPath = Root Else fldBrowser.SelectedPath = "C:\" End If fldBrowser.ShowNewFolderButton = False ReadFiles() 'get a list of all media files ClearComment() 'clear the displayed comment btnAll.PerformClick() 'display the current file list End Sub Private Sub frmMain_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing 'save current settings for next session With My.Settings .LastLocn = Me.Location .LastSize = Me.Size .LastRoot = Me.Root .AutoPlay = Me.AutoPlay .LastSplit = SplitContainer1.SplitterDistance End With SaveComment() 'save any modified comments BackupComments() 'save all comments to text file End Sub
SaveComment will save any changes that have been made to the comment for the current media file.
BackupComments saves all comments for the current media folder in a file named ".comments.txt" in the current folder. Alternate Data Streams are not supported on other file systems, and some copy programs do not copy ADS even between NTFS volumes so I like to keep a copy of the comments in a plain text file (I have a general purpose commenting app that makes use of this backup). Feel free to remove this call if you like.
I make frequent use of hotkeys so let's add a handler for those
Private Sub frmMain_KeyPress(sender As System.Object, e As System.Windows.Forms.KeyPressEventArgs) Handles MyBase.KeyPress 'Process global hotkeys Select Case Asc(e.KeyChar) Case 1 'ctrl-a - select all if comment has focus otherwise toggle AutoPlay If txtComment.Focused Then txtComment.Select(0, 99999) Else AutoPlay = Not AutoPlay Me.Text = "AutoPlay is " & IIf(AutoPlay, "ON", "OFF") End If e.Handled = True Case 6 'ctrl-f select new media folder 'ask the user to select a new media folder If fldBrowser.ShowDialog = Windows.Forms.DialogResult.OK Then SaveComment() 'save any changed comments BackupComments() 'backup comments for this folder ClearComment() 'clear the displayed comment Root = fldBrowser.SelectedPath txtWords.Text = "" ReadFiles() btnAll.PerformClick() End If e.Handled = True Case 18 'ctrl-r rename the currently selected file If lbxFiles.SelectedIndex < 0 Then Exit Sub Dim oldbase As String = GetFileNameWithoutExtension(CurrFile) Dim oldextn As String = GetExtension(CurrFile) Dim newname As String = Trim(InputBox("Enter new name", "Rename File", oldbase)) 'Copy the new name to the clipboard. That way if the user enters 'a name that is not valid he/she can just paste the invalid name 'back in and modify it instead of starting from scratch. If newname <> "" Then My.Computer.Clipboard.SetText(newname) If My.Computer.FileSystem.FileExists(Combine(Root, newname & oldextn)) Then MsgBox("There is already a file with that name", vbOKOnly) Else RenameFile(CurrFull, newname & oldextn.ToLower) End If End If e.Handled = True End Select End Sub
Before you can play a file you have to see what files are available. Let's add the code to read the file list.
''' <summary> ''' Read all media files in the current folder ''' </summary> ''' <remarks></remarks> Private Sub ReadFiles() SaveComment() ClearComment() 'clear the filelist and comments dictionaries for rebuilding FileList.Clear() Comments.Clear() CurrFile = "" CurrFull = "" 'If a video file does not have a comment then one will be added consisting 'of the file name without the extension. That means we will only have to 'search comment text rather than comment text and file names. For Each fullname In My.Computer.FileSystem.GetFiles(Root, FileIO.SearchOption.SearchTopLevelOnly, FileMask) Dim filename As String = System.IO.Path.GetFileName(fullname) Dim basename As String = System.IO.Path.GetFileNameWithoutExtension(filename) FileList.Add(filename, fullname) If HasComment(fullname) Then Comments.Add(filename, GetComment(fullname)) Else Comments.Add(filename, basename & vbCrLf & vbCrLf) SetComment(fullname, basename & vbCrLf & vbCrLf) End If Next End Sub
When the user selects a new file it will begin playing immediately unless explicitly stopped.
Private Sub lbxFiles_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles lbxFiles.SelectedIndexChanged 'User has selected a new file (ignore during rename operation) If Renaming Then Exit Sub Dim lbx As ListBox = sender If lbx.SelectedIndex = -1 Then Exit Sub SaveComment() 'Display the file name in the title bar and begin playback CurrFile = lbx.SelectedItem CurrFull = FileList(CurrFile) If Comments.ContainsKey(CurrFile) Then txtComment.Text = Comments(CurrFile) Else txtComment.Text = "" End If txtComment.Tag = txtComment.Text Me.Text = CurrFull 'play the current file unless autoplay is disabled. wmp.URL = CurrFull If Not AutoPlay Then wmp.Ctlcontrols.stop() wmp.stretchToFit = True End Sub
Now we can add the filtering capability. We'll add some flexibility here. I boiled down the options to two basics, All and Any. The user will type words into a textbox and click All to display only those files containing all of the words, or Any to display the files containing any of the words. I wanted a little more flexibility so instead of a strict word match I made it a "starts with" match. That way I could enter Adam and get videos containing Adam at the zoo as well as Adam's first birthday. A strict word match would not have matched the second file. Also, for a little extra I decided that if you hold the control key while clicking it would do the matching by string rather than by word (ear would match bearing, for example).
Private Sub btnAll_Click(sender As System.Object, e As System.EventArgs) Handles btnAll.Click 'Show only files with comments containing all of the given strings wmp.Ctlcontrols.stop() ClearComment() Dim mode As String = IIf(My.Computer.Keyboard.CtrlKeyDown, "STRING", "WORD") Dim words() As String = txtWords.Text.Split() lbxFiles.Items.Clear() For Each file As String In Comments.Keys Dim all As Boolean = True For Each word As String In words If Not FoundIn(Comments(file), word, mode) Then all = False Exit For End If Next If all Then lbxFiles.Items.Add(file) End If Next Me.Text = lbxFiles.Items.Count & " matching files in " & Root End Sub Private Sub btnAny_Click(sender As System.Object, e As System.EventArgs) Handles btnAny.Click 'Show only files with comments containing any of the given words. wmp.Ctlcontrols.stop() ClearComment() Dim mode As String = IIf(My.Computer.Keyboard.CtrlKeyDown, "STRING", "WORD") Dim words() As String = LCase(txtWords.Text).Split() lbxFiles.Items.Clear() For Each file As String In Comments.Keys For Each word As String In words If FoundIn(Comments(file), word, mode) Then lbxFiles.Items.Add(file) Exit For End If Next Next Me.Text = lbxFiles.Items.Count & " matching files in " & Root End Sub ''' <summary> ''' Look for occurrences of a word in the given text ''' </summary> ''' <param name="text">A text string to search</param> ''' <param name="word">The word to search for</param> ''' <param name="mode">Match type = "STRING" or "WORD"</param> ''' <returns>True if a match was found, False otherwise</returns> ''' <remarks>Search is case insensitive</remarks> Private Function FoundIn(text As String, word As String, mode As String) As Boolean 'Return true only if the given text contains the given word. Select Case mode Case "WORD" 'match if any word in text starts with the given word 'look for word in wordlist from file tags For Each tag As String In text.Split() If tag.StartsWith(word, StringComparison.OrdinalIgnoreCase) Then Return True Next Return False Case "STRING" 'match if the given word is found anywhere in text 'look for word anywhere in filename string Return InStr(text, word, CompareMethod.Text) > 0 Case Else Return False End Select End Function
And because I am allowing some tags in the file names it makes sense to allow the user to rename a file (CTRL-R in the hotkeys).
''' <summary> ''' Rename the current file ''' </summary> ''' <param name="oldname">Fully qualified old file name</param> ''' <param name="newname">Unqualified new file name</param> ''' <remarks></remarks> Private Sub RenameFile(oldname As String, newname As String) 'Rename the currently selected file. We want to set the global Renaming 'flag because during the renaming process the lbxFiles.SelectedIndexChanged 'event will be triggered and we want to ignore these events unless triggered 'explicitly by the user selecting a file. Renaming = True Try My.Computer.FileSystem.RenameFile(oldname, newname) 'update FileList and Comments dictionaries to reflect new file name FileList.Remove(CurrFile) FileList.Add(newname, oldname) Comments.Add(newname, Comments(CurrFile)) Comments.Remove(CurrFile) 'update displayed file list lbxFiles.Items(lbxFiles.SelectedIndex) = newname lbxFiles.SelectedIndex = lbxFiles.FindString(newname) CurrFile = newname CurrFull = Combine(Root, newname) Me.Text = CurrFull Catch ex As Exception MsgBox(ex.Message, vbOKOnly, "Could not rename file") End Try Renaming = False End Sub
Now we can add the few remaining housekeeping routines.
Private Sub ClearComment() 'clear the current comment display txtComment.Text = "" txtComment.Tag = "" End Sub Private Sub SaveComment() 'save the current comment if changed by user If CurrFull <> "" And txtComment.Text <> txtComment.Tag Then SetComment(CurrFull, txtComment.Text) txtComment.Tag = txtComment.Text Comments(CurrFile) = txtComment.Text End If End Sub ''' <summary> ''' Copies all file comments to .comments.txt ''' </summary> ''' <remarks></remarks> Private Sub BackupComments() Dim buffer As New System.Text.StringBuilder 'We could just write the comments for the video files but that may overwrite comments 'in the .comments.txt file for files of other types. For Each file In My.Computer.FileSystem.GetFiles(Root, FileIO.SearchOption.SearchTopLevelOnly) If HasComment(file) Then Dim comment As String = GetComment(file).Replace(vbCrLf, "\n").Replace(vbTab, "\t") Dim line As String = GetFileName(file) & "*" & comment buffer.Append(line & vbCrLf) End If Next System.IO.File.WriteAllText(Combine(Root, ".comments.txt"), buffer.ToString) End Sub
That's the entire application. Strictly speaking, to embed Windows Media Player, all you really need is to add the control to the toolbox (section 3), include
Imports WMPLib Imports AxWMPLib
and add the line
wmp.URL = SomeFileName
But where would be the fun in stopping there? I've attached the zipped project folder. It contains a little extra code such as a help window and a handler so that pressing ENTER in the txtWords control automatically clicks All.
As always, constructive comments are appreciated.