How can I download multiple files using CefSharp.
I need to download multiple files from a page, I execute a javaScript to do this.
First, I prove in Chrome, and the beginning doesn't work, only download the first link. I fixed it changing the property Automatic Downloads to Allow all sites to download multiple files automatically on Chrome Content Settings-Chrome
With CefSharp, first, I couldn't download anything, with this code I fixed it.
Public Class DownloadHandler
Implements IDownloadHandler
Public Event OnBeforeDownloadFired As EventHandler(Of DownloadItem)
Public Event OnDownloadUpdatedFired As EventHandler(Of DownloadItem)
Public Sub OnBeforeDownload(browser As IBrowser, downloadItem As DownloadItem, callback As IBeforeDownloadCallback) Implements IDownloadHandler.OnBeforeDownload
RaiseEvent OnBeforeDownloadFired(Me, downloadItem)
If Not callback.IsDisposed Then
Using callback
callback.[Continue](downloadItem.SuggestedFileName, showDialog:=False)
End Using
End If
End Sub
Public Sub OnDownloadUpdated(browser As IBrowser, downloadItem As DownloadItem, callback As IDownloadItemCallback) Implements IDownloadHandler.OnDownloadUpdated
RaiseEvent OnDownloadUpdatedFired(Me, downloadItem)
End Sub
End Class
But my problem is it only download the first link, and I need to download multiple files. How can I make CefSharp download multiple files?
What do you mean 'download multiple files from a page?' Are you simply downloading files from a public web site? I can think of a couple ways to do this. If you want to loop through a bunch of links, and download all files, you can setup an inventory list in Excel, like you see in the image below.
Then, run the following Macro.
Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal _
szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Sub DownloadFilefromWeb()
Dim strSavePath As String
Dim URL As String, ext As String
Dim buf, ret As Long
URL = Worksheets("Sheet1").Range("A2").Value
buf = Split(URL, ".")
ext = buf(UBound(buf))
strSavePath = "C:\Users\rshuell\Desktop\Downloads\" & "DownloadedFile." & ext
ret = URLDownloadToFile(0, URL, strSavePath, 0, 0)
If ret = 0 Then
MsgBox "Download has been succeed!"
Else
MsgBox "Error"
End If
End Sub
Now, if you just want to download one single file, run the script below.
Sub DownloadFileWithVBA()
Dim myURL As String
'Right-click on the link named 'Sample Address File'
'Click 'Copy Link Location'
'Paste the link below
myURL = "http://databases.about.com/library/samples/address.xls"
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False
WinHttpReq.Send
myURL = WinHttpReq.ResponseBody
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.ResponseBody
oStream.SaveToFile ("C:\Users\Excel\Desktop\address.xls")
oStream.Close
End Sub
This is Excel & VBA, not VB.NET, but if it helps you achieve your objective, please mark it as an answer!
Related
how should i make this go open folder only if only folder it is not open? the folder should only open if it is not open. and put an if, and an else.
Private Shared Function FindWindow(ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
End Function
Dim folderpath As String
Dim foldername As String
'Process.Start(System.Environment.CurrentDirectory)
folderpath = My.Application.Info.DirectoryPath + ("\Check")
foldername = System.IO.Path.GetFileName(folderpath)
If FindWindow(vbNullString, foldername) = 0 Then
Process.Start("explorer.exe", folderpath)
End If
Windows has a function built in to do this. https://learn.microsoft.com/en-us/windows/win32/shell/ishelldispatch-windows and look at the windows property.
When Internet Explorer 4 Desktop Update was released there was no difference between local files and internet files. Therefore it lists Internet Explorer (but no other browser) and Windows Explorer windows.
The win in AllWindows is actually an Internet Explorer object - see https://learn.microsoft.com/en-us/previous-versions/windows/internet-explorer/ie-developer/platform-apis/aa752084(v=vs.85)
'ListOpenShellWindows.vb
Imports System.Runtime.InteropServices
Public Module MyApplication
Sub Main()
Dim ObjShell as Object
Dim AllWindows as Object
objShell = CreateObject("Shell.Application")
AllWindows = objShell.Windows
For Each win in AllWindows
Msgbox(win.LocationUrl & " - " & win.LocationName)
Next
End Sub
End Module
To compile copy both files into same folder and double click the batch file.
REM ListOpenShellWindows.bat
REM This file compiles ListOpenShellWindows.vb to ListOpenShellWindows.exe using the system VB.NET compiler
"C:\Windows\Microsoft.NET\Framework\v4.0.30319\vbc.exe" /target:winexe /out:"%~dp0\ListOpenShellWindows.exe" "%~dp0\ListOpenShellWindows.vb"
pause
Edit
If interacting with the Shell it is best to use the Shell functions. You use ObjShell.Open to open a folder. See https://learn.microsoft.com/en-us/windows/win32/shell/ishelldispatch-open.
If the goal is to not open multiple explorer instances for the same directory, then you can simply pass a new ProcessStartInfo object to the Process.Start(...) function. Assign the directory path to the ProcessStartInfo.FileName property and the "open" command to the ProcessStartInfo.Verb property. This way, an already open instance will be activated rather than opening a new one for the same dir.
' Some caller...
Dim dirInfo = New DirectoryInfo(Path.Combine(My.Application.Info.DirectoryPath, "Check"))
Dim psi As New ProcessStartInfo With {
.FileName = dirInfo.FullName,
.Verb = "open"
}
Process.Start(psi)
On the other hand, if you still need to find out whether a directory is already open in the explorer, then you could pinvoke the FindWindowByCaption function which returns a handle to a window if any.
Dim dirInfo = New DirectoryInfo(Path.Combine(My.Application.Info.DirectoryPath, "Check"))
Dim p = FindWindowByCaption(IntPtr.Zero, dirInfo.Name)
If p = IntPtr.Zero Then
Process.Start(dirInfo.FullName)
Else
Console.WriteLine("Already Open!")
End If
<DllImport("user32.dll", EntryPoint:="FindWindow", SetLastError:=True, CharSet:=CharSet.Auto)>
Private Shared Function FindWindowByCaption(zero As IntPtr, lpWindowName As String) As IntPtr
End Function
Of course, the target directory should exist in the first place. Just in case, see the DirectoryInfo.Exists property and the DirectoryInfo.Create method.
I need to open the specific folder for a file and I am doing it with:
file = Directory.GetFiles(filepath,Filename,
SearchOption.AllDirectories).FirstOrDefault()
Process.Start("explorer.exe", "/select," & file.ToString)
This code is immediately opening the folder which is already fully loaded, but it doesnt seem enabled, endeed I cant do any action in it. The form is not freezing.
Thanks
I'll give you an answer in two parts...
Firstly, if the GetFiles() call takes to long and freezes the form (which doesn't seem to be the current problem), you should do the following:
Use EnumerateFiles() instead because in this case, FirstOrDefault() will return immediately after finding a matching file, unlike GetFiles() which will get all the files first before calling FirstOrDefault().
Wrap the call to EnumerateFiles() in a Task.Run() to execute it on a worker thread in case the search takes a little too long:
' Or:
' Private Async Sub SomeEventHandler()
Private Async Function ParentMethod() As Task
Dim filePath As String = Await Task.Run(
Function()
Return Directory.EnumerateFiles(dirPath, FileName, SearchOption.AllDirectories).
FirstOrDefault()
End Function)
' TODO: Use `filePath` to open the folder and select the file.
End Function
Secondly, do not use Process.Start("explorer.exe", "/select") because a) it starts a new Explorer.exe process rather than opening the directory in the current one, b) it seems to be causing you some issues, and c) it has some limitations.
Instead, use the approach demonstrated in the answer linked in point (c) above. The code is in C# but it can be easily converted to VB. Here's the VB version of the code (with an additional overload).
Add the following class to your project:
Imports System.IO
Imports System.Runtime.InteropServices
Public Class NativeMethods
<DllImport("shell32.dll", SetLastError:=True)>
Private Shared Function SHOpenFolderAndSelectItems(
pidlFolder As IntPtr, cidl As UInteger,
<[In], MarshalAs(UnmanagedType.LPArray)> apidl As IntPtr(),
dwFlags As UInteger) As Integer
End Function
<DllImport("shell32.dll", SetLastError:=True)>
Private Shared Sub SHParseDisplayName(
<MarshalAs(UnmanagedType.LPWStr)> name As String,
bindingContext As IntPtr, <Out> ByRef pidl As IntPtr,
sfgaoIn As UInteger, <Out> ByRef psfgaoOut As UInteger)
End Sub
Public Shared Sub OpenFolderAndSelectFile(filePath As String)
Dim dirPath As String = Path.GetDirectoryName(filePath)
Dim fileName As String = Path.GetFileName(filePath)
OpenFolderAndSelectFile(dirPath, fileName)
End Sub
Public Shared Sub OpenFolderAndSelectFile(dirPath As String, fileName As String)
Dim nativeFolder As IntPtr
Dim psfgaoOut As UInteger
SHParseDisplayName(dirPath, IntPtr.Zero, nativeFolder, 0, psfgaoOut)
If nativeFolder = IntPtr.Zero Then
' Log error, can't find folder
Return
End If
Dim nativeFile As IntPtr
SHParseDisplayName(Path.Combine(dirPath, fileName),
IntPtr.Zero, nativeFile, 0, psfgaoOut)
Dim fileArray As IntPtr()
If nativeFile = IntPtr.Zero Then
' Open the folder without the file selected if we can't find the file
fileArray = New IntPtr(-1) {}
Else
fileArray = New IntPtr() {nativeFile}
End If
SHOpenFolderAndSelectItems(nativeFolder, CUInt(fileArray.Length), fileArray, 0)
Marshal.FreeCoTaskMem(nativeFolder)
If nativeFile <> IntPtr.Zero Then
Marshal.FreeCoTaskMem(nativeFile)
End If
End Sub
End Class
Then, you can easily call it like this:
NativeMethods.OpenFolderAndSelectFile(filePath)
Some additional notes:
You should choose meaningful variable names. filePath should refer to the path of a file. If you want to refer to a folder/directory path, use something like dirPath or folderPath instead.
You don't need to call .ToString() on a variable that's already of a String type.
I would change the variable name file to something else. Maybe foundFile. After all File is the name of a class in System.IO and vb.net is not case sensitive. Your code works fine for me with the variable name change. Also got rid of the .ToString. I used .EnumerateFiles as commented by #jmcilhinney in the question you deleted. I purposely chose a path with all sorts of strange characters and it still worked.
Private Sub OPCode()
Dim filepath = "C:\Users\xxxx\Documents\TextNotes\Dogs & Cats (Pets)"
Dim Filename = "Specialty Vets.txt"
Dim foundFile = Directory.EnumerateFiles(filepath, Filename,
IO.SearchOption.AllDirectories).FirstOrDefault()
Process.Start("explorer.exe", "/select," & foundFile)
End Sub
I'm trying to add multiple sounds on an application using a Public function... When I use the absolute path for my sounds everything works perfectly, but when I'm trying to load them from Resources I don't get any sound output.. Any ideas what's wrong?
Public Class Form1
Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Integer, ByVal hwndCallback As Integer) As Integer
Dim musicAlias As String = "myAudio"
'Dim musicPath As String = "C:\Users\Teo\Documents\Visual Studio 2015\Projects\test\test\Resources\sound.mp3"
'Dim musicPath As String = "Resources\sound.mp3"
'Dim musicPath As String = My.Resources.ResourceManager.GetObject("sound.mp3")
Dim musicPath2 As String = "C:\Users\Teo\Desktop\sound.mp3"
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
mciSendString("Open " & musicPath & " alias " & musicAlias, CStr(0), 0, 0)
mciSendString("play " & musicAlias, CStr(0), 0, 0)
End Sub
End Class
The last one works perfectly, I tried every one of the above... The three comments above are different ways I tried to make it work, but all failed...
You can load the file from resources and cache them locally and play them.
Open Resources.resx file under My Project. Then add your file for example YourFileName.mp3 to the resources by choosing Add Existing File... then when you want to play the file, use this code:
Dim file As String = System.IO.Path.Combine(Application.StartupPath, "YourFileName.mp3")
If (Not System.IO.File.Exists(file)) Then
System.IO.File.WriteAllBytes(file, My.Resources.YourFileName)
End If
'Now the file exists locally
'Play the file here
I know this has an answer marked correct, but once you have a sound file in your Resources, it's much easier this way:
My.Computer.Audio.Play(My.Resources.MyCoolSound, AudioPlayMode.Background)
No reason to use an API call.
I am wanting to retrieve all the files in some directories. Here is my original code:
Private Function Search(path As String, Recursive As Boolean) As Boolean
Dim dirInfo As New IO.DirectoryInfo(path)
Dim fileObject As FileSystemInfo
If Recursive = True Then
For Each fileObject In dirInfo.GetFileSystemInfos()
If fileObject.Attributes = FileAttributes.Directory Then
Search(fileObject.FullName, Recursive)
Else
lstFiles.Items.Add(fileObject.FullName)
End If
Next
Else
For Each fileObject In dirInfo.GetFileSystemInfos()
lstFiles.Items.Add(fileObject.FullName)
Next
End If
Return True
End Function
This code works well, yet it returns some directories and I am wanting to only return files.
I tried this code:
Private Sub Search(ByVal path As String, ByVal Recursive As Boolean)
if not Directory.Exists(path) then Exit Sub
Dim initDirInfo As New DirectoryInfo(path)
For Each oFileInfo In initDirInfo.GetFiles
lstfiles.items.add(oFileInfo.Name)
Next
If Recursive Then
For Each oDirInfo In initDirInfo.GetDirectories
Search(oDirInfo.FullName, True)
Next
End If
End Sub
However, i get the following error:
Access to the path 'C:\Users\Simon\AppData\Local\Application Data\' is denied.
Can someone help me with my original code, or help me access these directories with my new code?
thanks
EDIT:
I have added this module to get it working:
Imports System.Security.Principal
Module VistaSecurity
'Declare API
Private Declare Ansi Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As String) As Integer
Private Const BCM_FIRST As Int32 = &H1600
Private Const BCM_SETSHIELD As Int32 = (BCM_FIRST + &HC)
Public Function IsVistaOrHigher() As Boolean
Return Environment.OSVersion.Version.Major < 6
End Function
' Checks if the process is elevated
Public Function IsAdmin() As Boolean
Dim id As WindowsIdentity = WindowsIdentity.GetCurrent()
Dim p As WindowsPrincipal = New WindowsPrincipal(id)
Return p.IsInRole(WindowsBuiltInRole.Administrator)
End Function
' Add a shield icon to a button
Public Sub AddShieldToButton(ByRef b As Button)
b.FlatStyle = FlatStyle.System
SendMessage(b.Handle, BCM_SETSHIELD, 0, &HFFFFFFFF)
End Sub
' Restart the current process with administrator credentials
Public Sub RestartElevated()
Dim startInfo As ProcessStartInfo = New ProcessStartInfo()
startInfo.UseShellExecute = True
startInfo.WorkingDirectory = Environment.CurrentDirectory
startInfo.FileName = Application.ExecutablePath
startInfo.Verb = "runas"
Try
Dim p As Process = Process.Start(startInfo)
Catch ex As Exception
Return 'If cancelled, do nothing
End Try
Application.Exit()
End Sub
End Module
The access denied errors are occurring at Windows Libraries I think. I don't think there is any way to list the file in these libraries as they aren't actually folders.
I've already tried using many different techniques with this... One that works pretty nicely but still ties up code when running is using the api call:
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
and
IF URLDownloadToFile(0, "URL", "FilePath", 0, 0) Then
End If
I've also used (Successfully) code to write vbscript from within Excel and then running with it wscript and waiting for the callback. But again this isn't totally async and still ties up some of the code.
I'd like to have the files download in an event driven class and the VBA code can do other things in a big loop with "DoEvents". When one file is done it can trigger a flag and the code can process that file while waiting for another.
This is pulling excel files off of an Intranet site. If that helps.
Since I'm sure someone will ask, I can't use anything but VBA. This is going to be used at the workplace and 90% of the computers are shared. I highly doubt they'll spring for the business expense of getting me Visual Studio either. So I have to work with what I have.
Any help would be greatly appreciated.
You can do this using xmlhttp in asynchronous mode and a class to handle its events:
http://www.dailydoseofexcel.com/archives/2006/10/09/async-xmlhttp-calls/
The code there is addressing responseText, but you can adjust that to use .responseBody. Here's a (synchronous) example:
Sub FetchFile(sURL As String, sPath)
Dim oXHTTP As Object
Dim oStream As Object
Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
Set oStream = CreateObject("ADODB.Stream")
Application.StatusBar = "Fetching " & sURL & " as " & sPath
oXHTTP.Open "GET", sURL, False
oXHTTP.send
With oStream
.Type = 1 'adTypeBinary
.Open
.Write oXHTTP.responseBody
.SaveToFile sPath, 2 'adSaveCreateOverWrite
.Close
End With
Set oXHTTP = Nothing
Set oStream = Nothing
Application.StatusBar = False
End Sub
Not sure if this is standard procedure or not but I didn't want to overly clutter my question so people reading it could understand it better.
But I've found an alternate solution to my question that is more in-line with what I was originally requesting. Thanks again to Tim as he set me on the right track, and his use of ADODB.Stream is a vital part of my solution.
This uses the Microsoft WinHTTP Services 5.1 .DLL that should be included with windows in one version or another, if not it is easily downloaded.
I use the following code in a class called "HTTPRequest"
Option Explicit
Private WithEvents HTTP As WinHttpRequest
Private ADStream As ADODB.Stream
Private HTTPRequest As Boolean
Private I As Double
Private SaveP As String
Sub Main(ByVal URL As String)
HTTP.Open "GET", URL, True
HTTP.send
End Sub
Private Sub Class_Initialize()
Set HTTP = New WinHttpRequest
Set ADStream = New ADODB.Stream
End Sub
Private Sub HTTP_OnError(ByVal ErrorNumber As Long, ByVal ErrorDescription As String)
Debug.Print ErrorNumber
Debug.Print ErrorDescription
End Sub
Private Sub HTTP_OnResponseFinished()
'Tim's code Starts'
With ADStream
.Type = 1
.Open
.Write HTTP.responseBody
.SaveToFile SaveP, 2
.Close
End With
'Tim's code Ends'
HTTPRequest = True
End Sub
Private Sub HTTP_OnResponseStart(ByVal Status As Long, ByVal ContentType As String)
End Sub
Private Sub Class_Terminate()
Set HTTP = Nothing
Set ADStream = Nothing
End Sub
Property Get RequestDone() As Boolean
RequestDone = HTTPRequest
End Property
Property Let SavePath(ByVal SavePath As String)
SaveP = SavePath
End Property
The main difference between this and what Tim was describing is that WINHTTPRequest has it's own built in events which I can wrap up in one neat little class and reuse wherever. It's to me, a more elegant solution than calling the XMLHttp and then passing it to a class to wait for it.
Having it wrapped up in a class like this means I can do something along the lines of this..
Dim HTTP(10) As HTTPRequest
Dim URL(2, 10) As String
Dim I As Integer, J As Integer, Z As Integer, X As Integer
While Not J > I
For X = 1 To I
If Not TypeName(HTTP(X)) = "HTTPRequest" And Not URL(2, X) = Empty Then
Set HTTP(X) = New HTTPRequest
HTTP(X).SavePath = URL(2, X)
HTTP(X).Main (URL(1, X))
Z = Z + 1
ElseIf TypeName(HTTP(X)) = "HTTPRequest" Then
If Not HTTP(X).RequestDone Then
Exit For
Else
J = J + 1
Set HTTP(X) = Nothing
End If
End If
Next
DoEvents
Wend
Where I just iterate through URL() with URL(1,N) is the URL and URL(2,N) is the save location.
I admit that can probably be streamlined a bit but it gets the job done for me for now. Just tossing my solution out there for anyone interested.
#TheFuzzyGiggler: +1: Thanks for sharing back.
I know its an old post but perhaps I make someone happy with this addidion to TheFuzzyGigglers code (works only in classes):
I added two properties:
Private pCallBack as string
Private pCallingObject as object
Property Let Callback(ByVal CB_Function As String)
pCallBack = CB_Function
End Property
Property Let CallingObject(set_me As Object)
Set pCallbackObj = set_me
End Property
'and at the end of HTTP_OnResponseFinished()
CallByName pCallbackObj, pCallback, VbMethod
In my class I have
Private EntryCollection As New Collection
Private Sub Download(ByVal fromURL As String, ByVal toPath As String)
Dim HTTPx As HTTPRequest
Dim i As Integer
Set HTTPx = New HTTPRequest
HTTPx.SavePath = toPath
HTTPx.Callback = "HTTPCallBack"
HTTPx.CallingObject = Me
HTTPx.Main fromURL
pHTTPRequestCollection.Add HTTPx
End Sub
Sub HTTPCallBack()
Dim HTTPx As HTTPRequest
Dim i As Integer
For i = pHTTPRequestCollection.Count To 1 Step -1
If pHTTPRequestCollection.Item(i).RequestDone Then pHTTPRequestCollection.Remove i
Next
End Sub
You could access the HTTP object from the HTTPCallBack and do many beautiful things here; the main thing is: its perfectly asynchronous now and easy to use. Hope this helps someone as the OP helped me.
I developed this further into a class: check my blog