VB.net getting tag info into mp3 files - mediaelement

How can I get internal info about sound files using a MediaElement?
I know how to get the duration of a song file with NaturalDuration property but I want to get access to Author and others tag that many mp3 files include into themselves. Is there some way to do this using just MediaElement? I know how to do it but only with WMP and I really need to do it just with a MediaElement because my application is a UWP application.
Thanks!!!

Ok, late and may be not so elegant but this was my solution for getting duration of a mp3 file. I used MusicProperties Class. With this class you get access for any music tag information into the file.
Public Function infoMP3(elfichero As String) As String
Dim salida As String = ""
Dim miTask = Task.Run(Async Function() As Task(Of String)
Dim musicFile As StorageFile = Await StorageFile.GetFileFromPathAsync(elfichero)
Dim FileProperties As StorageItemContentProperties = musicFile.Properties
Dim musicFileProperties As MusicProperties = Await FileProperties.GetMusicPropertiesAsync()
Dim tiempo = musicFileProperties.Duration
Dim horas As String
If tiempo.Hours < 10 Then
horas = "0" & tiempo.Hours.ToString
Else
horas = tiempo.Hours.ToString
End If
Dim minutos As String
If tiempo.Minutes < 10 Then
minutos = "0" & tiempo.Minutes.ToString
Else
minutos = tiempo.Minutes.ToString
End If
Dim segundos As String
If tiempo.Seconds < 10 Then
segundos = "0" & tiempo.Seconds.ToString
Else
segundos = tiempo.Seconds.ToString
End If
Dim autor = musicFileProperties.Artist
Dim titulo = musicFileProperties.Title
Dim presalida As String = "[" & horas & ":" & minutos & ":" & segundos & "];[" & titulo & "];[" & autor & "] " & elfichero
Return presalida
End Function)
miTask.Wait()
salida = miTask.Result
Return salida
End Function
To get access to the files later on Windows 10, you have to save permission for the files and/or folders. Do this when you select them.
... Dim listToken = Windows.Storage.AccessCache.StorageApplicationPermissions.FutureAccessList.Add(rutaS) ...
where rutaS is an SotorageFolder object.

Related

ADO adLockBatchOptimistic allows updates on modified records

I'm begging for help, since I'm too stupid.
What I do:
Open connection to Access DB
Download Table to a Recordset
Disconnect the RecordSet
Update a record
Update the same record in DB (by another user)
Connect RecordSet back to DB
UpdateBatch affected record
Yesterday it was throwing an error that the record has been modified in the meantime.
Today it's updating the record without any issues.
I would bet my arm I haven't changed anything...
I open the recordset with following settings (first set them, then open):
.CursorLocation = adUseClient
.LockType = adLockBatchOptimistic
I beg everyone for help
Example Code:
Dim DB_FOLDER_PATH As String
Dim DB_FILE_NAME As String
Dim DB_FILE_PATH As String
Dim CONNECTION As ADODB.CONNECTION
Dim CONNECTION_STRING As String
Dim QUERY_STRING As String
Dim tmp_RS As ADODB.Recordset
Dim tmp_RS2 As ADODB.Recordset
DB_FOLDER_PATH = "\\XXXXX\userdata\XXXXX\home\Documents\Data Base\"
DB_FILE_NAME = "TEST"
DB_FILE_PATH = DB_FOLDER_PATH & DB_FILE_NAME & ".accdb"
Set CONNECTION = New ADODB.CONNECTION
CONNECTION_STRING = "Provider=Microsoft.ACE.OLEDB.12.0" & ";" & "Data Source=" & DB_FILE_PATH & ";" & "Persist Security Info=False"
CONNECTION.Open CONNECTION_STRING
QUERY_STRING = "SELECT" & " " & "*" & " FROM [" & "DATA" & "]" & ";"
Set tmp_RS = New ADODB.Recordset
With tmp_RS
.CursorLocation = adUseClient
.LockType = adLockBatchOptimistic
.Open QUERY_STRING, CONNECTION
.ActiveConnection = Nothing
End With
Set tmp_RS2 = New ADODB.Recordset
With tmp_RS2
.CursorLocation = adUseClient
.LockType = adLockBatchOptimistic
.Open QUERY_STRING, CONNECTION
.ActiveConnection = Nothing
End With
With tmp_RS
.Fields("FIELD_LONG_TEXT_PLAIN").Value = "ABC"
.Update
.ActiveConnection = CONNECTION
.UpdateBatch
End With
With tmp_RS2
.Fields("FIELD_LONG_TEXT_PLAIN").Value = "ZXC"
.Update
.ActiveConnection = CONNECTION
.UpdateBatch
End With
Best Regards,
Michal

