i want achieve when shortcut link runs ... the form closes automatically, btw im new to vb coding so any help will be much appreciated, here's my code so far
Private Sub Form_Load()
Set ss = CreateObject("WScript.Shell")
ss.Run Chr(34) & ss.specialfolders("Desktop") & "\app\SOMEGAME.lnk" & Chr(34)
End Sub
Assuming you're using VB6 (which is what your code looks like) you can close your form by calling
Unload Me
at the end of the Form_Load event handler.
However, you don't need to use a form to launch a shortcut - you can add a module to your project (right-click your project, select Add -> Module) and then just call the ShellExecute() function to launch your shortcut like so:
'Declare the ShellExecute() API function
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL As Long = 1
'Entry point of your program
Public Sub Main()
Dim sPath As String
sPath = "C:\app\SOMEGAME.lnk"
ShellExecute 0, vbNullString, sPath, vbNullString, "C:\", SW_SHOWNORMAL
End Sub
To make this work, set the Startup Object under Project Properties to Sub Main.
Using this approach, you don't have a form - your program just runs from the command-line (or from its own shortcut). It's generally better not to create / show a form if your program doesn't need it since forms use extra resources.
With that said, you should try using VB.Net or C# to write programs for Windows - VB6 is old technology without support and it can't handle a number of new technologies. If you don't already know VB6 there's little point in learning it now - your time could be put to much better use by learning VB.Net / C#.
Related
I'm attempting to create a VB6 executable (not sure of the proper syntax) that will toggle the X-Mouse option in Tweak UI under Windows 98SE. Ideally, I would like to have two scripts - one that turns it off (regardless of its state) and one that turns it on (again, regardless of its state).
I have been able to open the TweakUI control panel with the code below.
Private Sub Form_Load()
Call Shell("rundll32.exe shell32.dll,Control_RunDLL tweakui.cpl", vbNormalFocus)
End Sub
If possible, I would like it to do it without opening the TweakUI control panel.
As far as I can tell, changing the registry setting doesn't work as I would have to reboot the computer for that to take effect.
I have Registry Monitor 7.04 running. It captures the following:
Path: C:\WINDOWS\RUNDLL32.EXE
Command Line: "C:\WINDOWS\RUNDLL32.EXE" "C:\WINDOWS\SYSTEM\TWEAKUI.CPL", Tweak UI
Other: hKey: 0xC2A066F0
Honestly, I'm not sure how to move forward.
Not sure the best way to show progress on this, I'll just edit.
This code is very close.
Private Declare Function SystemParametersInfo Lib "user32" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _
ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Const SPI_SETACTIVEWINDOWTRACKING = 4097
'Click on this button to Activate XMouse
Private Sub Command1_Click()
SystemParametersInfo SPI_SETACTIVEWINDOWTRACKING, 0, True, 0
End Sub
'Click on this button to Deactivate XMouse
Private Sub Command2_Click()
SystemParametersInfo SPI_SETACTIVEWINDOWTRACKING, 0, False, 0
End Sub
Button 1 works correctly and Activates XMouse. But button two does not deactivate it.
SPI_SETACTIVEWINDOWTRACKING is the parameter that does this.
systemparametersinfo is the function call that gets or sets settings like this. See https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-systemparametersinfoa
There is sample code using systemparametersinfo that changes the wallpaper. https://winsourcecode.blogspot.com/2019/06/changewallpaper.html
Thank you to all of the input. I was able to solve this problem.
Private Declare Function SystemParametersInfo Lib "user32" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _
ByVal lpvParam As Boolean, ByVal fuWinIni As Long) As Long
Const SPI_SETACTIVEWINDOWTRACKING = 4097
Private Sub Command1_Click()
retVal = SystemParametersInfo(SPI_SETACTIVEWINDOWTRACKING, 0, True, 0)
End Sub
Private Sub Command2_Click()
retVal = SystemParametersInfo(SPI_SETACTIVEWINDOWTRACKING, 0, False, 0)
End Sub
In addition to the help here, I stumbled upon a few gems that gave me what I needed.
Control the mouse speed under Windows 98 / 2000
and
Controling Active Window Tracking
A couple things of note. I had to include this or else nothing happened:
Const SPI_SETACTIVEWINDOWTRACKING = 4097
Also, the 3rd parameter was
ByRef lpvParam As Boolean
Instead of
ByVal lpvParam As Boolean
I was passing a pointer to a pointer instead of a pointer to a value
I am trying to 'shell osk.exe' from within my VB-6 application on a Windows 10-32 or Windows 10-64 bit machine.
In the past we have simply used :
Private Sub Command1_Click()
Dim strTemp As String
Dim fso1 As New FileSystemObject
strTemp = fso1.GetSpecialFolder(SystemFolder) & "\osk.exe"
Dim lngReturn As Long
Let lngReturn = ShellExecute(Me.hwnd, "Open", strTemp, vbNullString, "C:\", SW_SHOWNORMAL)
lblReturn.Caption = CStr(lngReturn)
end sub
We have also used the simpler 'shell' command as well; neither work.
And in the past this worked fine. We could also open NotePad, msPaint and some other utilities from within our program. We use an industrial touchscreen PC and for convenience we placed some buttons on our 'settings' page to quickly access these type of helper programs. I do not want to wait on the program, our code has it's own 'touchscreen keyboard'. The users will only use the Windows OSK when they want to perform some work outside of our main application.
For Windows XP all of these programs would open fine. Now for Windows 10, only the OSK.exe program will not start. Looking at the return code, the error returned is a '2'- File Not Found (I assume). But looking in the c:\windows\system32 folder the file 'osk.exe' is there along with mspaint.exe and notepad.exe .
Is there some Windows setting that is hiding the real osk.exe from my program?
Thanks for any suggestions.
On my 64-bit Windows 10, your code behaves as you said. It looks like on 64-bit windows you have to disable WOW 64 redirection:
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL = 1
Private Declare Function Wow64EnableWow64FsRedirection Lib "kernel32.dll" (ByVal Enable As Boolean) As Boolean '// ****Add this****
Private Sub Command1_Click()
Dim fso1 As New FileSystemObject
Dim strTemp As String
strTemp = fso1.GetSpecialFolder(SystemFolder) & "\osk.exe"
Dim lngReturn As Long
Wow64EnableWow64FsRedirection False '// ****Add this****
Let lngReturn = ShellExecute(Me.hwnd, "open", strTemp, vbNullString, "C:\", SW_SHOWNORMAL)
Wow64EnableWow64FsRedirection True '// ****Add this****
lblReturn.Caption = CStr(lngReturn)
End Sub
This code works like a charm on Windows 10 64-bit. Also tested on Windows 10 32-bit...works there as well.
Until recently this VB6 code worked on my windows 7 64 bit machine
Shell "c:\My App\Helpers\Helper.exe"
The error message this now throws is
Invalid procedure call or argument (Error 5)
Since it stopped working I have found that moving the directory Helpers to the desktop fixes the issue.
So also does getting rid of the space in the path by renaming the
My App
folder as
MyApp
So also does inserting opening and closing quotes as in :
Shell """c:\My App\Helpers\Helper.exe"""
Meanwhile if the Helpers folder is on the desktop I can insert a space into the path by renaming the folder 'Hel pers' and it still works without the extra quotes.
So these all work:
Shell """c:\My App\Helpers\Helper.exe"""
Shell "c:\Users\UserA\Desktop\Helpers\Helper.exe"
Shell "c:\Users\UserA\Desktop\Hel pers\Helper.exe"
while the original no longer works though it did for years
Shell "c:\My App\Helpers\Helper.exe"
What could be the cause of this, and is there a way to restore the behaviour to the way it was before?
The Shell() function dated from much simpler times, it is ambiguous today. The command can also mean "start the c:\My program and pass it the App\Helpers.Helper.exe command line argument".
Why it triggers on your machine is impossible to tell from a distance, especially when you obfuscate the real name of the program. An infamous example is having a file or directory named Program in the root directory. Now c:\Program Files\Etcetera no longer works.
Using the double-quotes is the correct approach.
Have a look at the ShellExecute() API instead of Shell()
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpszOp As String, _
ByVal lpszFile As String, ByVal lpszParams As String, _
ByVal LpszDir As String, ByVal FsShowCmd As Long) _
As Long
For more info : example on microsoft.com
[EDIT]
A small example with only the parts that you (probably) need:
'1 Form with:
' 1 Command button: Name="Command1"
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, ByVal lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
Private Const SW_SHOWNORMAL = 1
Private Sub Command1_Click()
Dim strPath As String
Dim strExe As String
Dim lngReturn As Long
strExe = "TestProg.exe"
strPath = "C:\Program Files (x86)\ShellTest"
lngReturn = ShellExecute(0, "Open", strExe, vbNullString, strPath, SW_SHOWNORMAL)
Caption = CStr(Now) & " : " & CStr(lngReturn)
End Sub
When you click on the command button it will execute TextProg.exe from the ShellTest directory
In the caption of the form it will show the return value of the ShellExecute command
I have a webform displayed in a WebBrowser control in a Visual Basic application to allow users to upload files to my webserver. Unusually for this type of thing, I know in advance the folder they need to browse to (I want them to upload a file which the VB application has generated) and I would like the Browse dialog box to default to that folder but it seems to default to whichever folder was last used by any application for File / Open.
I've tried using ChDir in VB to set the current folder but that doesn't work.
Is there any way I can persuade the Browse box to default to my desired folder?
First of all, I ought to state that there is no reliable way of doing this. The reason why it is so hard is for security reasons. There is a defaultValue and value property for the INPUT TYPE=FILE element, but if programmers had access to this, this could be used to suck files from the client machine - definitely not a good idea.
In Internet Explorer, the browse file dialogue is actually implemented by a Windows Common Dialog component. However, you have no direct access to this component.
There is no reliable browser-independent way of doing this. And I certainly don't recommend you reverse-engineer the "Last Recently Used" file list for the Common Dialog control (see jac's link). Doing that is very dangerous, since it is an internal-algorithm likely to change. And worse, you are hacking global state to solve a local problem (see Old New Thing blog, ad nauseam).
A solution that doesn't violate global state, but still hacky is to take advantage of the fact we know what the text is on the file upload dialogue. After your document has loaded, you can use a Timer to wait for the dialogue to appear, and at that point, paste the correct directory into the dialogue.
In my sample, I have code where the web browser control sits, and the BrowserHack.bas module.
Form code:
Option Explicit
Private Sub cmdLoadPage_Click()
' Store the default path into the .Tag property.
tmrWaitForDialogue.Tag = "C:\Windows\System32"
' Load URL.
wbMain.Navigate "<URL>"
End Sub
Private Sub Form_Load()
tmrWaitForDialogue.Enabled = False
tmrWaitForDialogue.Interval = 100 ' 10th of a second delay.
End Sub
Private Sub tmrWaitForDialogue_Timer()
If BrowserHack.IsBrowserFileDialogueVisible Then
' We don't want the Timer to fire again.
tmrWaitForDialogue.Enabled = False
' Copy the directory onto the clipboard.
Clipboard.Clear
Clipboard.SetText tmrWaitForDialogue.Tag
' The focus will be on the file path text box in the Open dialogue.
' Use CTL-V to paste the text, and then followed by an Enter character to
' dismiss the dropdown, and another to Open the folder.
SendKeys "^V"
SendKeys "{ENTER}"
SendKeys "{ENTER}"
End If
End Sub
Private Sub wbMain_DocumentComplete(ByVal pDisp As Object, URL As Variant)
tmrWaitForDialogue.Enabled = True
End Sub
BrowserHack:
' Purpose: Code to look for the WebBrowser (Internet Explorer) dialogue which appears when a File Upload control is clicked.
' Notes: Internet Explorer version dependent.
Option Explicit
Private Declare Function EnumThreadWindows Lib "User32.dll" ( _
ByVal dwThreadId As Long, _
ByVal lpfn As Long, _
ByVal lParam As Long _
) As Long
Private Declare Function GetClassName Lib "User32.dll" Alias "GetClassNameW" (ByVal hWnd As Long, ByVal lpClassName As Long, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "User32.dll" Alias "GetWindowTextW" (ByVal hWnd As Long, ByVal lpString As Long, ByVal nMaxCount As Long) As Long
Private Declare Function IsWindowVisible Lib "User32.dll" (ByVal hWnd As Long) As Long
Private Const APITRUE As Long = 1 ' Win32 API TRUE value
Private Const APIFALSE As Long = 0 ' Win32 API FALSE value
' This dialogue class is pretty universal.
Private Const m_ksDialogueClass As String = "#32770"
Private Const m_knDialogueClassLen As Long = 6
' This text may well change every time the browser is updated.
Private Const m_ksDialogueText As String = "Choose File to Upload"
Private Const m_knDialogueTextLen As Long = 21
' Buffers to be used for these strings.
Private m_sClassNameBuffer As String
Private m_sWindowNameBuffer As String
' Callback from the EnumThreadWindow() function.
Private Function EnumThreadWndProc( _
ByVal hWnd As Long, _
ByVal lParam As Long _
) As Long
Dim nRet As Long
' Filter out hidden windows.
If IsWindowVisible(hWnd) = APITRUE Then
' Retrieve the class name of the window.
' Note that this function requires you to allocate a buffer *including* the terminating null character.
' Since VB strings *always* are null terminated, we can add one to the string length.
nRet = GetClassName(hWnd, StrPtr(m_sClassNameBuffer), (m_knDialogueClassLen + 1))
' If the classes match, then try for a match on the window's text.
If m_sClassNameBuffer = m_ksDialogueClass Then
' Ditto GetClassName().
nRet = GetWindowText(hWnd, StrPtr(m_sWindowNameBuffer), (m_knDialogueTextLen + 1))
If m_sWindowNameBuffer = m_ksDialogueText Then
' This return value says "stop the enumeration".
' In this case EnumThreadWindow() with also return APIFALSE.
EnumThreadWndProc = APIFALSE
Exit Function
End If
End If
End If
EnumThreadWndProc = APITRUE
End Function
' Purpose: If the browser window is detected
Public Function IsBrowserFileDialogueVisible() As Boolean
' If this is the first time this function has been called, the buffers will not be allocated.
' Do this now.
If LenB(m_sClassNameBuffer) = 0 Then
m_sClassNameBuffer = Space$(m_knDialogueClassLen)
m_sWindowNameBuffer = Space$(m_knDialogueTextLen)
End If
' Enumerate through all windows on this thread. VB apps are single-threaded, and all GUI elements are forced to be on this thread, so this is ok.
If EnumThreadWindows(App.ThreadID, AddressOf EnumThreadWndProc, 0&) = APIFALSE Then
IsBrowserFileDialogueVisible = True
Else
IsBrowserFileDialogueVisible = False
End If
End Function
I am declaring and calling a dll function using the following syntax in VB6:
'Declare the function
Private Declare Sub MYFUNC Lib "mylib.dll" ()
'Call the function
MYFUNC
Calling the function results in the error File not found: mylib.dll. This happens when the application is run from the vb6 IDE or from a compiled executable.
The dll is in the working directory, and I have checked that it is found using ProcMon.exe from sysinternals. There are no failed loads, but the Intel Fortran dlls are not loaded (the ProcMon trace seems to stop before then).
I have also tried running the application in WinDbg.exe, and weirdly, it works! There are no failures on this line. The ProcMon trace shows that the Intel Fortran dlls are loaded when the program is run in this way.
The dll is compiled with Fortran Composer XE 2011.
Can anyone offer any help?
When loading DLLs, "file not found" can often be misleading. It may mean that the DLL or a file it depends on is missing - but if that was the case you would have spotted the problem with Process Monitor.
Often, the "file not found" message actually means that the DLL was found, but an error occured when loading it or calling the method.
There are actually three steps to calling a procedure in a DLL:
Locate and load the DLL, running the DllMain method if present.
Locate the procedure in the DLL.
Call the procedure.
Errors can happen at any of these stages. VB6 does all this behind the scenes so you can't tell where the error is happening. However, you can take control of the process using Windows API functions. This should tell you where the error is happening. You can alse set breakpoints and use Process Monitor to examine your program's behaviour at each point which may give you more insights.
The code below shows how you can call a DLL procedure using the Windows API. To run it, put the code into a new module, and set the startup object for your project to "Sub Main".
Option Explicit
' Windows API method declarations
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function CallWindowProc Lib "user32" Alias _
"CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, _
ByVal Msg As Any, ByVal wParam As Any, ByVal lParam As Any) _
As Long
Private Declare Function FormatMessage Lib "kernel32" Alias _
"FormatMessageA" (ByVal dwFlags As Long, lpSource As Long, _
ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Any) _
As Long
Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Const MyFunc As String = "MYFUNC"
Const MyDll As String = "mylib.dll"
Sub Main()
' Locate and load the DLL. This will run the DllMain method, if present
Dim dllHandle As Long
dllHandle = LoadLibrary(MyDll)
If dllHandle = 0 Then
MsgBox "Error loading DLL" & vbCrLf & ErrorText(Err.LastDllError)
Exit Sub
End If
' Find the procedure you want to call
Dim procAddress As Long
procAddress = GetProcAddress(dllHandle, MyFunc)
If procAddress = 0 Then
MsgBox "Error getting procedure address" & vbCrLf & ErrorText(Err.LastDllError)
Exit Sub
End If
' Finally, call the procedure
CallWindowProc procAddress, 0&, "Dummy message", ByVal 0&, ByVal 0&
End Sub
' Gets the error message for a Windows error code
Private Function ErrorText(errorCode As Long) As String
Dim errorMessage As String
Dim result As Long
errorMessage = Space$(256)
result = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0&, errorCode, 0&, errorMessage, Len(errorMessage), 0&)
If result > 0 Then
ErrorText = Left$(errorMessage, result)
Else
ErrorText = "Unknown error"
End If
End Function
The .dll must be in the current "working" directory (or registered), otherwise at run-time the application can't find it.
Do:
MsgBox "The current directory is " & CurDir
And then compare that with what you were expecting. The .dll would need to be in that directory.
My standard first go-to approach to this issue is to break out ProcMon (or FileMon on XP). Setup the filters so that you can see where exactly it's searching for the file. It is possible that it's looking for the file elsewhere or for a different file name.
Private Declare Sub MYFUNC Lib "mylib.dll" ()
Firstly you are declaring a Sub, not a function.
These don't have return values:
(vb6) Sub() == (vc++) void Sub()
(vb6) Func() as string == (vc++) string Func()
The path you have declared is local to the running environment. Thus when running is debug mode using VB6.exe, you'll need to have mylib.dll in the same directory as VB6.exe.
As you are using private declare, you might want to consider a wrapper class for your dll. This allows you to group common dll access together but allowing for reuse. Then methods of the class are used to access the exposed function.
So you can use all the code provided above, copy it into a class
MyClass code:
Option Explicit
'Private Declare Sub MYFUNC Lib "mylib.dll" ()
'<all code above Main()>
Private Sub Class_Initialize()
'initialise objects
End Sub
Private Sub Class_Terminate()
'Set anyObj = Nothing
End Sub
Public Sub ClassMethod()
On Error Goto errClassMethod
'Perhaps look at refactoring the use of msgbox
'<code body from Main() given above>
exit sub
errClassMethod:
'handle any errors
End Sub
'<all code below main>
Apartment threading model loads ALL modules when the application is started. Using a class will only "load" the dll when the class is instantiated. Also results in neater calling code without the surrounding obfuscation of windows API calls: (ie. modMain):
Sub Main()
Dim m_base As MyClass
Set m_base = New MyClass
MyClass.ClassMethod()
End Sub
I tried #roomaroo's answer and it didn't give me specific enough info. Using Dependency Walker helped me resolve it. Also had to chdir, as per #bnadolson