Directshow Audio/Video for Captured device - vb.net

Directshow Audio/Video Capture
In VB.Net, I can capture the video from connected device, but unable to recieve any sound, as speakers are connected. I can play movies and mp3s from MediaPlayer. But, confused, why the sound is not coming. Please guide me to set audio filters in the following code. Please help, kindly make relevant changes in the following code...
Public Function FindCaptureDevice() As IBaseFilter
Debug.WriteLine("Start the Sub FindCaptureDevice")
Dim hr As Integer = 0
Dim classEnum As IEnumMoniker = Nothing
'Dim classEnum1 As IEnumMoniker = Nothing
Dim moniker As IMoniker() = New IMoniker(0) {}
Dim source As Object = Nothing
Dim devEnum As ICreateDevEnum = CType(New CreateDevEnum, ICreateDevEnum)
hr = devEnum.CreateClassEnumerator(FilterCategory.VideoInputDevice, classEnum, 0)
DsError.ThrowExceptionForHR(hr)
Marshal.ReleaseComObject(devEnum)
If classEnum Is Nothing Then
Throw New ApplicationException("No video capture device was detected.\r\n\r\n" & _
"This sample requires a video capture device, such as a USB WebCam,\r\n" & _
"to be installed and working properly. The sample will now close.")
End If
If classEnum.Next(moniker.Length, moniker, IntPtr.Zero) = 0 Then
Dim iid As Guid = GetType(IBaseFilter).GUID
moniker(0).BindToObject(Nothing, Nothing, iid, source)
Else
Throw New ApplicationException("Unable to access video capture device!")
End If
Marshal.ReleaseComObject(moniker(0))
Marshal.ReleaseComObject(classEnum)
Return CType(source, IBaseFilter)
End Function

Related

How to get/download the album art from internet for Music Player project

Hello i'm making Music player with clean look and great design and i'm about to finish it but i want to add a cool smart feature is when there is an internet connection and there isn't album cover in the mp3 file ('The song) then the program should download and get the cover by name of the mp3 file and if there is cover in the mp3 file use it (i already done that). all i wan't knew is to knew what i done wrong in this code. The problem is Msgbox appearing and says error in downloading song cover BUT why. Is there is something wrong in my code? and thanks for you time and helping me :)
''label13 and labell5 is the song name
''download cover if internet is avaiable
If My.Computer.Network.IsAvailable Then
Label13.Text = Label5.Text
Dim Clint As New WebClient()
Dim photolink As String = Nothing
Application.DoEvents()
Dim sourceCollection As String = Clint.DownloadString(New Uri("https://www.amazon.com/s?k=" + Label13.Text + "&i=digital-music&ref=nb_sb_noss"))
Dim Weber As New WebBrowser With {.ScriptErrorsSuppressed = True}
Weber.DocumentText = sourceCollection
Dim htmlColl As HtmlDocument = Weber.Document.OpenNew(True)
htmlColl.Write(sourceCollection)
If htmlColl.GetElementById("mp3StoreShovelerCell0") IsNot Nothing Then
Dim theHtmlElementCollection As HtmlElementCollection = htmlColl.GetElementById("mp3StoreShovelerCell0").GetElementsByTagName("img")
For Each curElement As HtmlElement In theHtmlElementCollection
photolink = curElement.GetAttribute("src")
Next
If photolink IsNot Nothing Then
photolink = photolink.ToString.Replace("._SL500_SS110_.jpg", "._SS500_.jpg")
BunifuImageButton2.ImageLocation = photolink
End If
Else
BunifuImageButton2.Image = My.Resources.clipart536736
MsgBox("Error in Downloading Song Cover")
End If
Else
Dim file As TagLib.File = TagLib.File.Create(AxWindowsMediaPlayer1.URL.ToString())
If (file.Tag.Pictures.Length > 0) Then
Dim bin = CType(file.Tag.Pictures(0).Data.Data, Byte())
BunifuImageButton2.Image = Image.FromStream(New MemoryStream(bin)).GetThumbnailImage(600, 600, Nothing, IntPtr.Zero)
BunifuImageButton7.Image = Image.FromStream(New MemoryStream(bin)).GetThumbnailImage(600, 600, Nothing, IntPtr.Zero)
Else
BunifuImageButton7.Image = My.Resources.clipart536736
End If
End If
BunifuImageButton7.Image = BunifuImageButton2.Image
''end of code cover

Memory files get trashed by third party software