Save outlook message as eml incomplete (body missing,attachments not opening,...)

I try to save outlook mails within an SQL-BLOB-Field as eml (or raw) content.
I have a form within MS Access to get the mails from outlook code:
Dim objitem As Outlook.MailItem
Set objOutlook = New Outlook.Application
Set objMapiFolder = objOutlook.Session.Folders("USER").Folders("Posteingang")
Dim inboundemail As ADODB.Recordset
Set inboundemail = New ADODB.Recordset
inboundemail.Open "Inbound_EMail_Buffer", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
Set MailList = objMapiFolder.Items
Dim senderMail As String
Dim ReceiverMail As String
FillAddress
Dim SAfeMailItem
Set SAfeMailItem = CreateObject("Redemption.SafeMailItem")
For Each objitem In MailList
If objitem.Class = olMail Then
With objitem
inboundemail.AddNew
Select Case .SenderEmailType
Case "SMTP"
senderMail = .SenderEmailAddress
Case "EX"
senderMail = FindAddress(.SenderEmailAddress)
End Select
inboundemail!From = Left(Chr(34) & .SenderName & Chr(34) & " <" & senderMail & ">", 80)
inboundemail!To = .To
inboundemail!CC = .CC
inboundemail!Subject = Left(.Subject, 80)
inboundemail!DateReceived = .ReceivedTime
inboundemail!uid = .EntryId
SAfeMailItem.Item = objitem
x = SAfeMailItem.SaveAs("c:\temp\" & .EntryId & ".eml", olRFC822)
inboundemail!Size = .Size
inboundemail.Update
End With
End If
Next objitem
Me.ctlDocuments.Requery
Set objitem = Nothing
Set objOutlook = Nothing
Unfortunately the original Mail isn't saved complete
this is the mail in outlook
this is the saved .eml mail
saved eml after 5.23

Google Closure Compile REST Api suddenly Throws Error 405 "Method not allowed"

I've been using Closure as part of y application to compress Javascript for a while now, but just started getting an error 405 - Method not allowed
My code as below was working for a couple of years, but has now stopped.
NOTE: this is not called frequently, just when ever any changes are detected in the Javascript files in my application.
I get no further error information from the Closure app than this.
Obviously this code performs a POST operation. If I use the form found here https://closure-compiler.appspot.com/home, it works, but if I either browser to the URL or use my code I get Error 405, it's almost as if my code is trying a GET method... but it's not...
Any ideas?
Public Class Closure
Property OriginalCode As String
Property CompiledCode As String
Property Errors As ArrayList
Property Warnings As ArrayList
Property Statistics As Dictionary(Of String, Object)
Public Sub New(Input As String, Optional CompliationLevel As String = "SIMPLE_OPTIMIZATIONS")
Dim _HttpWebRequest As HttpWebRequest
Dim _Result As StringBuilder
Dim ClosureWebServiceURL As String = "http://closure-compiler.appspot.com/compile?"
Dim ClosureWebServicePOSTData As String = "output_format=json&output_info=compiled_code" &
"&output_info=warnings" &
"&output_info=errors" &
"&output_info=statistics" &
"&compilation_level=" & CompliationLevel & "" &
"&warning_level=default" &
"&js_code={0}"
'// Create the POST data
Dim Data = String.Format(ClosureWebServicePOSTData, HttpUtility.UrlEncode(Input))
_Result = New StringBuilder
_HttpWebRequest = DirectCast(WebRequest.Create(ClosureWebServiceURL), HttpWebRequest)
_HttpWebRequest.Method = "POST"
_HttpWebRequest.ContentType = "application/x-www-form-urlencoded"
'//Set the content length to the length of the data. This might need to change if you're using characters that take more than 256 bytes
_HttpWebRequest.ContentLength = Data.Length
'//Write the request stream
Using SW As New StreamWriter(_HttpWebRequest.GetRequestStream())
SW.Write(Data)
End Using
Try
Dim response As WebResponse = _HttpWebRequest.GetResponse()
Using responseStream As Stream = response.GetResponseStream
Dim encoding As Encoding = System.Text.Encoding.GetEncoding("utf-8")
Using readStream As New StreamReader(responseStream, encoding)
Dim read(256) As Char
Dim count As Integer = readStream.Read(read, 0, 256)
While count > 0
Dim str As New String(read, 0, count)
_Result.Append(str)
count = readStream.Read(read, 0, 256)
End While
End Using
End Using
Dim js As New JavaScriptSerializer
js.MaxJsonLength = Int32.MaxValue
Dim d As Dictionary(Of String, Object) = js.Deserialize(Of Dictionary(Of String, Object))(_Result.ToString())
Me.CompiledCode = d.NullKey("compiledCode")
Me.Warnings = TryCast(d.NullKey("warnings"), ArrayList)
Me.Errors = TryCast(d.NullKey("errors"), ArrayList)
Me.Statistics = TryCast(d.NullKey("statistics"), Dictionary(Of String, Object))
Catch ex As Exception
Me.CompiledCode = ""
If Me.Errors Is Nothing Then
Dim er As New List(Of String)
er.Add(ex.ToString())
Me.Errors = New ArrayList(er)
Else
Me.Errors.Add(ex.ToString())
End If
End Try
Me.OriginalCode = Input
End Sub
End Class
Closure REST api is redirecting to https, you may want to try to POST to "https://closure-compiler.appspot.com/compile" directly in order to avoid redirection.

Ms Access 2016 Hashtable cause Automation error

In our old system we were using ms access 2003
Now we move our system to ms access 2016 now we are getting Automation error
when we debug;
msSqlAccessRelations.Add "CurrentUserId", "CurrentUserId"
this line gives an error.
we defined hashtable like this
Dim msSqlAccessRelations As New Hashtable
also mscorlib reference already added.
this code perfectly works on ms access 2003
Dim db As Database
Set db = CurrentDb
Dim rs As ADODB.Recordset
Dim msQry(0) As String
Dim accessQry(0) As String
Dim msSqlAccessRelations As New Hashtable
msQry(0) = "Select * From [IFSDB].[dbo].[Notes] Where ReferNum = " & ReferNum & " AND ReferTypeId = " & ReferTypeId & " " & extraFilter & " Order by NoteID desc"
accessQry(0) = "Select CurrentUserId , CurrentUserPrinted from TblCurrentUser"
msSqlAccessRelations.Add "CurrentUserId", "CurrentUserId"
If GetMSSQLDown = False Then
Set GetNotes = GetDataToDifferentDb(msQry, accessQry, msSqlAccessRelations, "CurrentUserPrinted,Note,NoteID,CurrentUserId,ReferNum,ReferTypeId,AppearOnReport,AppearOnBOLReport,Date,ShowForPickers")
Else
Set GetNotes = rs
End If

VBA to read in tab delimited file

I have some code which reads in a tab delimited file where cell reference B2 matches the reference in the first column in the tab delimited file. This works fine where the text file is small. The below works on a sample file with aa bb and cc as the headers with dummy data.
Option Explicit
Sub TestImport()
Call ImportTextFile(Sheet1.Range("B1"), vbTab, Sheet2.Range("A4"))
End Sub
Public Sub ImportTextFile(strFileName As String, strSeparator As String, rngTgt As Range)
Dim lngTgtRow As Long
Dim lngTgtCol As Long
Dim varTemp As Variant
Dim strWholeLine As String
Dim intPos As Integer
Dim intNextPos As Integer
Dim intTgtColIndex As Integer
Dim wks As Worksheet
Set wks = rngTgt.Parent
intTgtColIndex = rngTgt.Column
lngTgtRow = rngTgt.Row
Open strFileName For Input Access Read As #1
While Not EOF(1)
Line Input #1, strWholeLine
varTemp = Split(strWholeLine, strSeparator)
If CStr(varTemp(0)) = CStr(Range("B2")) Then
wks.Cells(lngTgtRow, intTgtColIndex).Resize(, UBound(varTemp) + 1).Value = varTemp
lngTgtRow = lngTgtRow + 1
End If
Wend
Close #1
Set wks = Nothing
End Sub
I am trying to get the below bit of code to work using ADO as this will run much faster on a text file with a couple of million records however I am getting an error on the '.Open str' part of the code (no value given for one or more required parameters).
It looks like it is to do with how I am defining the string- could you review and see if there is something I am missing...?
Sub QueryTextFile()
t = Timer
Dim cnn As Object
Dim str As String
Set cnn = CreateObject("ADODB.Connection")
cnn.Provider = "Microsoft.Jet.OLEDB.4.0"
cnn.ConnectionString = "Data Source=C:\Users\Davids Laptop\Documents\Other Ad Hoc\Test Files\;Extended Properties=""text;HDR=Yes;FMT=Delimited;"""
cnn.Open
Dim rs As Object
Set rs = CreateObject("ADODB.Recordset")
str = "SELECT * FROM [test1.txt] WHERE [aa]=" & Chr(34) & Range("B2") & Chr(34)
With rs
.ActiveConnection = cnn
.Open str
Sheet1.Range("A4").CopyFromRecordset rs
.Close
End With
cnn.Close
MsgBox Timer - t
End Sub

Resources