This question already has answers here:
Loop through IContextMenu
(2 answers)
Closed 4 years ago.
i am trying to write a delphi application that automatically pins apps to the start menu, so they are easily visible in tablet mode.
I did some research and all i found was a VBScript that worked (see the code below).
So i tried to open the VBScript in my delphi application with Shell Execute
ShellExecute(Handle, 'open', Pchar('C:\tmp\VBScript.vbs'), 'C:\WINDOWS\system32\ notepad.exe', nil, SW_NORMAL);
But if i try to run the script with shell execute there is no "Pin to start" verb. Otherwise it works if i open it directly from the explorer.
Whats the difference between running the file directly from the windows explorer or from delphi with shell execute?
Or do you have an idea how i could try to pin apps only with delphi?
VBScript:
Dim Argumente
Dim File, objFSO
Dim strFolder, strExecutable
Set objShell = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
arg0 = wscript.arguments.unnamed.item("0")
arg1 = wscript.arguments.unnamed.item("1")
File = arg0&arg1
If (objFSO.FileExists(File )) Then
Else
WScript.Echo "File " & File & " gibt es nicht. Script fehlgeschlagen"
WScript.Quit(2)
End If
strFolder = arg0
strExecutable = arg1
WScript.Echo "Folder:" & strFolder & ""
WScript.Echo "File:" & strExecutable & ""
Set objFolder = objShell.Namespace(strFolder)
Set objFolderItem = objFolder.ParseName(strExecutable)
Set colVerbs = objFolderItem.Verbs
'uncomment this section to display the available verbs
For Each objVerb In colVerbs
If objVerb <> "" Then
WScript.Echo objVerb
End If
Next
'Loop through the verbs and if PIN is found then 'DoIt' (execute)
blnOptionFound = False
For Each objVerb In colVerbs
If Replace(objVerb.name, "&", "") = "Pin to Start" Then
objVerb.DoIt
blnOptionFound = True
WScript.Echo "The application '" & strExecutable & "' was just Pinned to the Start Menu."
WScript.Quit(0)
End If
Next
if blnOptionFound = false then
WScript.Echo "The application '" & strExecutable & "' was already pinned to the Start Menu."
WScript.Quit(1)
end if
There is a special folder for pinned start menu items into which you just place a shortcut to your program
https://superuser.com/a/171129/442240
So no need to use complex scipts for this
Related
This question already has answers here:
File checking on Windows Startup is failing [duplicate]
(2 answers)
Closed 2 years ago.
I have this script (below), not the best script but it works fine, however every time I restart my computer that new registry triplet is gone and I have no guess why.
I got no errors from this script, but if I let it run for a reasonably period of time a vbs Msgboxpops up with,
This script contains malicious content and has been blocked by your antivirus software.
I honestly don't think it is related but apparently I cannot post a question being concise due to text requirements limitations. Or is it related and the antivirus is wiping out that triplet? After this message the new register is still there (in the registry) but not after a restart.
Dim sKey
sKey = "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\so_Robocopy"
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim wshShell
Set wshShell = CreateObject("WScript.Shell")
If fso.FileExists("so_Robocopy.bat") Then
RegisterOnWindowsStartUp()
MsgBox "Backup message text"
Do While True
wshShell.Run Chr(34) & "so_Robocopy.bat" & Chr(34), 0
WScript.Sleep 300000
Loop
Else
RemoveFromRegistry()
End If
Function RemoveFromRegistry()
On Error Resume Next
wshShell.RegDelete sKey 'Error handling routine
End Function
Function RegisterOnWindowsStartUp()
If DoesRegistryExist = False Then
wshShell.RegWrite sKey, Chr(34) & WScript.ScriptFullName & Chr(34), "REG_SZ"
End If
End Function
Function DoesRegistryExist()
with CreateObject("WScript.Shell")
on error resume next
sValue = .regread(sKey)
DoesRegistryExist = (err.number = 0)
on error goto 0
End with
End Function
When you run the script, it will work fine, and no problem because you are running the script on the current directory and the so_Robocopy.bat existed on the same directory.
However, on Windows Startup, the script will execute on the Directory of Windows Startup and not on the original directory where your script is located.
Here's what happened to your code,
' Script execute from the Directory of Windows Starup
If fso.FileExists("so_Robocopy.bat") Then ' (1) There will be no so_Robocopy.bat on the Directory of Windows Startup, then this will return false.
RegisterOnWindowsStartUp()
MsgBox "Backup message text"
Do While True
wshShell.Run Chr(34) & "so_Robocopy.bat" & Chr(34), 0
WScript.Sleep 300000
Loop
Else (2) The condition is false, then remove the key from registry.
RemoveFromRegistry()
End If
Make sure you are looking from the original directory where your script is. You can use Scripting.FileSystemObject and WScript.ScriptFullName for that.
(1)
so_robocopy_file = CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName) & "\so_Robocopy.bat"
If fso.FileExists(so_robocopy_file) Then ' (2)
RegisterOnWindowsStartUp()
MsgBox "Backup message text"
Do While True
wshShell.Run Chr(34) & so_robocopy_file & Chr(34), 0 ' (3)
WScript.Sleep 300000
Loop
Else
I have been trying to create a really simple script to maintain visibility on an IE page but am currently unable to force the visibility or foreground position of an existing IE window.
I am able to successfully activate the window using WshShell.AppActivate() but it does not make the page foreground to a user. A sample from my code is below.
Basically the code loops until the user ends the notepad window. my confusion is specifically with why IE is not visible no matter what commands I send
Dim pressX
Dim FindProc
pressX = 1
' Create WScript Shell Object to access filesystem.
Set WshShell = WScript.CreateObject("WScript.Shell")
'WshShell.Run "NoScreenSaver.txt", 2, 0
' Define Which process to seek for to terminate script
strComputer = "."
FindProc = "NoScreenSaver"
Dim objApp : Set objApp = CreateObject("Shell.Application")
Dim IE : Set IE = Nothing
Dim objWindow
' Loop start
Do
' Wait for 5 minutes
WScript.Sleep 3000 '000
For Each objWindow In objApp.Windows
If (InStr(objWindow.Name, "Internet Explorer")) Then
Set IE = objWindow
Exit For
End If
Next
' check if specific notepad closed
If WshShell.AppActivate("NoScreenSaver.txt") = True Then
'WshShell.AppActivate("iexplore.exe")
'wscript.echo FindProc & " is running"
Else
wscript.echo FindProc & " is not running" & vbCrLf & "Script will now end"
pressX = 0
End If
IE.visible = True
wshshell.appactivate ie.name
IE.navigate "google.ca"
' Send dummy key
WshShell.SendKeys "{F13}"
' repeat
Loop While pressX
I never wanted to use AppActivate to check for the specific notepad window either since it would take foreground. There is some information regarding using a COM wrapper but the COM wrapper approach is not possible within my constraints.
Truth: I am completely new to this scripting thing and have reached an end-pass. I am trying to write a script that will not only create a shortcut on the user's desktop, but when the user clicks on the icon, I want them to be asked if they really want to shut down the computer and given the option to cancel the shutdown or proceed with the shutdown. So far I have searched to the end of my textbook and google. I can achieve creating an icon and having it perform a Windows native shutdown but not with my special intervening actions. I just don't know how to make the icon call back into the script for the select case routine... Sorry if it is a bit messy See below:
result = MsgBox ("Would you really like to Shutdown?", vbYesNo, "Shutdown?")
Set Shell = CreateObject("WScript.Shell")
DesktopPath = Shell.SpecialFolders("Desktop")
' Add Shutdown link to the desktop
Set linkShutdown = Shell.CreateShortcut(DesktopPath & "\Shutdown.lnk")
linkShutdown.Description = "Shutdown the computer"
linkShutdown.IconLocation = ("%SystemRoot%\system32\SHELL32.dll,27")
linkShutdown.TargetPath = "shutdown"
linkShutdown.WindowStyle = 1
linkShutdown.WorkingDirectory = "%windir%"
linkShutdown.Save
Select Case result
Case vbYes
MsgBox("Shutting down ...")
Dim objShell
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "C:\WINDOWS\system32\shutdown.exe -r -t 0"
Case vbNo
MsgBox("Ok")
End Select
Try this Vbscript : Ask2Shutdown.vbs
Option Explicit
Dim MyScriptPath
MyScriptPath = WScript.ScriptFullName
Call Shortcut(MyScriptPath,"Shutdown the computer")
Call AskQuestion()
'**********************************************************************************************
Sub Shortcut(PathApplication,Name)
Dim objShell,DesktopPath,objShortCut,MyTab
Set objShell = CreateObject("WScript.Shell")
MyTab = Split(PathApplication,"\")
If Name = "" Then
Name = MyTab(UBound(MyTab))
End if
DesktopPath = objShell.SpecialFolders("Desktop")
Set objShortCut = objShell.CreateShortcut(DesktopPath & "\" & Name & ".lnk")
objShortCut.TargetPath = Dblquote(PathApplication)
ObjShortCut.IconLocation = "%SystemRoot%\system32\SHELL32.dll,-28"
objShortCut.Save
End Sub
'**********************************************************************************************
Sub AskQuestion()
Dim Question,Msg,Title
Title = "Shutdown the computer"
Msg = "Are you sure to shutdown the computer now ?"& Vbcr &_
"If yes, then click [YES] button "& Vbcr &_
"If not, then click [NO] button"
Question = MsgBox (Msg,VbYesNo+VbQuestion,Title)
If Question = VbYes then
Call Run_Shutdown(30)
else
WScript.Quit()
End if
End Sub
'**********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
Sub Run_Shutdown(N)
Dim ws,Command,Execution
Set ws = CreateObject("wscript.Shell")
Command = "Cmd /c Shutdown -s -t "& N &" -c "& DblQuote("Save your work because your PC will shut down in "& N &" seconds")
Execution = ws.run(Command,0,True)
End sub
'**********************************************************************************************
Set x = CreateObject("Shell.Application")
x.ShutdownWindows
Gives you the Windows' Shutdown dialog.
You have two scripts in one file that you run sequentally. Put them into two files.
i want .vbs script, to open multiple large files .vbs [i want to Open .vbs one by one] that do not make me, lag in PC.
0001.vbs, 0002.vbs, 0003.vbs, 0004.vbs
is can be different names like:
Anna.vbs, Diana.vbs, Antony.vbs, Andy.vbs
Example:
run C:\0001.vbs
MsgBox "0001.vbs IS END"
Next Open run C:\0002.vbs
MsgBox YES NO
MsgBox "0002.vbs IS END"
Next Open run C:\0003.vbs
MsgBox YES NO
MsgBox "0003.vbs IS END"
Next Open run C:\0004.vbs
MsgBox YES NO
MsgBox "0004.vbs IS END"
Thank you for you help.
Set Shell = CreateObject("WScript.Shell")
For i = 1 To 4
strFile = Right("0000" & i, 4) & ".vbs"
If MsgBox("Would you like to run " & strFile & "?", vbYesNo Or vbQuestion) = vbYes Then
Shell.Run "c:\" & strFile, 1, True
MsgBox strFile & " IS END"
End If
Next
Just make sure you pass True as the last parameter to Shell.Run so that this script waits until the others are done before reporting that they've ended.
Edit: To answer your comment about using names, you can loop through an array created on-the-fly.
For Each strName In Array("Anna", "Diana", "Antony", "Andy")
Next
To not make you wait for each sub process/.vbs before you start the next, don't use the 3rd/wait/true parameter to the .Run method:
a.vbs
Option Explicit
Dim oWSH : Set oWSH = CreateObject("WScript.Shell")
Dim v
For v = 0 To 1
oWSH.Run "cscript.exe " & v & ".vbs", 0, False
Next
MsgBox WScript.ScriptName & " done. " & Now()
0.vbs, 1.vbs
Option Explicit
Randomize
WScript.Sleep Rnd() * 1000
MsgBox WScript.ScriptName & " done. " & Now()
Evidence:
As you can see, a.vbs is finished first and 0.vbs and 1.vbs terminate in random/not in call order.
We have
0001.vbs, 0002.vbs, 0003.vbs, 0004.vbs
Assuming that you have this script file with the after mentioned files in the same directory.
If not, just modify the full path of your vbs files you want to run.
Instead of
WshShell.Run ".\0001.vbs"
You use for example:
WshShell.Run "c:\indel\0001.vbs"
This is the script:
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run ".\0001.vbs"
WshShell.Run ".\0002.vbs"
WshShell.Run ".\0003.vbs"
WshShell.Run ".\0004.vbs"
What you need to do is make this code
do
msgbox("haha you cant close this")
CreateObject ("WScript.Shell").Run(".\Duplicate.vbs")
loop
I am trying to update a VBScript (very little experience with this, I do a lot of VB.NET), that reads an FTP directory and moves certain files to a new local directory on a daily basis. I have old code that works on an FTP site that uses anonymous logins, but I now need it to access an FTP site that requires username and password.
Here is my current code -
Sub MoveNSPurolatorFile()
Dim NSPurolatorFTPSite, NSPurolatorMoveFilePath, NSPurolatorFTPFolder, NSPurolatorFTPFileName
Dim folder, files
Dim fso
set fso = CreateObject("Scripting.FileSystemObject")
NSPurolatorFTPSite="\\xxx.xxx.x.xx\"
NSPurolatorMoveFilePath = "F:\TestDirectory"
NSPurolatorFTPFolder = "TestFolder"
NSPurolatorFTPFileName = "MAN0201.CSV"
If InStr(NSPurolatorFTPFileName, "_processed") = 0 and InStr(NSPurolatorFTPFileName, ".CSV") > 0 Then
If fso.FolderExists(NSPurolatorFTPSite & NSPurolatorFTPFolder) Then
If fso.FileExists(NSPurolatorFTPSite & NSPurolatorFTPFolder & NSPurolatorFTPFileName) Then
objfile.writeline "NS Purolator File Found: " & NSPurolatorFTPSite & NSPurolatorFTPFolder & NSPurolatorFTPFileName
fso.copyFile NSPurolatorFTPSite & NSPurolatorFTPFolder & NSPurolatorFTPFileName, NSPurolatorMoveFilePath & "\"
Else
objfile.writeline "File does not exist: " & NSPurolatorFTPSite & NSPurolatorFTPFolder & NSPurolatorFTPFileName
End If
End If
End If
Next
End Sub
It says the folder does not exist, but I know it does and when I run this code against an ftp site that does not require username and password it works fine. I guess my question is - How do I pass in the username and password using VBScript to the ftp site before trying to access folders, etc?
Thanks.
This really is an incredibly bad way to do this. You can't just treat folders on a remote FTP site as local folders.
You really should be using InetCtrls.Inet.1
Here's an example I lifted from somewhere else that does not do what you want, but contains all the parts you need - you need to pick it apart to suit your needs.
'Option Explicit
'const progname="FTP upload script by Richard Finegold"
'const url = "ftp://ftp.myftpsite.com"
'const rdir = "mydir"
'const user = "anonymous"
'const pass = "myname#mymailsite.com"
'This is an example of ftp'ing without calling the external "FTP" command
'It uses InetCtrls.Inet.1 instead
'Included is a "hint" for simple downloading
'Sources:
'http://msdn.microsoft.com/library/partbook/ipwvb5/loggingontoftpserver.htm
'http://msdn.microsoft.com/library/partbook/egvb6/addinginternettransfercontrol.htm
'http://cwashington.netreach.net/ - search on "ftp" - inspiration only!
'Insist on arguments
dim objArgs
Set objArgs = Wscript.Arguments
If 0=objArgs.Count Then
MsgBox "No files selected for operation!", vbOkOnly + vbCritical, progname
WScript.Quit
End If
'Force console mode - csforce.vbs (with some reorganization for efficiency)
dim i
if right(ucase(wscript.FullName),11)="WSCRIPT.EXE" then
dim args, y
For i = 0 to objArgs.Count - 1
args = args + " " + objArgs(i)
Next
Set y = WScript.CreateObject("WScript.Shell")
y.Run "cscript.exe " & wscript.ScriptFullName + " " + args, 1
wscript.quit
end if
'Do actual work
dim fso, ftpo
set fso = WScript.CreateObject("Scripting.FileSystemObject")
set ftpo = WScript.CreateObject("InetCtls.Inet.1") 'Msinet.ocx
ftpo.URL = url
ftpo.UserName = user
ftpo.Password = pass
WScript.Echo "Connecting..."
ftpo.Execute , "CD " & rdir
do
' WScript.Echo "."
WScript.Sleep 100 'This can take a while loop while ftpo.StillExecuting
for i = 0 to objArgs.Count - 1
dim sLFile
sLFile = objArgs(i)
if (fso.FileExists(sLFile)) then
WScript.Echo "Uploading " & sLFile & " as " & FSO.GetFileName(sLFile) & " "
ftpo.Execute , "Put " & sLFile & " " & FSO.GetFileName(sLFile)
'ftpo.Execute , "Get " & sRemoteFile & " C:\" & sLFile
do
'WScript.Echo "."
WScript.Sleep 100 'This can take a while
loop while ftpo.StillExecuting
else
MsgBox Chr(34) & sLFile & Chr(34) & " does not exist!", _
vbOkOnly, progname
end if
next
WScript.Echo "Closing"
ftpo.Execute , "Close"
WScript.Echo "Done!"
Here's a pretty nice way to do it - I'm sure this could be improved upon, but I just got it going.. :-)
Dim fso, folder1, folder2, folder2a
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder2a = fso.GetFolder("C:\temp")
ftpFolderString = "ftp://username:password#ftp.ftpsite.com/folderpath"
targetFoldder = "C:\temp"
fileSearchStr = "searchstring"
Dim SH, txtFolderToOpen, thing
Set SH = CreateObject("Shell.Application")
'SH.Open txtFolderToOpen
Set folder1 = SH.NameSpace(ftpFolderString)
Set folder2 = SH.NameSpace(targetFoldder)
For Each item In folder1.items
If InStr(LCase(item.Name),fileSearchStr) > 0 Then
Debug.WriteLine item.Name
folder2.CopyHere item,4
WScript.Sleep(200)
For Each item2 In folder2a.Files
If item2.Name = item.Name Then
While item2.Size < item.Size
WScript.Sleep(200)
Wend
End If
Next
WScript.Sleep(200)
End If
Next
Set SH = Nothing
Debug.WriteLine "Done"
How is the script being run? Manually, automatically? By a service?
Mapped-letter drives are not always available when running as a service.
Experiment with the script to ensure that it even able to see the F:\ drive, and then see what else is visible.
Is the FTP site accessed by a UNC path (looks like it is)? If it is just a standard FTP address then you can incorporate the username / password in the URL e.g. ftp://user:pass#myftpsite.com. If it is a UNC path that you are trying to access using different credentials then the easiest way would probably be to map a drive, do the work and then unmap the drive. 2 different approaches can be found here