Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 6 years ago.
Improve this question
I have this vbs (part of the script was provided by hackoo) to launch sfc.exe to fix system files, but like I need to add some features, such as a message, and I need while running sfc.exe, display a message "wait" (hiding the sfc.exe window) and the end of the program, exit the final message, but the script does not work well (sfc.exe fails hiding the window and displays the final message before concluding)
Option Explicit
' Run as Admin
If Not WScript.Arguments.Named.Exists("elevate") Then
CreateObject("Shell.Application").ShellExecute WScript.FullName _
, WScript.ScriptFullName & " /elevate", "", "runas", 1
WScript.Quit
End If
On Error Resume next
mensaje = MSGBOX ("Start System File Checker", vbOKCancel, "System File Checker")
If mensaje = vbOK Then
Dim ws,MyCommand,Execution
Set ws = createobject("wscript.shell")
MyCommand = "%windir%\system32\SFC.exe /SCANNOW"
Execution = ws.run(MyCommand,1,False)
objshell.run NewPath,vbhide
CALL MSGBOX ("System File Checker has finished", VBOKONLY, "System File Checker")
Else
CALL MSGBOX ("System File Checker has been canceled", VBOKONLY, "System File Checker")
End If
On Error GoTo 0
Note: missing part "wait" while running hidden sfc.exe
Thanks
To hide the console you should write it like that :
Change False to True for waiting until the process will finish and the value 1 to 0 to hide the console
Execution = ws.run(MyCommand,0,True)
And your code should look like this one :
Option Explicit
' Run as Admin
If Not WScript.Arguments.Named.Exists("elevate") Then
CreateObject("Shell.Application").ShellExecute WScript.FullName _
, WScript.ScriptFullName & " /elevate", "", "runas", 1
WScript.Quit
End If
Dim ws,MyCommand,Execution,Question
Question = MSGBOX ("Did you want to start the System File Checker ?", vbOKCancel+vbQuestion, "System File Checker")
If Question = vbOK Then
Set ws = createobject("wscript.shell")
MyCommand = "%windir%\system32\SFC.exe /SCANNOW"
Execution = ws.run(MyCommand,0,True)
If Execution = 0 Then
Call MSGBOX ("System File Checker has finished", VBOKONLY, "System File Checker")
Else
Call MSGBOX ("System File Checker has been canceled", VBOKONLY, "System File Checker")
Wscript.quit(1)
End If
Else
Call MSGBOX ("System File Checker has been canceled", VBOKONLY, "System File Checker")
Wscript.quit(1)
End If
Related
This question already exists:
CANoe reconnect to instance using com [closed]
Closed 10 months ago.
I am developing vbs script to launch CANoe and then readout system variable. I am able to launch CANoe successfully and having problem in reading system variable.
My code is as follow:
Set App = CreateObject("CANoe.Application")
Wscript.Sleep(3000)
If Err.Number Then
Wscript.Echo "Error in opening config file, quit the script"
WScript.Quit
Else
Wscript.Echo "CAnoe Launched successfully"
End If
'App.Open (ScriptPath & "\CANoe_VW_T7ACS.cfg")
App.Open(WScript.Arguments.Item(0))
Wscript.Sleep(3000)
If Err.Number Then
Wscript.Echo "Error in opening config file, quit the script"
WScript.Quit
Else
Wscript.Echo "CAnoe Config Loaded successfully"
End If
If App.Configuration.ReadOnly Then
Wscript.Echo "The configuration is read-only."
Else
Wscript.Echo "The configuration is writeable."
End If
App.Measurement.Start
WScript.Sleep(5000)
WScript.Sleep(5000)
WScript.Sleep(5000)
Set Measurement = App.Measurement
Wscript.ConnectObject Measurement, "Measurement_"
Set Pedal = App.CAPL.cclSysVarSetInteger("Relais::Relais_S_C1", 0)
Wscript.Echo Pedal
Set App = Nothing
Set Measurement = Nothing
The error I am getting at line
Set Pedal = App.CAPL.cclSysVarSetInteger("Relais::Relais_S_C1", 0)
is,
enter image description here
what can be the problem ?
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
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
I am currently learning how to write commands in Visual Basic and decided to make a simple shutdown message. The code worked perfectly: when the user clicked 'yes' it shutdown and 'no', 'cancel' and the 'X' button closed the message.
However, I decided to try a make a prank message aswell, where the computer would shutdown whatever option was chosen. I ran the script, however when I clicked the 'X' icon (I did not fancy the idea of shutting down my computer!), my computer shutdown anyway :(
Is there a way to stop this happening, or, even better, is there a way to grey out the 'X' icon so the user cannot close the message?
Here is the code:
Option Explicit
Dim result
result = MsgBox ("Do you want to shutdown?", 3+48,"Warning")
Dim objShell
Select Case result
Case vbYes
MsgBox("shuting down ...")
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "C:\WINDOWS\system32\shutdown.exe -r -t 20"
Case vbNo
MsgBox("shuting down ...")
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "C:\WINDOWS\system32\shutdown.exe -r -t 20"
Case vbCancel
MsgBox("shuting down ...")
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "C:\WINDOWS\system32\shutdown.exe -r -t 20"
End Select
Cheers in advance! :D
-r : for reboot
-s : for shutdown
This Vbscript can create a shortcut on your desktop asking you if you want to shutdown the computer or not.
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
'**********************************************************************************************
Ok, is there a reason for trying to remove/disable the X? I ask because it will be kinda difficult though it can be done.
Not all button combinations on the msgbox enable the X. Try vbAbortRetryIgnore and also try vbYesNo.
If a Cancel button is provided (all other combinations except vbOkOnly) then X is enabled
If only one button is displayed then X is enabled
This really makes it almost pointless to disable the button once you are aware of these things. Here's what happens when the above scenarios are displayed an user hits X vs clicking on a button
N/A. X button not enabled
MsgBox returns vbCancel
MsgBox returns value of only button
By the way, it is not just clicking X. When X is enabled, ESC will trigger same results.
I want to launch swf application through vb script code,by making function library in qtp.
Try this sample :
Option Explicit
Dim Application
Application = "D:\Offroad Madness.swf" 'Path to your swf file.Just change this line
Call RunThis(Application)
'*********************************************************************************
Sub RunThis(Application)
Dim Title,Ws,Question,Result
Title = "Open SWF Files by Hackoo 2015"
Set Ws = CreateObject("WScript.Shell")
Question = MsgBox("Did you want to open this file "& DblQuote(Application) &" with iexplore ?" & Vbcr &_
"Yes ==> To open the swf file with iexplore" & Vbcr &_
"No ==> To open the swf file with default program" & Vbcr &_
"Cancel ==> To quit this script",vbQuestion+vbYesNoCancel,Title)
If Question = vbYes Then
Result = Ws.Run("iexplore.exe "& DblQuote(Application),1,False)
End If
If Question = vbNo Then
Result = Ws.Run(DblQuote(Application),1,False)
End If
If Question = vbCancel Then
Wscript.Quit()
End If
End Sub
'*********************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'*********************************************************************************