I have an collection of apps that rely on memory files. I create them with a persistent app, then 3 apps update the files with GPS, IMU and switch data, and 3 apps read the current status and generate commands to servo controllers. This has worked fine for years, but today the apps failed due to missing memory files when I started a third party c# camera control app.
I suspect the other app overwrites the memory area. Is there a way to protect these memory files.
I am in Visual Studio 2017, Win10/64 and .net 4.6.1
I have included the create and sample read and write code - all of which have worked for years. I did update the system to current .net 4.6.1, and without the 3rd party app the system runs for hours without error. The instant I start the c# app compiled app the memory files disappear. I do not have access to the source, and am hopeless with C#.
Not a clue now, one solution is to install a new CPU and run the 3rd partys app on a separate box. There is no communication between my apps and it.
I create with :
Dim LoopForever As Boolean = True
Dim AHRS_Memory_File_Name As String = "AHRSMemoryData"
Dim GPS_Memory_File_Name As String = "GPSMemoryData"
Dim Switch_Memory_File_Name As String = "SwitchMemoryData"
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As
System.EventArgs) Handles Button1.Click
Dim MMS = MemoryMappedFile.CreateNew(Switch_Memory_File_Name, 20,
MemoryMappedFileAccess.ReadWrite)
Dim GPS = MemoryMappedFile.CreateNew(GPS_Memory_File_Name, 200,
MemoryMappedFileAccess.ReadWrite)
Dim AHRS = MemoryMappedFile.CreateNew(AHRS_Memory_File_Name, 200,
MemoryMappedFileAccess.ReadWrite)
Do Until LoopForever = False
Thread.Sleep(10000)
Loop
End Sub
A sample Write is
Sub WriteGPS_To_Memory()
Dim GPS_MMF = MemoryMappedFile.OpenExisting(GPS_Memory_File_Name)
Dim Bytes As Byte()
' This is the format of the current gps memory message
outMessage = GPSSpeedIn & "," & GPSBearing & "," & GPSLongitude & ","
& GPSLatitude & "," & GarminMagDeviationText & "," & GPSMessageCount
& "," & GPSAltitude & ","
Bytes = StrToByteArray(outMessage)
Try
Using writer = GPS_MMF.CreateViewAccessor(0, Bytes.Length)
writer.WriteArray(Of Byte)(0, Bytes, 0, Bytes.Length)
' writer.Dispose()
End Using
Catch ex As Exception
MsgBox("mem write error = " & ex.ToString)
End Try
And a sample read is
Dim MMF = MemoryMappedFile.OpenExisting(MEMS_Memory_File_Name)
Using reader = MMF.CreateViewAccessor(0, 200,
MemoryMappedFileAccess.Read)
Dim NewByteString = New Byte(200) {}
reader.ReadArray(Of Byte)(0, NewByteString, 0,
NewByteString.Length)
InMessage = Convert.ToString(NewByteString)
teststring = ""
CycleCount = CycleCount + 1
teststring = BitConverter.ToString(NewByteString)
For i As Integer = 0 To NewByteString.Length - 1
AHRS_CommDataIn =
System.Text.Encoding.ASCII.GetString(NewByteString)
Next
End Using
MMF.Dispose()
Best outcome is to find a way to protect these files. I am in the US, the vendor is in Israel and not particularly responsive.
There is time pressure on this as my company uses this software to locate water bodies producing mosquitoes (hate those pests) which distribute West Nile Virus, Denge and Malaria. Today we scrubbed a 300 sq mi mission affecting about 500K persons.
The issue was apparently in the third party software - they issued a updated program the day we posted the issue to their support site - so we must not have been to only site with this issue

Open raster file error: A Debugger is attached to w3wp exe but not configured

I have written a vb.net function to open a raster file. The function is as follows:
Public Function OpenRaster(ByVal directoryName As String, ByVal fileName As String) As IRaster
Dim workspaceFactory As IWorkspaceFactory
Dim rasterWorkspace As IRasterWorkspace
Dim rasterDataset As IRasterDataset = Nothing
Try
workspaceFactory = New RasterWorkspaceFactory
ESRI.ArcGIS.DataSourcesGDB.AccessWorkspaceFactoryClass()
rasterWorkspace = TryCast(workspaceFactory.OpenFromFile(directoryName, 0), IRasterWorkspace)
rasterDataset = rasterWorkspace.OpenRasterDataset(fileName)
Catch e As Exception
End Try
Dim pRasterLayer As IRasterLayer = New RasterLayer()
pRasterLayer.CreateFromDataset(rasterDataset)
Dim pRaster As IRaster = Nothing
pRaster = pRasterLayer.Raster
Return pRaster
End Function
The above function is throwing below error in TryCast statement :
A Debugger is attached to w3wp exe but not configured to debug this unhandled exception. To debug this expression detach the current debugger.
I searched on google also, some suggestions were to enable 32-bit in IIS application pool, but enabling this also is not making the code work

