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
Related
ive seen other questions about this issue but none of them resolved it for me so here i go. I'm trying to send a keypress to a game to save the progress(its a 64bit game). what i've coded so far is :
Dim p() As Process
Dim GameID As Integer = 0
Dim p As Process() = Process.GetProcessesByName("Gamename")
If p.Length > 0 Then
For i As Integer = 0 To p.Length - 1
GameID = (p(i).Id)
Next
End If
AutoSaveTimer.Enabled = True
Dim Test As Integer = 0
GetAsyncKeyState(Test)
AppActivate("GameName")
My.Computer.Keyboard.SendKeys(";", True)
now i've tried Sendkeys.Send(";") but without luck, and the game runs under "GameName" but then the keypress needs to be sent in a window under the game :
Blacked out is the game and under the first window is where the keypress needs to be sent
thanks in advance for the help
I use InputSimulator in my app and it works great.
https://inputsimulator.codeplex.com/
It could be this easy to send keys. The active window will see that as if the user actually used those keys.
var sim = new InputSimulator();
sim.Keyboard.KeyPress(VirtualKeyCode.SPACE);
sim = null;
Here's a screen shot of the methods you can use for keyboard.
You can simulate keyboard input to a program like this:
<DllImport("user32.dll")> _
Public Shared Function SetForegroundWindow(hWnd As IntPtr) As Boolean
End Function
Public Sub Send()
Dim p As System.Diagnostics.Process() = System.Diagnostics.Process.GetProcessesByName("notepad")
'search for process notepad
If p.Length > 0 Then
'check if window was found
'bring notepad to foreground
SetForegroundWindow(p(0).MainWindowHandle)
End If
SendKeys.SendWait("a")
'send key "a" to notepad
End Sub
I am attempting to write a simple plugin for MusicBee (a music player app)
I am building on the example provided with the API.
Some background: this plugin is launched when the main .exe (musicbee) launches.
The Configure() function is run when the user goes to the plugin config screen in the options menu.
The
Dim configPanel As Panel = DirectCast(Panel.FromHandle(panelHandle), Panel)
Dim btn1 As New Button
and configPanel.Controls.AddRange(New Control() {btn1})
lines add a button to this config screen which I am using to enable/disable the only function of my plugin.
To provide user feedback I need to change the text of this button (i.e. "ON", "OFF")
The problem: If I declare the button inside the Configure() function I cannot access it from the other click event function. (btn1_Click())
If I declare it globally then when the user closes the config screen (not the whole plugin) btn1 gets disposed (actually configPanel gets disposed by the musicbee API I think). When the user tries to open the config screen again I get an exception because it tries to access btn1 when it was already disposed and is not re-declared.
MusicBee v3.0.6132.15853 (Win6.1), 7 Mar 2017 20:53:
System.Reflection.TargetInvocationException: Exception has been thrown by the target of an invocation. ---> System.ObjectDisposedException: Cannot access a disposed object.
Object name: 'Button'.
There must be a way to declare/setup btn1 so that this works but I don't know how.
Thanks, Timothy.
Imports System.Runtime.InteropServices
Imports System.Drawing
Imports System.Windows.Forms
Public Class Plugin
Private mbApiInterface As New MusicBeeApiInterface
Private about As New PluginInfo
Dim playMode As Boolean
Public Function Initialise(ByVal apiInterfacePtr As IntPtr) As PluginInfo
CopyMemory(mbApiInterface, apiInterfacePtr, 4)
If mbApiInterface.MusicBeeVersion = MusicBeeVersion.v2_0 Then
' MusicBee version 2.0 - Api methods > revision 25 are not available
CopyMemory(mbApiInterface, apiInterfacePtr, 456)
ElseIf mbApiInterface.MusicBeeVersion = MusicBeeVersion.v2_1 Then
CopyMemory(mbApiInterface, apiInterfacePtr, 516)
ElseIf mbApiInterface.MusicBeeVersion = MusicBeeVersion.v2_2 Then
CopyMemory(mbApiInterface, apiInterfacePtr, 584)
ElseIf mbApiInterface.MusicBeeVersion = MusicBeeVersion.v2_3 Then
CopyMemory(mbApiInterface, apiInterfacePtr, 596)
ElseIf mbApiInterface.MusicBeeVersion = MusicBeeVersion.v2_4 Then
CopyMemory(mbApiInterface, apiInterfacePtr, 604)
ElseIf mbApiInterface.MusicBeeVersion = MusicBeeVersion.v2_5 Then
CopyMemory(mbApiInterface, apiInterfacePtr, 648)
Else
CopyMemory(mbApiInterface, apiInterfacePtr, Marshal.SizeOf(mbApiInterface))
End If
about.PluginInfoVersion = PluginInfoVersion
about.Name = "Single Play Mode"
about.Description = "Adds a single play mode i.e play one track and stop."
about.Author = "Timothy Hobbs"
about.TargetApplication = "" ' current only applies to artwork, lyrics or instant messenger name that appears in the provider drop down selector or target Instant Messenger
about.Type = PluginType.General
about.VersionMajor = 1 ' your plugin version
about.VersionMinor = 0
about.Revision = 1
about.MinInterfaceVersion = MinInterfaceVersion
about.MinApiRevision = MinApiRevision
about.ReceiveNotifications = ReceiveNotificationFlags.PlayerEvents
about.ConfigurationPanelHeight = 40 ' height in pixels that musicbee should reserve in a panel for config settings. When set, a handle to an empty panel will be passed to the Configure function
Return about
End Function
Public Function Configure(ByVal panelHandle As IntPtr) As Boolean
' save any persistent settings in a sub-folder of this path
Dim dataPath As String = mbApiInterface.Setting_GetPersistentStoragePath()
' panelHandle will only be set if you set about.ConfigurationPanelHeight to a non-zero value
' keep in mind the panel width is scaled according to the font the user has selected
' if about.ConfigurationPanelHeight is set to 0, you can display your own popup window
If panelHandle <> IntPtr.Zero Then
Dim configPanel As Panel = DirectCast(Panel.FromHandle(panelHandle), Panel)
Dim btn1 As New Button
btn1.Location = New Point(0, 0)
btn1.Size = New Size(150, 25)
btn1.Text = "Single Play Mode: OFF"
playMode = False
configPanel.Controls.AddRange(New Control() {btn1})
AddHandler btn1.Click, AddressOf btn1_Click
End If
Return True
End Function
Public Sub btn1_Click(sender As Object, e As EventArgs) 'toggle play mode
If playMode Then 'We are in single play mode so turn it OFF
playMode = False
btn1.Text = "Single Play Mode: OFF" '*******ERROR HERE*******
If mbApiInterface.Player_GetStopAfterCurrentEnabled() Then
mbApiInterface.Player_StopAfterCurrent() 'disable it
End If
'also disable stopaftercurrent once more for the current song.
Else 'We are in normal play mode so turn it ON
playMode = True
btn1.Text = "Single Play Mode: ON" '*******AND HERE*******
'enable it once
If Not mbApiInterface.Player_GetStopAfterCurrentEnabled() Then
mbApiInterface.Player_StopAfterCurrent() 'enable it
End If
End If
End Sub
' called by MusicBee when the user clicks Apply or Save in the MusicBee Preferences screen.
' its up to you to figure out whether anything has changed and needs updating
Public Sub SaveSettings()
' save any persistent settings in a sub-folder of this path
Dim dataPath As String = mbApiInterface.Setting_GetPersistentStoragePath()
End Sub
' MusicBee is closing the plugin (plugin is being disabled by user or MusicBee is shutting down)
Public Sub Close(ByVal reason As PluginCloseReason)
End Sub
' uninstall this plugin - clean up any persisted files
Public Sub Uninstall()
End Sub
' receive event notifications from MusicBee
' you need to set about.ReceiveNotificationFlags = PlayerEvents to receive all notifications, and not just the startup event
Public Sub ReceiveNotification(ByVal sourceFileUrl As String, ByVal type As NotificationType)
' perform some action depending on the notification type
Select Case type
Case NotificationType.PluginStartup
' perform startup initialisation
Select Case mbApiInterface.Player_GetPlayState()
Case PlayState.Playing, PlayState.Paused
' ...
End Select
Case NotificationType.TrackChanged
If playMode Then 'if single play mode is enabled
If Not mbApiInterface.Player_GetStopAfterCurrentEnabled() Then
mbApiInterface.Player_StopAfterCurrent() 'enable it
End If
End If
End Select
End Sub
' return an array of lyric or artwork provider names this plugin supports
' the providers will be iterated through one by one and passed to the RetrieveLyrics/ RetrieveArtwork function in order set by the user in the MusicBee Tags(2) preferences screen until a match is found
Public Function GetProviders() As String()
Return New String() {}
End Function
' return lyrics for the requested artist/title from the requested provider
' only required if PluginType = LyricsRetrieval
' return Nothing if no lyrics are found
Public Function RetrieveLyrics(ByVal sourceFileUrl As String, ByVal artist As String, ByVal trackTitle As String, ByVal album As String, ByVal synchronisedPreferred As Boolean, ByVal provider As String) As String
Return Nothing
End Function
' return Base64 string representation of the artwork binary data from the requested provider
' only required if PluginType = ArtworkRetrieval
' return Nothing if no artwork is found
Public Function RetrieveArtwork(ByVal sourceFileUrl As String, ByVal albumArtist As String, ByVal album As String, ByVal provider As String) As String
'Return Convert.ToBase64String(artworkBinaryData)
Return Nothing
End Function
End Class
I am novice of VB.Net trying to create a plugin for a program with a fairly lacking API. Essentially what I am trying to accomplish is press a button in the interface, which will create a new window. Once this window loads, I have a couple other buttons to press to eventually print out an HTML file it generates.
I attempted to use Windows UI Automation, but was unable to manipulate the first control (it appeared as a "pane" element for some reason, and had no supported control patterns)
I eventually was able to use PostMessage to send a MouseDown and MouseUp message to the control to activate it.
My question is: What is the best way for me to wait for this window to finish loading before continuing my code execution?
I tried using Thread.Sleep after I sent the click to my control, but my code seemed to trigger the sleep before it even started to load the window. I suspect there may be some kind of event-driven options, but I don't even know where I would begin with that.
Side note: I do have access to the program's Process ID if that helps.
EDIT:
To be more explicit about what I have done, here is some code for you to look at:
' These variables declared further up in my program, when plugin is loaded
Private aeDesktop As AutomationElement
Private aeRadan As AutomationElement
Private aeBlocksBtn As AutomationElement
Private Sub UITest1()
Dim rpid As Integer
Dim intret As Integer
' Note: mApp is declared further up in the code, when the plug in initializes
' It sets a reference to the application object (API command from the software)
rpid = mApp.ProcessID
aeDesktop = AutomationElement.RootElement
Dim propcon As New PropertyCondition(AutomationElement.ProcessIdProperty, rpid)
Dim propcon2 As New PropertyCondition(AutomationElement.NameProperty, "big_button_blocks.bmp")
aeRadan = aeDesktop.FindFirst(TreeScope.Children, propcon)
aeBlocksBtn = aeRadan.FindFirst(TreeScope.Descendants, propcon2)
' MAKELONG is a function that concatenates given x and y coordinates into an appropriate "lparam" value for PostMessage.
' Coordinates 20, 20 are chosen arbitrarily
Dim lParam As Long = MAKELONG(20, 20)
intret = PostMessage(CInt(aeBlocksBtn.GetCurrentPropertyValue(AutomationElement.NativeWindowHandleProperty)), &H201, &H1, lParam)
intret = PostMessage(CInt(aeBlocksBtn.GetCurrentPropertyValue(AutomationElement.NativeWindowHandleProperty)), &H202, &H0, lParam)
Dim bwinprop As New PropertyCondition(AutomationElement.NameProperty, "Radan Block Editor")
Dim aeblockwin As AutomationElement
Dim numwaits As Integer = 0
Do
numwaits += 1
Thread.Sleep(100)
aeblockwin = aeRadan.FindFirst(TreeScope.Children, bwinprop)
Loop While (numwaits < 50) AndAlso (aeblockwin Is Nothing)
If numwaits >= 50 Then
MessageBox.Show("ERROR: Block Editor Window Not found")
End If
I am fairly sure what is happening has to do with the code moving to the Do While loop before the PostMessage is processed by the program. I have tried using SendMessage to try to bypass this, but unfortunately that does not seem to work.
I feel like there is a pretty simple solution here, like maybe some kind of alternate wait or sleep command that I don't know about, so maybe someone could help guide me to it?
EDIT 2:
Screenshot of the inspect.exe output for this control.
Also, a screenshot of the user interface. This is from Radan, a CAM software I use for nesting and processing sheet metal parts to be laser cut. I put a red box around the control I would like to activate.
Basically, I want to download the contents of a particular URL (basically, just HTML codes in the form of a String) into my VB6 String variable. However, there are some conditions.
I know about the URLDownloadToFile Function - however, this requires that you save the downloaded file/HTML onto a file location on disk before you can read it into a String variable, this is not an option for me and I do not want to do this.
The other thing is, if I need to use an external library, it must already come with all versions of Windows from XP and onwards, I cannot use a control or library that I am required to ship, package and distribute even if it is free, this is not an option and I do not want to do this. So, I cannot use the MSINET.OCX (Internet Transfer) Control's .OpenURL() function (which simply returns contents into a String), as it does not come with Windows.
Is there a way to be able to do this with the Windows API, URLMON or something else that is pre-loaded into or comes with Windows, or a way to do it in VB6 (SP6) entirely?
If so, I would appreciate direction, because even after one hour of googling, the only examples I've found are references to URLDownloadToFile (which requires saving on disk before being ale to place into a String) and MsInet.OpenURL (which requires that I ship and distribute MSINET.OCX, which I cannot and don't want to do).
Surely there has got to be an elegant way to be able to do this? I can do it in VB.NET without an issue, but obviously don't have the luxury of the .NET framework in VB6 - any ideas?
Update:
I have found this: http://www.freevbcode.com/ShowCode.asp?ID=1252
however it says that the displayed function may not return the entire
page and links to a Microsoft bug report or kb article explaining
this. Also, I understand this is based off wininet.dll - and I'm
wondering which versions of Windows does WinInet.dll come packaged
with? Windows XP & beyond? Does it come with Windows 7 and/or Windows
8?
This is how I did it with VB6 a few years ago:
Private Function GetHTMLSource(ByVal sURL As String) As String
Dim xmlHttp As Object
Set xmlHttp = CreateObject("MSXML2.XmlHttp")
xmlHttp.Open "GET", sURL, False
xmlHttp.send
GetHTMLSource = xmlHttp.responseText
Set xmlHttp = Nothing
End Function
If you want to do this with pure VB, and no IE, then you can take advantage of a little-used features of the VB UserControl - async properties.
Create a new UserControl, and call it something like UrlDownloader. Set the InvisibleAtRuntime property to True. Add the following code to it:
Option Explicit
Private Const m_ksProp_Data As String = "Data"
Private m_bAsync As Boolean
Private m_sURL As String
Public Event AsyncReadProgress(ByRef the_abytData() As Byte)
Public Event AsyncReadComplete(ByRef the_abytData() As Byte)
Public Property Let Async(ByVal the_bValue As Boolean)
m_bAsync = the_bValue
End Property
Public Property Get Async() As Boolean
Async = m_bAsync
End Property
Public Property Let URL(ByVal the_sValue As String)
m_sURL = the_sValue
End Property
Public Property Get URL() As String
URL = m_sURL
End Property
Public Sub Download()
UserControl.AsyncRead m_sURL, vbAsyncTypeByteArray, m_ksProp_Data, IIf(m_bAsync, 0&, vbAsyncReadSynchronousDownload)
End Sub
Private Sub UserControl_AsyncReadComplete(AsyncProp As AsyncProperty)
If AsyncProp.PropertyName = m_ksProp_Data Then
RaiseEvent AsyncReadComplete(AsyncProp.Value)
End If
End Sub
Private Sub UserControl_AsyncReadProgress(AsyncProp As AsyncProperty)
If AsyncProp.PropertyName = m_ksProp_Data Then
Select Case AsyncProp.StatusCode
Case vbAsyncStatusCodeBeginDownloadData, vbAsyncStatusCodeDownloadingData, vbAsyncStatusCodeEndDownloadData
RaiseEvent AsyncReadProgress(AsyncProp.Value)
End Select
End If
End Sub
To use this control, stick it on a form and use the following code:
Option Explicit
Private Sub Command1_Click()
XDownload1.Async = False
XDownload1.URL = "http://www.google.co.uk"
XDownload1.Download
End Sub
Private Sub XDownload1_AsyncReadProgress(the_abytData() As Byte)
Debug.Print StrConv(the_abytData(), vbUnicode)
End Sub
Suffice to say, you can customise this to your hearts content. It can tell (using the AyncProp object) whether the file is cached, and other useful information. It even has a special mode in which you can download GIF, JPG and BMP files and return them as a StdPicture object!
One alternative is using Internet Explorer.
Dim ex As InternetExplorer
Dim hd As HTMLDocument
Dim s As String
Set ex = New InternetExplorer
With ex
.Navigate "http://donttrack.us/"
.Visible = 1
Set hd = .Document
s = hd.body.innerText ' assuming you just want the text
's = hd.body.innerHTML ' if you want the HTML
End With
EDIT: For the above early binding to work you need to set references to "Microsoft Internet Controls" and "Microsoft HTML Object Library" (Tools > References). You could also use late binding, but to be honest, I forget what the proper class names are; maybe someone smart will edit this answer :-)
How can I set focus on other application based on process name in VB2010?
What I can do now is set focus on other application based on windows name using FindWindow then use SetForegroundWindow. Below is what I currently have
Dim theHandle As IntPtr
theHandle = FindWindow(Nothing, "Gmail: Email from Google")
If theHandle <> IntPtr.Zero Then
SetForegroundWindow(theHandle)
The problem is that FindWindow need exact windows name to works and I don't always know the exact name. (Because my program open up different website that the user enter, so I have no control over they site they open). So is there anyway that I can set focus using the process name instead? (in this case firefox.exe) Any other suggestions are welcome.
Thanks
You can use System.Diagnostics.Process to look up a process by name and then find the window title:
For Each app As Process In Process.GetProcessesByName("firefox")
Dim theHandle As IntPtr = FindWindow(Nothing, app.MainWindowTitle)
If theHandle <> IntPtr.Zero Then
SetForegroundWindow(theHandle)
End If
Next
Use the static GetProcessesByName method and then the MainWindowTitle property. For this sample you would need Import System.Diagnostics to import the right namespace.
Private Sub ActivateApp(ByVal pID As Integer)
Dim p As Process = Process.GetProcessById(pID)
If p IsNot Nothing Then
SetForegroundWindow(p.MainWindowHandle)
End If
End Sub
Then use this:
ActivateApp(System.Diagnostics.Process.GetCurrentProcess.Id)
SendKeys.SendWait("~")