Trying to scrape thumbnail from vimeo video player ID, but not getting any response or error code.
I know there is API but this really works like 3month ago now my little app is broken, so what am I doing wrong?
Private Function RequestToVimeo(ByVal VimeoVideoID As String, ByVal views As Boolean, rndAgent As Boolean, referer As String, Proxy As WebProxy) As Boolean
ReDownloadJson:
Dim ResponseString As String = GetJson(VimeoVideoID, Proxy)
Try
Thistoken = Newtonsoft.Json.JsonConvert.DeserializeObject(Of VimeoJson)(ResponseString)
Catch ex1 As Exception
Try
Thistoken = Newtonsoft.Json.JsonConvert.DeserializeObject(Of OtherJson.VimeoJson)(ResponseString)
Catch ex As Exception
Proxy = Nothing
GoTo ReDownloadJson
End Try
End Try
If PreviewBox.ImageLocation Is Nothing OrElse PreviewBox.ImageLocation = String.Empty Then
PreviewBox.ImageLocation = Thistoken.video.thumbs.base + "_640.jpg"
End If
If response IsNot Nothing Then
response.Close()
End If
Return False
End Try
End Function
Ok I fixed somethign and this is correct I hope :)
Private Sub getBtn_Click(sender As Object, e As EventArgs) Handles getBtn.Click
Try
Dim vimeoUrl As String = "https://i.vimeocdn.com/video/"
Dim vimeoID As String = videoID.Text 'this comes here your vimeo video ID
If PreviewBox.ImageLocation Is Nothing OrElse PreviewBox.ImageLocation = String.Empty Then
PreviewBox.ImageLocation = "https://i.vimeocdn.com/video/" + vimeoID + "_640.jpg"
End If
Catch ex As Exception
End Try
End Sub
Related
complete code is as below I am fetching the value and sending it in mail but value hard coded ISMS: need to be in bold.
Public Function CCC_GetISMS_Details( ByVal dbPwOHelperPwO As ISingleDbObject) As String
Dim scriptErrorBase As String = "Script Error [CCC_GetISMS_Details]"
Dim fkPwo As IForeignKey = dbPwOHelperPwO.GetFK("UID_PersonWantsOrg")
Dim orderDetail2 As String = String.Empty
Dim DetailStrg As New StringBuilder
'there is a related pwo
If Not fkPwo.IsEmpty Then
Dim pwo As ISingleDbObject = fkPwo.Create()
'orderDetail2 = pwo.GetValue("OrderDetail2").String
'User Story 9672 to fetch the right ISMS Group from request and send it in approval mail
orderDetail2 = pwo.ObjectWalker.GetValue("FK(CCC_UID_CSMGroup).GroupName")
If Not String.IsNullOrEmpty(orderDetail2) Then
DetailStrg.AppendLine(String.Format("ISMS: {0}",orderDetail2))
End If
Else
Throw New Exception(scriptErrorBase & " no related person want org record!")
End If
Return DetailStrg.ToString()
End Function
DetailStrg.AppendLine($"<b>ISMS:</b> {orderDetail2}")
I am trying to create a function that grabs the status of an airway bill by using a tracking number.
I have managed to create a function that grabs the status correctly with the help of the stackoverflow community.
However, I am trying to add in the error handling where the tracking number may be incorrect.
With the current function, it correctly gets the result if the tracking number is valid.
But when an incorrect number is provided, the function returns a 0 value and keeps running in a loop in the background. When stopped from the VBA editor, excel crashes.
This is the code I have come up with so far. Any help to add this error handling would be appreciated.
Sample Correct Cargo Number: 92366691
Sample Incorrect Cargo Number: 59473805
Function FlightStat_AF(cargoNo As Variant) As String
Dim url As String, ie As Object, result As String
url = "https://www.afklcargo.com/mycargo/shipment/detail/057-" & cargoNo
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = False
.navigate url
Do Until .readyState = 4: DoEvents: Loop
End With
'wait a little for dynamic content to be loaded
Application.Wait (Now + TimeSerial(0, 0, 1))
'Get the status from the table
Do While result = ""
DoEvents
On Error Resume Next
result = Trim(ie.document.getElementsByClassName("fs-12 body-font-bold")(1).innerText)
On Error GoTo 0
Application.Wait (Now + TimeSerial(0, 0, 1))
Loop
ie.Quit: Set ie = Nothing
'Return value of the function
FlightStat_AF = result
End Function
I learned a lot today and I'am very happy about that. My code based on this answer, I learned all the new things from^^
Scraping specific data inside a table II (Answer by SIM)
You ask about how to avoid an error when you send a wrong ID. Here is the answer how you can deal with that error and the error when you send an ID in the wrong format of an ID.
This is the Sub() to test the function:
Sub test()
'A valid ID
MsgBox FlightStat_AF("92366691")
'A wrong ID
'The whole string is "The provided AWB(s) is either invalid, not found or you are not authorized for it."
'The function FlightStat_AF cuts the string by comma
'So it delivers "The provided AWB(s) is either invalid"
'I'am not clear with regex till now and used it like the macro this code is based on ;-)
MsgBox FlightStat_AF("59473805")
'Somthing else than a valid ID format
MsgBox FlightStat_AF("blub")
End Sub
This is the function() to get the answer you want:
Function FlightStat_AF(cargoNo As Variant) As String
Const url = "https://www.afklcargo.com/mycargo/api/shipment/detail/057-"
Dim elem As Object
Dim result As String
Dim askFor As String
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", url & cargoNo, False
.send
result = .responseText
If .Status = 200 Then
If InStr(1, result, "faultDescription") = 0 Then
askFor = """metaStatus"""
Else
askFor = """faultDescription"""
End If
With CreateObject("VBScript.RegExp")
.Global = True
.MultiLine = True
.Pattern = askFor & ":(.*?),"
Set elem = .Execute(result)
End With
If Not elem Is Nothing Then
result = Replace(elem(0).SubMatches(0), Chr(34), "")
Else
result = "No Value"
End If
Else
result = "No cargoID"
End If
End With
FlightStat_AF = result
End Function
a way to check that the url is valid is to use the function below :
Public Function URLexist(urlToCheck As String) As Boolean
'source : https://excel-malin.com
On Error GoTo Err
Dim oXHTTP As Object
Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
oXHTTP.Open "HEAD", urlToCheck , False
oXHTTP.send
URLexist = (oXHTTP.Status = 200)
Exit Function
Err:
URLexist = False
End Function
Okay i tried everything searched google, tried the example in docs Awesomium and it didn't work. I have a tabbed browser. How can i make for every webcontrol to handle showcreatedwebview event.
this for window you created
Private Sub Mainwindow_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
PictureBox2.Enabled = False
TextBox1.Text = Clipboard.GetText
WebControl1.Source = New Uri(TextBox1.Text)
End Sub
this for you browser
Private Sub WebControl1_ShowCreatedWebView(ByVal sender As Object, ByVal e As Awesomium.Core.ShowCreatedWebViewEventArgs) Handles WebControl1.ShowCreatedWebView
Clipboard.SetText(e.TargetURL.ToString)
Dim webControl As Awesomium.Windows.Forms.WebControl = TryCast(sender, Awesomium.Windows.Forms.WebControl)
Form1.Tabcontrol1.TabContainer.AddTab(New Mainwindow, True, Form1.Tabcontrol1.TabContainer.TabCount)
Dim webControl11 As WebControl = TryCast(sender, WebControl)
If webControl Is Nothing Then Return
If Not webControl.IsLive Then Return
Mainwindow.Close()
If e.IsPopup AndAlso (Not e.IsUserSpecsOnly) Then
' JSWindowOpenSpecs.InitialPosition indicates screen coordinates
ElseIf (e.IsWindowOpen OrElse e.IsPost) Then
Else
e.Cancel = True
Mainwindow.TextBox1.Text = e.TargetURL.ToString
' Show the window.
Form1.Tabcontrol1.TabContainer.AddTab(New Mainwindow, True, Form1.Tabcontrol1.TabContainer.TabCount)
End If
End Sub
End Class
I need to read the field value from a webpage using lotusscript. Essentially I am planning on writing an agent to go to a specific URL, get a value from the page, and then use this value for the url it sends the user to.
Can anyone give me a pointer?
A
Update December 2019: As of Notes 10 (released in 2018) there is a NotesHTTPRequest class that does exactly the same thing as my code.
I do this all the time, it is not hard at all (on Windows). I created a class to do this, so it is very easy to implement.
Here is how you call it:
Dim internet As New RemoteHTML()
Dim html As String
html = internet.GetHTTP("http://www.texasswede.com/mypage.html")
That's it, now you just pull whatever information you want out of the html string.
Here is the class:
Option Public
Option Declare
Class RemoteHTML
Private httpObject As Variant
Public httpStatus As Integer
Public Sub New()
Set httpObject = CreateObject("MSXML2.ServerXMLHTTP")
End Sub
Public Function GetHTTP(httpURL As String) As String
Dim retries As Integer
retries = 0
Do
If retries>1 Then
Sleep 1 ' After the two first calls, introduce a 1 second delay betwen each additional call
End If
retries = retries + 1
Call httpObject.open("GET", httpURL, False)
Call httpObject.send()
httpStatus = httpObject.Status
If retries >= 10 Then
httpStatus = 0 ' Timeout
End If
Loop Until httpStatus = 200 Or httpStatus > 500 Or httpStatus = 404 Or httpStatus = 0
If httpStatus = 200 Then
GetHTTP = Left$(httpObject.responseText,16000)
Else
GetHTTP = ""
End If
End Function
Public Function GetFile(httpURL As String, filename As String) As Boolean
Dim session As New NotesSession
Dim retries As Integer
Dim stream As NotesStream
Dim flag As Boolean
Dim responsebody As variant
Dim cnt As Long
Dim buffer As String
Dim tmp As Byte
Set stream = session.CreateStream
retries = 0
Do
If retries>1 Then
Sleep 1 ' After the two first calls, introduce a 1 second delay betwen each additional call
End If
retries = retries + 1
Call httpObject.open("GET", httpURL, False)
Call httpObject.send()
httpStatus = httpObject.Status
If retries >= 10 Then
httpStatus = 0 ' Timeout
End If
Loop Until httpStatus = 200 Or httpStatus > 500 Or httpStatus = 404 Or httpStatus = 0
If httpStatus = 200 Then
flag = stream.Open(filename, "binary")
If flag = False Then
MsgBox "Failed to create " & filename & "..."
GetFile = False
Exit function
End If
responsebody = httpObject.ResponseBody
ForAll r in responsebody
tmp = r
Call Stream.Write(Chr$(CInt(tmp)))
cnt = cnt + 1
End ForAll
MsgBox cnt
GetFile = True
Else
GetFile = False
End If
End Function
Private Function getString(ByVal StringBin As string)
Dim intCount As Long
getString =""
For intCount = 1 To LenB(StringBin)
getString = getString & Chr( Asc(MidB(StringBin, intCount, 1)) )
Next
End Function
End Class
If your code will be running on Windows, you can use either WinHTTP or XMLHTTP COM classes to read web pages. If the code will be running on any other platform, you will be better off using Java instead of LotusScript.
If You're trying to read form a NotesField, you could go for below approach. Tha Class was created to specifically handle export of RichText items into html-strings in order to find the otherwise kind-of-hidden embedded images (pasted graphics) that may exist in NotesRichText items.
The function ExportDoc() copies the html response text into a user defined field on the document at hand:
Public Class RTExporter
session As NotesSession
db As NotesDatabase
doc As NotesDocument
obj As Variant
url As String
Public Sub New()
Set Me.session = New NotesSession()
Set db = session.CurrentDatabase
Set obj = CreateObject("Microsoft.XMLHTTP")
End Sub
' Handles export from eventual NotesRichTextitems in the form of HTml
Public Function ExportDoc(hostUrl As String, doc As NotesDocument, rtFieldName As String, htmlFieldName As String)
Dim htmlString As String
url = hostUrl & Me.db.FilePath & "/0/" & doc.Universalid & "/" & rtFieldname & "?openfield&charset=utf-8
Set Me.doc = doc
htmlString = GetHtmlFromField(htmlFieldName)
Call doc.ReplaceItemValue(htmlFieldName, htmlString)
Call doc.Save(True, False)
End Function
' Get http response text and store it in <fieldname>
Private Function GetHtmlFromField(rtFieldName As String) As String
Dim html As String
On Error Goto ERH
obj.open "GET", Me.url, False, "", ""
obj.send("")
GetHtmlFromField = Trim$(obj.responseText)
Exit Function
ERH:
GetHtmlFromField = "Error " & Err & ": " & Error & " occured on line: " & Erl
End Function
End Class
I need to create a NPAPI-Browser plugin to control mplayer, I found one way to control mplayer is its slave mode [link], Is there any other better way?
not your question, I know. but VLC has similar levels of codec support, an integrated web interface extensible with lua scripting, and all the fluff you might not want (like the OSD) can be turned off. VLC is also controllable through telnet, and the lua libraries are easily extensible to allow network interfacing or whatever else you might want. I wrote a plugin to allow serial line control.
Found that mplayer slave mode is the only way, ftp://ftp2.mplayerhq.hu/MPlayer/DOCS/tech/slave.txt
I am developing android phone remote control + VB.NET TCP server - mplayer. I am using mplayer in slave mode. I send command from android app to VB.NET TCP server. Then the command will send to mplayer.
I will show some code that control and send the mplayer desired commands, but the server part is not finished yet. The coding is no finished yet but I hope it is useful for you.
Imports System.ComponentModel
Imports System.IO
Imports System.Data.OleDb
Public Class Form1
Private bw As BackgroundWorker = New BackgroundWorker
Dim i As Integer = 0
Dim dbFile As String = Application.StartupPath & "\Data\Songs.accdb"
Public connstring As String = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & dbFile & "; persist security info=false"
Public conn As New OleDbConnection(connstring)
Dim sw As Stopwatch
Dim ps As Process = Nothing
Dim jpgPs As Process = Nothing
Dim args As String = Nothing
Private Sub bw_DoWork(ByVal sender As Object, ByVal e As DoWorkEventArgs)
Dim worker As BackgroundWorker = CType(sender, BackgroundWorker)
If bw.CancellationPending = True Then
e.Cancel = True
Exit Sub
Else
' Perform a time consuming operation and report progress.
'System.Threading.Thread.Sleep(500)
bw.ReportProgress(i * 10)
Dim dir_info As New DirectoryInfo(TextBox1.Text)
ListFiels("SongList", TextBox2.Text, dir_info)
End If
End Sub
Private Sub bw_RunWorkerCompleted(ByVal sender As Object, ByVal e As RunWorkerCompletedEventArgs)
If e.Cancelled = True Then
Me.tbProgress.Text = "Canceled!"
ElseIf e.Error IsNot Nothing Then
Me.tbProgress.Text = "Error: " & e.Error.Message
Else
Me.tbProgress.Text = "Done!"
End If
End Sub
Private Sub bw_ProgressChanged(ByVal sender As Object, ByVal e As ProgressChangedEventArgs)
Me.tbProgress.Text = e.ProgressPercentage.ToString() & "%"
End Sub
Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
Try
ps.Kill()
Catch
Debug.Write("already closed")
End Try
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Windows.Forms.Control.CheckForIllegalCrossThreadCalls = False 'To avoid error from backgroundworker
bw.WorkerReportsProgress = True
bw.WorkerSupportsCancellation = True
AddHandler bw.DoWork, AddressOf bw_DoWork
AddHandler bw.ProgressChanged, AddressOf bw_ProgressChanged
AddHandler bw.RunWorkerCompleted, AddressOf bw_RunWorkerCompleted
funPlayMusic()
End Sub
Private Sub buttonStart_Click(sender As Object, e As EventArgs) Handles buttonStart.Click
If Not bw.IsBusy = True Then
bw.RunWorkerAsync()
End If
End Sub
Private Sub buttonCancel_Click(sender As Object, e As EventArgs) Handles buttonCancel.Click
If bw.WorkerSupportsCancellation = True Then
bw.CancelAsync()
End If
End Sub
Private Sub btnSearch_Click(sender As Object, e As EventArgs) Handles btnSearch.Click
If Not bw.IsBusy = True Then
sw = Stopwatch.StartNew()
bw.RunWorkerAsync()
sw.Stop()
Label1.Text = ": " + sw.Elapsed.TotalMilliseconds.ToString() + " ms"
End If
End Sub
Private Sub ListFiels(ByVal tblName As String, ByVal pattern As String, ByVal dir_info As DirectoryInfo)
i = 0
Dim fs_infos() As FileInfo = Nothing
Try
fs_infos = dir_info.GetFiles(pattern)
Catch ex As Exception
MessageBox.Show(ex.ToString())
End Try
For Each fs_info As FileInfo In fs_infos
i += 1
Label1.Text = i
insertData(tblName, fs_info.FullName)
lstResults.Items.Add(i.ToString() + ":" + fs_info.FullName.ToString())
If i = 1 Then
Playsong(fs_info.FullName.ToString())
Else
i = 0
lstResults.Items.Clear()
End If
Next fs_info
sw.Stop()
Label1.Text = ": " + sw.Elapsed.TotalMilliseconds.ToString() + " ms"
fs_infos = Nothing
Dim subdirs() As DirectoryInfo = dir_info.GetDirectories()
For Each subdir As DirectoryInfo In subdirs
ListFiels(tblName, pattern, subdir)
Next
End Sub
Private Sub insertData(ByVal tableName As String, ByVal foundfile As String)
Try
If conn.State = ConnectionState.Open Then conn.Close()
conn.Open()
Dim SqlQuery As String = "INSERT INTO " & tableName & " (SngPath) VALUES (#sng)"
Dim SqlCommand As New OleDbCommand
With SqlCommand
.CommandType = CommandType.Text
.CommandText = SqlQuery
.Connection = conn
.Parameters.AddWithValue("#sng", foundfile)
.ExecuteNonQuery()
End With
conn.Close()
Catch ex As Exception
conn.Close()
MsgBox(ex.Message)
End Try
End Sub
Private Sub btnClearList_Click(sender As Object, e As EventArgs) Handles btnClearList.Click
lstResults.Items.Clear()
End Sub
Private Sub funPlayMusic()
ps = New Process()
ps.StartInfo.FileName = "D:\Music\mplayer.exe "
ps.StartInfo.UseShellExecute = False
ps.StartInfo.RedirectStandardInput = True
jpgPs = New Process()
jpgPs.StartInfo.FileName = "D:\Music\playjpg.bat"
jpgPs.StartInfo.UseShellExecute = False
jpgPs.StartInfo.RedirectStandardInput = True
'ps.StartInfo.CreateNoWindow = True
args = "-fs -noquiet -identify -slave " '
args += "-nomouseinput -sub-fuzziness 1 "
args += " -vo direct3d, -ao dsound "
' -wid will tell MPlayer to show output inisde our panel
' args += " -vo direct3d, -ao dsound -wid ";
' int id = (int)panel1.Handle;
' args += id;
End Sub
Public Function SendCommand(ByVal cmd As String) As Boolean
Try
If ps IsNot Nothing AndAlso ps.HasExited = False Then
ps.StandardInput.Write(cmd + vbLf)
'MessageBox.Show(ps.StandardOutput.ReadToEndAsync.ToString())
Return True
Else
Return False
End If
Catch ex As Exception
Return False
End Try
End Function
Public Sub Playsong(ByVal Songfilelocation As String)
Try
ps.Kill()
Catch
End Try
Try
ps.StartInfo.Arguments = args + " """ + Songfilelocation + """"
ps.Start()
SendCommand("set_property volume " + "80")
Catch e As Exception
MessageBox.Show(e.Message)
End Try
End Sub
Private Sub lstResults_SelectedIndexChanged(sender As Object, e As EventArgs) Handles lstResults.SelectedIndexChanged
Playsong(lstResults.SelectedItem.ToString())
End Sub
Private Sub btnPlayJPG_Click(sender As Object, e As EventArgs) Handles btnPlayJPG.Click
Try
' jpgPs.Kill()
Catch
End Try
Try
'ps.StartInfo.Arguments = "–fs –mf fps=5 mf://d:/music/g1/Image00020.jpg –loop 200" '-vo gl_nosw
'jpgPs.Start()
Shell("d:\Music\playjpg.bat")
' SendCommand("set_property volume " + "80")
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End Sub
Private Sub btnPlayPause_Click(sender As Object, e As EventArgs) Handles btnPlayPause.Click
SendCommand("pause")
End Sub
Private Sub btnMute_Click(sender As Object, e As EventArgs) Handles btnMute.Click
SendCommand("mute")
End Sub
Private Sub btnKaraoke_Click(sender As Object, e As EventArgs) Handles btnKaraoke.Click
'SendCommand("panscan 0-0 | 1-1")
SendCommand("af_add pan=2:1:1:0:0")
End Sub
Private Sub btnStereo_Click(sender As Object, e As EventArgs) Handles btnStereo.Click
SendCommand("af_add pan=2:0:0:1:1")
End Sub
Private Sub btnStop_Click(sender As Object, e As EventArgs) Handles btnStop.Click
Playsong("d:\music\iot.mp4")
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
'SendCommand("loadfile d:\music\iot.mp4")
'SendCommand("pt_step 1")
End Sub
End Class