Proper clipboard format for Windows 10 Start Menu element

I'm implementing an IDropTarget COM interface which allow any OLE application to drag it's data over my application. However, it fails when I drop a menu item from Windows 10 Start Menu.
The code works fine with folders and files from the desktop or Windows Explorer, but fails when it comes from the Start Menu.
The code fails in iDataObject::QueryGetData using CFSTR_SHELLIDLIST clipboard format.
Someone knows what is the proper clipboard format used by a Start Menu item in Windows 10? Apparently I could use IDataObject::EnumFormatEtc but can not find any example.
Here is the relevant code:
_format = RegisterClipboardFormat(CFSTR_SHELLIDLIST)
Public Function DragDrop1(ByVal pDataObj As System.IntPtr, ByVal grfKeyState As Integer, ByVal pt As ShellCOM._POINT, ByRef pdwEffect As Integer) As Integer Implements ShellCOM.IDropTarget.DragDrop
Dim DataObj As ShellCOM.IDataObject
DataObj = Marshal.GetTypedObjectForIUnknown(pDataObj, GetType(ShellCOM.IDataObject))
If DataObj IsNot Nothing Then
Dim format As New FORMATETC
Dim medium As New STGMEDIUM
format.cfFormat = _format
format.ptd = 0
format.dwAspect = DVASPECT.DVASPECT_CONTENT
format.lindex = 0
format.Tymed = TYMED.TYMED_HGLOBAL
If DataObj.QueryGetData(format) = S_OK Then <----- code fail here, what is the correct format of an element from Windows 10 Start Menu?
' ....
' ....
End If
End If
Return S_OK
End Function
Problem solved. IDataObject::QueryGetData website indicates that currently only -1 is supported for lindex member. So now my app can get the menu item paths.
format.lindex = -1

How do I upload data to a server with valid SSL certificate using a client vb.net program?

