gunsmokingman
Content Type
Profiles
Forums
Events
Posts posted by gunsmokingman
-
-
I have updated the original HTA.
1:\ Made it so it runs command and other resources from a folder called Resource, I also included a icon for the HTA.
In the resource folder there are 5 CMD files that are just examples to run upon selection
2:\ It self closes upon completion of command
<TITLE> « Windows 10 Install  » </TITLE> <HTA:APPLICATION ID="Win10Install" APPLICATIONNAME="Win10_Install" Border="Thin" BORDERSTYLE ="Complex" Caption="Yes" Icon="Resource/AppIcon01.ico" INNERBORDER ="No" MaximizeButton="No" MinimizeButton="Yes" Scroll="No" SCROLLFLAT ="No" SingleInstance="Yes" SysMenu="Yes" WindowState="Normal"/> <STYLE type="text/css"> Body { Padding-Top:1pt;Padding-Bottom:1pt;Margin:1pt; Font-Size:10.25pt;Font-Weight:Bold; Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS; Color:Black;BackGround-Color:#EFE9E3; Text-Align:Center;Vertical-Align:Top; } .List1{ Color:#0000A9;BackGround-Color:#C9C9C9; Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS; } .List2{ Color:#00A900;BackGround-Color:#E9E9E9; Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS; } </STYLE> <SCRIPT Language="VBScript"> '-> Script Run Time Objects Dim Act :Set Act = CreateObject("Wscript.Shell") Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject") '-> Resize And Place In Approx Center Of Screen Dim Wth, Hht :Wth = int(319) :Hht = int(175) window.ResizeTo Wth, Hht MoveTo((Screen.Width / 2) - (Wth / 2)),((Screen.Height / 2) - (Hht / 2)) '-> Get The Path Of The HTA '-> Script From https://gallery.technet.microsoft.com/scriptcenter/7a7f9937-0c6f-4f1e-a953-d29e47b2f5d5 Dim F1, F2, F3, ArrFn, Sd F1 = replace(Win10Install.commandLine,chr(34),"") ArrFn = split(F1,"\") F2 = ArrFn(ubound(ArrFn)) Sd = Replace(F1,F2,"") F3 = "<font Style='Color:1D6937';>" Function Window_onLoad() BLAH.InnerHTML = Replace(F3,"1D6937", "0B7DAD") & "Hta Path : " & Sd & "</FONT>" 'Win10Install.Icon = Sd & "Resource\AppIcon01.ico" End Function '-> Function For The Select Function Install_Select() Dim i For i = 0 To Select01.options.length If Select01.options(i).selected Then If Not Select01.options(i).value = "DiskSelect" Then BLAH.InnerHTML = F3 & "Processing Selection</FONT>" '-> Passes varible To The Work Function Work(Select01.options(i).value) Exit For End If End if Next End Function '-> Run Selected Cmd Function And Reports Missing Files Function Work(f) If Fso.FileExists(Sd & f) Then Act.Run(Sd & f),1,true window.close() Else BLAH.InnerHTML = Replace(F3,"1D6937", "ED0647") & "Missing Install Cmd Error" Act.Popup "Missing This File :" & f & vbCrLf &_ "Contact The System Administator" ,7, "Missing Install Command",4128 window.close() End If End Function </SCRIPT> <BODY> <!-- Main Text Body --> <TABLE><TD Title='' Style='Font:9.25pt;Font-weight:bold;'> Windows 10 Disk Selection</TD></TABLE> <!-- Select Body --> <TABLE><TD Title='Select a disk size you want to install Windows 10 to.'> <SELECT size='1' ID='Select01' name="Select01" OnChange='Install_Select()' Style='Width:113;Text-Align:Center;Font-Size:8.05pt;Font-Weight:Bold;'> <OPTION Class='List2' value="DiskSelect"> Select A Disk </OPTION> <OPTION Class='List1' value="Resource\Win10_Install_01.cmd"> » 120 GB</OPTION> <OPTION Class='List2' value="Resource\Win10_Install_02.cmd"> » 240 GB</OPTION> <OPTION Class='List1' value="Resource\Win10_Install_03.cmd"> » 450 GB</OPTION> <OPTION Class='List2' value="Resource\Win10_Install_04.cmd"> » 001 TB</OPTION> <OPTION Class='List1' value="Resource\Win10_Install_05.cmd"> » 002 TB</OPTION> </Select> <!-- User Message Body --> <TD Style='Font:8.25pt;Font-weight:bold;' > Select the disk size that you want to use to install Windows 10 to. This application self closes upon completion of the command.</TD> </TD></TABLE> <TABLE><TD Title='' Style='Font:8.25pt;Font-weight:bold;Padding-Top:3pt;'> <SPAN ID=BLAH></SPAN></TD></TABLE> </BODY>
1 -
I do not know if you could use this. Here is a HTA I cobble together. It a HTA that uses VBS script
to make it work. I added a text document named DemoInstall.hta.txt rename to DemoInstall.hta to make it active. I will help on any scripting problems you might have with this.
<TITLE> « Windows 10 Install  » </TITLE> <HTA:APPLICATION ID="Win10Install" APPLICATIONNAME="Win10_Install" Border="Thin" BORDERSTYLE ="Complex" Caption="Yes" Icon="%ProgramFiles%\Windows Media Player\wmplayer.exe" INNERBORDER ="No" MaximizeButton="No" MinimizeButton="Yes" Scroll="No" SCROLLFLAT ="No" SingleInstance="Yes" SysMenu="Yes" WindowState="Normal"/> <STYLE type="text/css"> Body { Padding-Top:1pt;Padding-Bottom:1pt;Margin:1pt; Font-Size:10.25pt;Font-Weight:Bold; Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS; Color:Black;BackGround-Color:#EFE9E3; Text-Align:Center;Vertical-Align:Top; } .List1{ Color:#0000A9;BackGround-Color:#C9C9C9; Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS; } .List2{ Color:#00A900;BackGround-Color:#E9E9E9; Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS; } </STYLE> <SCRIPT Language="VBScript"> '-> Resize And Place In Approx Center Of Screen Dim Wth, Hht :Wth = int(287) :Hht = int(200) window.ResizeTo Wth, Hht MoveTo((Screen.Width / 2) - (Wth / 2)),((Screen.Height / 2) - (Hht / 2)) '-> Get The Path Of The HTA '-> Script From https://gallery.technet.microsoft.com/scriptcenter/7a7f9937-0c6f-4f1e-a953-d29e47b2f5d5 Dim F1, F2, ArrFn, Sd F1 = replace(Win10Install.commandLine,chr(34),"") ArrFn=split(F1,"\") F2 = ArrFn(ubound(ArrFn)) Sd=replace(F1,F2,"") Function Window_onLoad() BLAH.InnerHTML = "Hta Path : " & Sd End Function '-> Function For The Select Function Install_Select() On Error Resume Next Dim i For i = 0 To Select01.options.length If Select01.options(i).selected Then alert(Select01.options(i).value) End if Next End Function </SCRIPT> <BODY> <!-- Main Text Body --> <TABLE><TD Title='' Style='Font:8.25pt;Font-weight:bold;'> Select A Disk Size To Install To</TD></TABLE> <!-- Select Body --> <TABLE><TD Title='Select a disk size you want to install Windows 10 to.'> <SELECT size='5' ID='Select01' name="Select01" OnChange='Install_Select()' Style='Width:105;Text-Align:Center;Font-Size:8.05pt;Font-Weight:Bold;'> <OPTION Class='List1' value="Install Script For 120 GB"> » 120 GB</OPTION> <OPTION Class='List2' value="Install Script For 240 GB"> » 240 GB</OPTION> <OPTION Class='List1' value="Install Script For 450 GB"> » 450 GB</OPTION> <OPTION Class='List2' value="Install Script For One TB"> » One TB</OPTION> <OPTION Class='List1' value="Install Script For Two TB"> » Two TB</OPTION> </Select> </TD></TABLE> <!-- Lower Body Text --> <TABLE><TD Title='' Style='Font:8.25pt;Font-weight:bold;'> Some more space for instuctions on what the app does and other information </TD></TABLE> <TABLE><TD Title='' Style='Font:8.25pt;Font-weight:bold;'> <SPAN ID=BLAH></SPAN></TD></TABLE> </BODY>
0 -
This simple script is the VBS way of renaming a file using Drag And Drop and changing the file name to
one with using HourMinuteSecond.FileExtension for it new name
'-> Object To Copy And Delete File Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject") '-> Run Time Varibles Dim FName, Nname '-> Check For Drag And Drop And Then Process A Single File If WScript.Arguments.Count = 1 Then '-> Get File So You Can Get It Path Set FName = Fso.GetFile(WScript.Arguments(0)) '-> File New Name Using HourMinutesSecomds.FileExtension Nname = Hour(Now) & Minute(Now) & Second(Now) & "." & Right(FName.Path,3) '-> Copy Drag And Drop File To It New Name FName.Copy(Replace(FName.Path,FName.Name,Nname)),True '-> Delete The Original Faile Fso.DeleteFile WScript.Arguments(0),True Else '-> For No File Or To Many File Error If WScript.Arguments.Count = 0 Then WScript.Echo _ "Drag and Drop One File On To This Script To Have It Function" If WScript.Arguments.Count > 1 Then WScript.Echo _ "To Many Files, This Script Can Process Only 1 File at a Time" End If
1 -
Here a demo menu cmd I made to turn on or
@Echo Off CLS COLOR 9F MODE 62,9 TITLE Demo Menu :Main CLS Echo. Echo This Is To Turn On Or Turn Off The Hiberfil.sys Echo. Echo Type YES For This Choice Echo Type NO For This Choice Echo Type Quit To Close Window Echo. SET Choice= SET /P Choice=Type Choice Then Press Enter: IF /I '%Choice%'=='yes' GOTO Item1 IF /I '%Choice%'=='no' GOTO Item2 IF /I '%Choice%'=='quit' GOTO TheEnd ECHO "%Choice%" is not valid. Please try again. SET /P = Press Enter To Continue GOTO MAIN :Item1 CLS Echo. Echo You Selected Choice 1 ping -n 3 127.0.0.1>nul Goto TheEnd :Item2 CLS Echo. Echo You Selected Choice 2 ping -n 3 127.0.0.1>nul Goto TheEnd :TheEnd Exit
0 -
Cmd promt Echo www.google.com and open google.com
Echo Off CLS Color 9F Mode 75, 17 Echo Opening www.google.com ping -n 2 127.0.0.1>nul start www.google.com ping -n 3 127.0.0.1>nul1 -
If you can use VBS here is a VBS script that checks all local active drives searching for
a file called Test.txt.
'-> Objects For Run Time Dim Act :Set Act = CreateObject("Wscript.Shell") Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject") '-> Varibles For Run Time Dim Chk, Drv, Fil, Tmp '-> File Name To Search For Fil = "\Test.txt" '-> Check File Set To False If Found It Becomes True Chk = False '-> Loop For All The Drives For Each Drv In Fso.Drives '-> If Drive is Active If Drv.IsReady = True Then '-> Check For The File On A Active Drive If Fso.FileExists(Drv & Fil) Then '-> If Check File Found Do Some Action WScript.Echo Drv & Fil Chk = True Else '-> Colllect The Drives That Are Missing The Check File Tmp = Tmp & "Missing : " & Drv & Fil & vbCrLf End If End If Next '-> If The Check File Is Missing If Chk = False Then WScript.Echo Tmp End If
0 -
Why not use VBS to do what you want. This way you do not have
3rd party apps to do what you want.
If MsgBox("Would you like to restart the Computer?",4132,_ "Shut Off Computer") = 6 Then '-> Code Below Here Yes MsgBox "User said yes to restart" Else '-> Code Below Here No MsgBox "User said no to restart" End If
0 -
To recap jaclaz all you have offer is nothing other than some apps that OP did not want to use.
1:\ The only way you might be able to do this is with VBS sendkeys method
https://social.technet.microsoft.com/wiki/contents/articles/5169.vbscript-sendkeys-method.aspx
This means, it might work or it might not work
No where does it say it will work or that this is the only way of doing it.
2:\ I have given the OP a solution to his problem that he elected not to use
QuoteMike88 if you want a simple way to do what you want could you run the cmd from vbs
Example
[CODE}
Dim Act :Set Act = CreateObject("Wscript.Shell")
'-> First Cmd Show Windows Wait Until Finished
Act.Run("Some1.cmd /Switches"),1,True
'-> Second Cmd Hide Windows Wait Until Finished
Act.Run("Some2.cmd /Switches"),0,True
'-> Third Cmd Show Windows Wait Until Finished
Act.Run("Some3.cmd /Switches"),1,True{/CODE]
3;\ Then I provided the list from here https://technet.microsoft.com/en-us/library/ee156605.aspx
Integer = Window Style Description
0 = Hides the window and activates another window.
1 = Activates and displays a window. If the window is minimized or maximized, the system restores it to its original size and position. An application should specify this flag when displaying the window for the first time.
2 = Activates the window and displays it as a minimized window.
3 = Activates the window and displays it as a maximized window.
4 = Displays a window in its most recent size and position. The active window remains active.
5 = Activates the window and displays it in its current size and position.
6 = Minimizes the specified window and activates the next top-level window in the Z order. The Z order is nothing more than the list detailing the order in which windows are to be activated. If you press ALT+TAB, you will see a graphical representation of the Z list.
7 = Displays the window as a minimized window. The active window remains active.
8 = Displays the window in its current state. The active window remains active.
9 = Activates and displays the window. If the window is minimized or maximized, the system restores it to its original size and position. An application should specify this flag when restoring a minimized window.
10 = Sets the show-state based on the state of the program that started the application.
4:\ Sendkeys does work in cmd perhaps it does not accept all keys combination. Myself I
only use sendkey for demo and nothing else more.
'-> Objects For Script Run Time Dim Act :Set Act = CreateObject("Wscript.Shell") Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject") '-> Varibles For Run Time Dim UP :UP = Act.ExpandEnvironmentStrings("%UserProfile%") & "\Desktop\Test.txt" Dim UN :UN = Act.ExpandEnvironmentStrings("%UserName%") '-> Open Cmd Act.Run("cmd.exe"),1,False Act.AppActivate("cmd.exe") :WScript.Sleep 100 '-> Body Of Command For Cmd Act.SendKeys "Echo Off" :WScript.Sleep 100 Act.SendKeys "{ENTER}" Act.SendKeys "CLS && Color A9" :WScript.Sleep 100 Act.SendKeys "{ENTER}" Act.SendKeys "" :WScript.Sleep 1000 Act.SendKeys "{ENTER}" Act.SendKeys "Echo="+UN+" > " + UP Act.SendKeys "{ENTER}" Act.SendKeys "CLS && Color F9" :WScript.Sleep 1000 Act.SendKeys "{ENTER}" Act.SendKeys "" :WScript.Sleep 100 Act.SendKeys "{ENTER}" Act.SendKeys "Dir /b" :WScript.Sleep 1000 Act.SendKeys "{ENTER}" Act.SendKeys "Dir /b >>" + UP:WScript.Sleep 100 Act.SendKeys "{ENTER}" Act.SendKeys "Exit" :WScript.Sleep 3500 Act.SendKeys "{ENTER}" '-> Check To See If Text Exist If Fso.FileExists(UP) Then '-> Open Text File Act.Run(UP),1,True '-> Ask To Keep Or Delete Text File If MsgBox("Yes To Delete No To Keep File",4132,"Keep Or Delete") = 6 Then Fso.DeleteFile(UP),True End If End If0 -
You are wrong jaclaz Sendkeys does work on cmd.exe, I was able to
send text and have it do a DIr command and exit.
0 -
I did a test of cmd.exe using Sendkeys I did manage to get something
to work. The problem is the loop for cmd.exe it just stays stuck in the
loop.
Dim Act :Set Act = CreateObject("Wscript.Shell")
Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")
Act.Run("cmd.exe"),1,False
Success = Act.AppActivate("cmd.exe")
Wscript.Sleep 1000
Act.SendKeys "COLOR 9F" :WScript.Sleep 100
Act.SendKeys "{ENTER}" :WScript.Sleep 500
WScript.Sleep 100
Act.SendKeys "Test of AppActivate." :WScript.Sleep 1000
Act.SendKeys "{ENTER}"
Act.SendKeys "CLS" :WScript.Sleep 100
Act.SendKeys "{ENTER}"
Act.SendKeys "Dir /B" :WScript.Sleep 500
Act.SendKeys "" :WScript.Sleep 500
Act.SendKeys "{ENTER}"
Act.SendKeys "Exit" :WScript.Sleep 3500
Act.SendKeys "{ENTER}"[/CODE]
0 -
The SendKey method is not a very reliable way of doing things. The best way I think to do what Mike86
wants is use CreateObject("Wscript.Shell").run method and use it own built in method of displaying how
the app windows appear.
Table 3.9 Integers Accepted by the Run Method for the Window Style
https://technet.microsoft.com/en-us/library/ee156605.aspx
Integer = Window Style Description
0 = Hides the window and activates another window.
1 = Activates and displays a window. If the window is minimized or maximized, the system restores it to its original size and position. An application should specify this flag when displaying the window for the first time.
2 = Activates the window and displays it as a minimized window.
3 = Activates the window and displays it as a maximized window.
4 = Displays a window in its most recent size and position. The active window remains active.
5 = Activates the window and displays it in its current size and position.
6 = Minimizes the specified window and activates the next top-level window in the Z order. The Z order is nothing more than the list detailing the order in which windows are to be activated. If you press ALT+TAB, you will see a graphical representation of the Z list.
7 = Displays the window as a minimized window. The active window remains active.
8 = Displays the window in its current state. The active window remains active.
9 = Activates and displays the window. If the window is minimized or maximized, the system restores it to its original size and position. An application should specify this flag when restoring a minimized window.
10 = Sets the show-state based on the state of the program that started the application.
0 -
Here is a SendKey Demo in VBS
[CODE}
Dim Act :Set Act = CreateObject("Wscript.Shell")
Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")
Act.Run("Notepad.exe"),1,FalseDo Until Success = True
Success = Act.AppActivate("Notepad")
Wscript.Sleep 1000
Loop
'-> Send keys Body Message
Act.SendKeys "This is a test of AppActivate."
WScript.Sleep 1000
Act.SendKeys "{ENTER}"
Act.SendKeys "T" :WScript.Sleep 500
Act.SendKeys "e" :WScript.Sleep 500
Act.SendKeys "s" :WScript.Sleep 500
Act.SendKeys "t" :WScript.Sleep 500
'-> Send keys For saving File
Act.SendKeys "%F"
Act.SendKeys "{DOWN}" :WScript.Sleep 500
Act.SendKeys "{DOWN}" :WScript.Sleep 500
Act.SendKeys "{DOWN}" :WScript.Sleep 500
Act.SendKeys "{ENTER}" :WScript.Sleep 500
'-> Send key Save Text File Name
Act.SendKeys "T" :WScript.Sleep 500
Act.SendKeys "e" :WScript.Sleep 500
Act.SendKeys "m" :WScript.Sleep 500
Act.SendKeys "p" :WScript.Sleep 500
Act.SendKeys ".txt":WScript.Sleep 500
Act.SendKeys "{ENTER}",500
'-> Send File Keys To Close
Act.SendKeys "%F" :WScript.Sleep 1000
Act.SendKeys "{DOWN}" :WScript.Sleep 500
Act.SendKeys "{DOWN}" :WScript.Sleep 500
Act.SendKeys "{DOWN}" :WScript.Sleep 500
Act.SendKeys "{DOWN}" :WScript.Sleep 500
Act.SendKeys "{DOWN}" :WScript.Sleep 500
Act.SendKeys "{DOWN}" :WScript.Sleep 500
Act.SendKeys "{ENTER}" :WScript.Sleep 500
'_> Remove The Created Text File
Dim F, P
P = Act.ExpandEnvironmentStrings("%Userprofile%") & "\Documents\Temp.txt"
Set F = Fso.GetFile(P)
F.Delete[/CODE}
Rename Demo_SendKey.vbs.txt to Demo_SendKey.vbs to make active
0 -
Mike88 if you want a simple way to do what you want could you run the cmd from vbs
Example
[CODE}
Dim Act :Set Act = CreateObject("Wscript.Shell")
'-> First Cmd Show Windows Wait Until Finished
Act.Run("Some1.cmd /Switches"),1,True
'-> Second Cmd Hide Windows Wait Until Finished
Act.Run("Some2.cmd /Switches"),0,True
'-> Third Cmd Show Windows Wait Until Finished
Act.Run("Some3.cmd /Switches"),1,True{/CODE]
Table 3.9 Integers Accepted by the Run Method for the Window Style
https://technet.microsoft.com/en-us/library/ee156605.aspx
0 -
The only way you might be able to do this is with VBS sendkeys method
https://social.technet.microsoft.com/wiki/contents/articles/5169.vbscript-sendkeys-method.aspx
0 -
Start with a Google query like Code language for drivers
0 -
I am not sure what you want but using this reference https://msdn.microsoft.com/en-us/library/windows/desktop/aa378858(v=vs.85).aspx
I put together this script run it and see if it what you need.
Dim d,oWMI, oSR, colItem, objItem Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2") Set oSR = GetObject("winmgmts:{impersonationLevel=impersonate}!root/default:SystemRestore") Set colItem = oWMI.ExecQuery("SELECT * FROM Win32_LogicalDisk WHERE DriveType=3") On Error Resume Next For Each objItem In colItem d = objItem.Name & "\" If (oSR.Enable(d)) = 0 Then wscript.Echo "Success" & vbTab & d Else wscript.Echo "Failed " & vbTab & d End If Next
0 -
I have updated the original script
1:\ Added a message box to appear with instructions on how to use
2:\ Added a new user input to search for the file type
New Code
Dim Col,Str, Res :Str = "." Dim Wmi :Set Wmi = GetObject("winmgmts:\\" & Str & "\root\cimv2") '-> Check To Nake Sure Cscript Is Used If InStr(1,WScript.FullName,"cscript",1) Then UserImput() '-> Main Search Object Using The User Input Set Col = Wmi.ExecQuery("Select * from CIM_DataFile Where Extension = '" & Res &"'") WScript.StdOut.WriteLine "Begin Querry For " & Res Main() Else '-> Wrong Script Engine MsgBox Space(10) & "Error Wrong Scripting Engine" & vbCrLf & _ "You must right click this script and select the Cmd Prompt or" & vbCrLf & _ "Csript option to run this script",4128,"Error Wrong Script Engine" End If '-> Main Function To Collect All The Files Function Main() If Col.count = 0 Then WScript.StdOut.WriteLine "Can Not Find This File Type" WScript.Sleep 3500 WScript.Quit Else WScript.StdOut.WriteLine "Processing Please Wait..." For Each Obj in Col '-> Display File Type WScript.StdOut.WriteLine Obj.Name WScript.Sleep 300 Next End If Res = "" CloseCmd() End Function '-> Get User Input For File Type Function UserImput() Do While Res = "" WScript.StdOut.WriteBlankLines 1 WScript.StdOut.WriteLine _ "Type the file type you are searching for in this" & vbCrLf &_ "format txt or vbs or cmd no dot is needed." & vbCrLf & _ "Type exit or quit to stop the script." WScript.StdOut.WriteBlankLines 1 Res = Wscript.StdIn.ReadLine Select Case LCase(Res) Case "exit" WScript.Quit Case "quit" WScript.Quit End Select Loop End Function '-> Close The CMD Window Function CloseCmd() Do While Res = "" WScript.StdOut.WriteBlankLines 2 WScript.StdOut.WriteLine "Total File Count : " & Col.count WScript.StdOut.WriteLine "Type quit Or exit to close CMD window" Res = Wscript.StdIn.ReadLine Select Case LCase(Res) Case "exit" WScript.Quit Case "quit" WScript.Quit End Select Loop End Function
Rename WmiUserInExtSearch.vbs.txt to WmiUserInExtSearch.vbs to make active
0 -
Here is a VBS script that output results to CMD prompt window. You will have to add the file type that you want to search for.
'-> Main Search Object Change 'vbs' to 'FileTypeHere'
Dim Col :Set Col = Wmi.ExecQuery("Select * from CIM_DataFile Where Extension = 'vbs'")Dim Str :Str = "." Dim Wmi :Set Wmi = GetObject("winmgmts:\\" & Str & "\root\cimv2") '-> Main Search Object Change 'vbs' to 'FileTypeHere' Dim Col :Set Col = Wmi.ExecQuery("Select * from CIM_DataFile Where Extension = 'vbs'") Dim Res '-> Check To Nake Sure Cscript Is Used If InStr(1,WScript.FullName,"cscript",1) Then Main() End If '-> Main Function To Collect All The Files Function Main() If Col.count = 0 Then WScript.StdOut.WriteLine "Can Not Find This File Type" WScript.Sleep 3500 WScript.Quit Else WScript.StdOut.WriteLine "Processing..." For Each Obj in Col '-> Display File Type WScript.StdOut.WriteLine Obj.Name WScript.Sleep 500 Next End If CloseCmd() End Function '-> Close The CMD Window Function CloseCmd() Do While Res = "" WScript.StdOut.WriteLine "Total File Count : " & Col.count WScript.StdOut.WriteLine " Type quit Or exit to close CMD window" Res = Wscript.StdIn.ReadLine Select Case LCase(Res) Case "exit" WScript.Quit Case "quit" End Select Loop End Function
I have tested this script on my computer with no run-time error. I will help you edit this script so it will do what you want.
0 -
Here is a rewrite of your code that you posted, I removed all the redundant code and added
a function to process the text file.
<script language="VBScript"> Option Explicit '-> Objects For Run Time Dim fso :Set fso = CreateObject("Scripting.FileSystemObject") Dim WshShell :Set WshShell = CreateObject("WScript.Shell") Dim Temp :Temp = Temp = WshShell.ExpandEnvironmentStrings("%Temp%") '-> Varibles For Run Time Dim Command, PSFile, return, file,text '-> Button 01 Click Function Run_PS_Script1() ExampleOutput.value = "" btnClick1.disabled = True document.body.style.cursor = "wait" btnClick1.style.cursor = "wait" Command = "cmd /c echo Get-NetAdapter ^| select Name,MacAddress ^| Where-Object {$_.Name -like 'Ethernet' -or $_.Name -like 'Wi-Fi'} ^| Out-File %temp%\output.txt -Encoding ascii > %temp%\process.ps1" PSFile = WshShell.Run(Command,0,True) return = WshShell.Run("powershell.exe -ExecutionPolicy Unrestricted -File %temp%\process.ps1", 0, true) '-> Replace It With A Function, So It Can Be Access More than Once ReadTheFile() document.body.style.cursor = "default" btnClick1.style.cursor = "default" btnClick1.disabled = False End Function '-> Button 02 Click Function Run_PS_Script2() ExampleOutput.value = "" btnClick2.disabled = True document.body.style.cursor = "wait" btnClick2.style.cursor = "wait" Command = "cmd /c echo Get-NetAdapter ^| select Name,MacAddress ^| Where-Object {$_.Name -like 'Ethernet'} ^| Out-File %temp%\output.txt -Encoding ascii > %temp%\process.ps1" PSFile = WshShell.Run(Command,0,True) return = WshShell.Run("powershell.exe -ExecutionPolicy Unrestricted -File %temp%\process.ps1", 0, true) Set fso = CreateObject("Scripting.FileSystemObject") '-> Replace It With A Function, So It Can Be Access More than Once ReadTheFile() document.body.style.cursor = "default" btnClick2.style.cursor = "default" btnClick2.disabled = False End Function '-> Read The Text File Dislay The Results, From Button 01 And Button 02 Function ReadTheFile() Set file = fso.OpenTextFile(Temp &"\output.txt", 1) text = file.ReadAll ExampleOutput.Value=text file.Close End Function </script>
0 -
VBS Drag And Drop Function
'-> Checks To Make Sure Only 1 Files Is Process If WScript.Arguments.Count = 0 Then MsgBox "You Must Drag And Drop One File Onto This Script.",4128, _ "Error No Drag And Drop performed" ElseIf WScript.Arguments.Count = 1 Then MsgBox WScript.Arguments.Item(0),4128, "Drag Drop Demo" ElseIf WScript.Arguments.Count > 1 Then MsgBox "Drag And Drop To Many Files, This Script Is Only For One File To Be Drag And Drop Onto " & _ "This Script",4128,"Error To Many Files" End If
0 -
Here is a Demo VBS script that pings in this order, your computer, made up IP, your computer, made up IP. It uses a counter that resets it self every 5 times. When it stops if you do nothing or select No than the script continues after 30 seconds, if Yes is selected script quits. It displays the ping results in a 3 second self closing message box, it also display the cycles left before being ask to continue or quit.
DemoPing
'-> Run Time Object Dim Act :Set Act = CreateObject("Wscript.Shell") '-> Run Time Varibles Dim C1, i, Ip, Rtn, T1, T2 Ip = Array("127.0.0.1", "81.123.55.99","127.0.0.2","82.234.100.56") '-> Loop To Keep Repeating The Second Loop Do C1 = C1 + 1 '-> Stops The Script If C1 = 5 Then '-> No Or Time Out Continues The Script, Yes Script Quit, If Act.Popup("Would You Like To Quit The Script?",30, _ "Continue Or Quit", 4132) = 6 Then WScript.Quit(1) End If '-> Reset The Counter C1 = 0 End If '-> Threw The Ip Array For Each i In Ip Ping(i) T1 = Rtn & ", Ip Reply : "& i :T2 = "Cycles Left : " & 5-C1 If Rtn Then Act.Popup T1 & vbCrLf & T2,3,"Yes Reply",4128 Else Act.Popup T1 & vbCrLf & T2,3,"No Reply",4128 End If Next Loop Until C1 = 10000 '-> Ping Computer Function Ping(P) If Act.Run("Ping -n 1 -w 1000 " & P, 0, True) = 0 Then Rtn = True Else Rtn = False End If End Function
Rename PingDemo.vbs.txt to PingDemo.vbs to make it active PingDemo.vbs.txt
0 -
You would need to use a loop within a loop to do what you need
Example only not working code
Do For Each Object In Your List Of Computors Some Code Here To Ping next Until Something That last 6 Hours
0 -
Here is a VBS script that meant to be run from your Desktop to a Folder and list it Contents. It then rename the file to a 4 digit number, it also produces a text file with the changes made.
1:\ Change This For Each i In Fso.GetFolder("D:\UsbMp3").Files, to the path of the folder
2:\ This script only is meant to be used with file that have only 3 characters and a period any less or more will cause an error
Code
'-> Object For Runtime Dim Act :Set Act = CreateObject("Wscript.Shell") Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject") '-> Run Time Varibles Dim C1, i, j, t, Ts '->Loop Threw The File In The Folder Listed Below For Each i In Fso.GetFolder("D:\UsbMp3").Files '-> Count The Files C1 = C1 + 1 '-> Get The Period And File Charaters EG .com, .txt, .vbs j = Right(i.Name,4) '-> For The Text Report List The New File Name With The Old File Name t = t & Az(C1) & j & " = " & i.Name & vbCrLf '-> Copy Old Name To the New Name = Az(C1) & j Fso.CopyFile i.Path,Replace(i.path,i.name,Az(C1) & j),True '-> Delete The Old File Fso.DeleteFile(i.Path),True Next '-> Build And Show The Report Set Ts = Fso.CreateTextFile("TestList.txt") Ts.WriteLine Now() Ts.WriteLine "Files Process : " & Az(C1) Ts.WriteLine t Ts.Close() Act.Run("TestList.txt"),1,True '-> Ask To Keep It Or Delete It If MsgBox("Yes To Keep TestList.txt Or No To Delete TestList.txt", _ 4132,"Keep Or Delete") = 7 Then Fso.DeleteFile("TestList.txt"),True End If '-> Funtion To Add Zero To The Number Function Az(n) Dim z If Len(n)= 1 Then n = "000" & n If Len(n)= 2 Then n = "00" & n If Len(n)= 3 Then n = "0" & n Az=n End Function
Rename TestListFiles.vbs.txt to TestListFiles.vbs to make active TestListFiles.vbs.txt
Resuts TestList.txt
0 -
Perhaps a more simple solution would be to use a VBS script to install. I say this because VBS has a built in
Timer Function, below is an example using 3 common MS apps in an Array. It will then process the time it
takes you to close each app and report it with a 10 second self closing Popup messagebox.
'-> Runtime Object Dim Act :Set Act = CreateObject("Wscript.Shell") '-> Array To Hold Apps Dim App :App = Array("Notepad.exe","mspaint.exe", "cmd.exe") '-> Runtime Varibles Dim Tm1, Tm2, Tm3, Tm4, i '-> Threw Each App In Tha Array For Each i In App '-> Start Time Tm1 = Timer Act.Run(i),1,True '-> End Time Tm2 = Timer '-> Results Tm3 = Tm2 - Tm1 '-> For The Popup Report Tm4 = Tm4 & Round(Tm3,2) & " seconds " & i & vbCrLf Next '-> Show The Results Act.Popup Tm4,10,"Results",4128Rename DemoTimer.vbs.txt to DemoTimer.vbs to make active
0
[PS/Batch] Looking for a one line command to Refresh the Desktop.
in Programming (C++, Delphi, VB/VBS, CMD/batch, etc.)
Posted
VBS script 1 line to refresh Desktop