I am working on a program and uploads a shipping manifest to a the shippers website. When I try to upload, I get a nondescript error back from their server, and when checking with the shipper, they tell me that "there is an issue with the SSL" I am using.
I've spent quite a bit of time piecing together code that, from what I seem to understand, is supposed to work, but I'm not making any progress. As far as I know everything else is fine with the upload, but there is a problem with my SSL certificate
If I understand what this code is supposed to do correctly, I should get a certificate from the shippers website, which allows certification to my program for a space of time during which I can upload the data. I'm really not sure that this is what my code is doing at all, but the only code examples I have seen show it something like this.
Here's my code with the URLs changed:
'This references a custom class that compiles the manifest I'm going to upload
Dim StringToUpload As String = Compile_Manifest(MyDate, UseTestDB)
Dim webClient As New System.Net.WebClient
webClient.Credentials = System.Net.CredentialCache.DefaultCredentials
'From what I understand,
'this is supposed to set up properties used in next section of code
System.Net.ServicePointManager.SecurityProtocol = Net.SecurityProtocolType.Ssl3
System.Net.ServicePointManager.ServerCertificateValidationCallback = _
AddressOf AcceptAllCertifications
'I can see that this reaches the server,
'but I don't know how it relates to the next section of code
'that actually uploads the manifest
Dim ServerRequest As System.Net.WebRequest = _
System.Net.WebRequest.Create("https://www.certify.some-shippper.com:443/somefolder")
Dim ServerResponse As System.Net.WebResponse
ServerResponse = ServerRequest.GetResponse()
ServerResponse.Close()
'This code works for the upload of the manifest,
'and it seems the above code is unrelated and does not use a SSL certificate.
'When this code runs I get the same error back from the shippers server,
'indicating an issue with my SSL, with or without the two sections of code above.
Dim StrResult As String = ""
Dim WrappedString As String = TransmitPLD.WrapPldFile(StringToUpload)
'This references a custom class that wraps the data to upload
'in information from the shipper.
Dim ByesToUpload As Byte() = _
System.Web.HttpUtility.UrlEncodeToBytes(WrappedString, _
System.Text.ASCIIEncoding.ASCII)
Dim Result As Byte() = _
webClient.UploadData("https://www.certify.some-shippper.com:443/somefolder", _
ByesToUpload)
StrResult = System.Web.HttpUtility.UrlDecode(Result, _
System.Text.ASCIIEncoding.ASCII)
MessageBox.Show(StrResult)
So it turns out I went about it the wrong way. I needed to upload my data through System.Net.WebRequest and it takes care of the certificates for me. Not implementing all the parts of the code I needed, it didn't handle the retrieval of the shipper's certificate.
In case anyone else gets confused about the matter like I did, here's my working code for anyone to see, adapt and use. My resource for fixing the code (and by that I mean starting from scratch) was the MSDN page for the WebRequest class, and it has code examples much the same as what I have below in C++, C#, and VB.NET and here is the link.
First there are some global variables that need to be set and class that needs to be created for to store the upload response:
' This is set in the function that Upload function
' and uploads the data in the ReadCallback sub
Private Shared WrappedString As String
' This is used to wait for the callback in the Upload function
Private Shared allDone As New Threading.ManualResetEvent(False)
Friend Class RequestState
' This class stores the request state of the request.
Public request As Net.WebRequest
Public Sub New()
request = Nothing
End Sub ' New
End Class ' RequestState
Then there is a sub needed for the upload part web request which will be called further below in the upload function:
Private Shared Sub ReadCallback(asynchronousResult As IAsyncResult)
Try
Dim myRequestState As RequestState = CType(asynchronousResult.AsyncState, RequestState)
Dim myWebRequest As Net.WebRequest = myRequestState.request
' End the request.
Dim streamResponse As IO.Stream = myWebRequest.EndGetRequestStream(asynchronousResult)
' Convert the string into a byte array.
Dim byteArray As Byte() = System.Text.Encoding.ASCII.GetBytes(WrappedString)
' Write the data to the stream.
streamResponse.Write(byteArray, 0, byteArray.Length)
streamResponse.Close()
' Allow the main thread to resume.
allDone.Set()
Catch ex As Exception
Throw New Exception("Error in " & Reflection.MethodBase.GetCurrentMethod.Name.ToString & " **" & ex.Message, ex)
End Try
End Sub ' ReadCallback
Finally, this is the function that should be called to upload the data, which uses all the code above:
Public Shared Function Upload(ByVal MyDate As Date) As String
Dim StrResult As String = ""
UploadSucess = False
Try
' This is my code that builds the manifest that I want to upload
Dim StringToUpload As String = Compile_PLD200(MyDate)
WrappedString = TransmitPLD.WrapPldFile(StringToUpload)
Dim myWebRequest As Net.WebRequest
myWebRequest = Net.WebRequest.Create("https://www.some.website.com:443/someplace")
' Create an instance of the RequestState and assign
' myWebRequest to it's request field.
Dim myRequestState As New RequestState()
myRequestState.request = myWebRequest
myWebRequest.ContentType = "multipart/mixed; boundary=BOUNDARY"
myRequestState.request.Method = "POST"
' Start the asynchronous 'BeginGetRequestStream' method call.
Dim r As IAsyncResult = CType(myWebRequest.BeginGetRequestStream(AddressOf ReadCallback, myRequestState), IAsyncResult)
' Pause the current thread until the async operation completes.
allDone.WaitOne()
' Send the Post and get the response.
Dim myWebResponse As Net.WebResponse = myWebRequest.GetResponse()
Dim streamResponse As IO.Stream = myWebResponse.GetResponseStream()
Dim streamRead As New IO.StreamReader(streamResponse)
Dim readBuff(256) As [Char]
Dim count As Integer = streamRead.Read(readBuff, 0, 256)
While count > 0
Dim outputData As New [String](readBuff, 0, count)
Console.WriteLine(outputData)
count = streamRead.Read(readBuff, 0, 256)
StrResult += outputData
End While
' Close the Stream Object.
streamResponse.Close()
streamRead.Close()
' Release the HttpWebResponse Resource.
myWebResponse.Close()
Catch ex As Exception
Throw New Exception("Error in " & Reflection.MethodBase.GetCurrentMethod.Name.ToString & " **" & ex.Message, ex)
End Try
Return StrResult
End Function ' Upload
Again here is the MSDN page for the WebRequest class which has a code example too.
Hope this helps anyone who was stuck like I was. And any criticisms as to the implementation of the code are welcome. This just happen to do what I want, I can't say it is the most efficient implementation.