How to output Command prompt to a log file using VBScript - vbscript

I'm not a programmer so I don't want to overly irritate the fine folk in this forum. My issue is that I would like to use VBScript to Telnet into a Linux device, issue a DF command and output all response to a log file which I can parse later. I originally found a method to successfully Telnet but I have have been experimenting without success regarding the text file output requirement. The following code certainly does not work but I am wondering if I am even close to the correct method?
Dim WshShell, oExec
Set WshShell = CreateObject("WScript.Shell")
Set oExec = WshShell.Exec("cmd /c dir")
WshShell.run"cmd" '*** open command window ***
WScript.Sleep 250
WshShell.SendKeys("{Enter}")
WshShell.SendKeys"telnet 10.13.2.2"
WshShell.SendKeys("{Enter}")
WScript.Sleep 2000
WshShell.SendKeys"root"
WshShell.SendKeys("{Enter}")
WScript.Sleep 1500
WshShell.SendKeys"password"
WshShell.SendKeys("{Enter}")
WScript.Sleep 1500
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objLogFile = objFSO.OpenTextFile("C:\VBSmemSize.txt", 2, True)
WshShell.SendKeys"df /mnt/cf"
WshShell.SendKeys("{Enter}")
Do
strFromProc = oExec.Stdout.Readline()
WScript.Echo strFromProc
Loop While Not objLogFile.StdOut.atEndOfStream

You can capture output from external commands but not at the same time interact with them like you do with sendkeys. Here an example of what works
Function ExecPing(strTarget)
Set objShell = CreateObject("WScript.Shell")
Set objExec = objShell.Exec("ping -n 2 -w 1000 " & strTarget)
strPingResults = LCase(objExec.StdOut.ReadAll)
If InStr(strPingResults, "antwoord van") Then '"reply from" in E
WScript.Echo VbCrLf & strTarget & " responded to ping."
ExecPing = True
Else
WScript.Echo VbCrLf & strTarget & " did not respond to ping."
ExecPing = False
End If
End Function
ExecPing pcname

Related

Use VBscript to paste data into a txt file and save

I need to paste data from clipboard (Ctrl+V) into a text file and save it.
I already did some research and it seems that a text file doesn't have a method like SaveAs.
With code below, I could create a new text file and paste data into it, but I can't Save it:
Set WShshell = CreateObject("WScript.Shell")
WShshell.run "c:\WINDOWS\system32\notepad.exe",1
WshShell.AppActivate "notepad"
WShshell.SendKeys "^V"
I understand there is a method called CreateTextFile, but seems I can't perform paste with it.
I also tried to combine those two:
Set WShshell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CreateTextFile "c:\1.txt",true
WshShell.AppActivate "notepad"
WShshell.SendKeys "^V"
But nothing happened...
UFT has its own clipboard access methods you could use. Here I've created an instance of the clipboard, and extracted its content into sText, then created a text file in C:\temp and written the data from the clipboard directly into it. oFile.Close closes the file and saves it at the same time.
Dim oClipboard : Set oClipboard = CreateObject("Mercury.Clipboard")
sText = oClipboard.GetText ' gets the current content of the clipboard
Dim oFso : Set oFso = CreateObject("Scripting.FileSystemObject")
Dim oFile : Set oFile = oFso.CreateTextFile("C:\temp\myTextFile.Txt", True)
oFile.Write sText
oFile.Close
I took a stab at it... This was my successful result.
I also noted that this script got really angry when another notepad was already opened.
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set WShshell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
'Gets user profile variable with CMD
UserProfile = CreateObject("WScript.Shell").Exec("cmd /c echo.%USERPROFILE%").Stdout.ReadAll
'Creates temporary files in appdata\local\temp
'--------------------------------------------------------------------------------------
tmpfilename = fso.GetTempName
tmpfile = Replace(UserProfile & "\AppData\Local\Temp\" & tmpfilename, vbcrlf, "")
Set CreateTempFile = FSO.OpenTextFile(tmpfile, forwriting, true) : CreateTempFile.Close
'Creates a new file for the pasted content
'--------------------------------------------------------------------------------------
MyFile = ThisFolder & "ClipBoard_Extract_" & _
Replace(FormatDateTime(Cdate(now),2), "/", "-") & "_" & _
Hour(now) & Minute(Now) & Second(now) & ".txt"
'Execute's the Main Sub but you could get along without it.
' I usually build my scripts to scale and do logging and other magical things.
'--------------------------------------------------------------------------------------
MainScript
Sub MainScript()
CaptureClipboardText
ExtractTempFile
End Sub
Sub CaptureClipboardText
WShshell.run "c:\WINDOWS\system32\notepad.exe " & tmpfile, 1
WshShell.AppActivate "Notepad"
wscript.sleep 1000
WShshell.SendKeys "^V"
WShshell.SendKeys "^S"
Wshshell.SendKeys "%F"
Wshshell.SendKeys "x"
Wshshell.SendKeys "s"
wscript.sleep 1000
End Sub
Sub ExtractTempFile
Set Extract = fso.OpenTextFile(tmpfile, ForReading)
Set Output = fso.OpenTextFile(MyFile, ForWriting, True) 'True on this syntax means - Create the file if it doesn't exist.
Do Until Extract.AtEndofSTream
line = Extract.Readline
Output.Writeline Line
Loop
Extract.Close : Set Extract = Nothing
fso.DeleteFile tmpfile, true
End Sub
Function ThisFolder
ThisFolder = Left(Wscript.ScriptFullName, Len(Wscript.ScriptFullName) - Len(Wscript.ScriptName))
End Function
Cheers!

Pinging and launching program

I am trying to make a script which pings an IP address until it receives a response. When it does, it launches another script called "sound.vbs". I've got 2 issues:
I don't
want the cmd window to pop up when ping command is executed.
Even when ping fails, script simply shuts down instead of waiting some time and retrying the ping.
Code:
Dim objShell
Set objShell = Wscript.CreateObject("WScript.Shell")
Dim target 'define target ip
Dim result 'define ping result
target= "193.105.173.130" 'Archeage EU server IP (possibly Shatigon)
result = "Request timed out" 'Initial result
Set shell = WScript.CreateObject("WScript.Shell") 'create WScript shell
Set shellexec = shell.Exec("ping " & target) 'setting up the ping
Dim count
count = 1
Do
result = LCase(shellexec.StdOut.ReadAll)
If InStr(result , "reply from") Then
objShell.Run "sound.vbs"
Set objShell = Nothing
count = count + 1
Else
WScript.Sleep 4000
End If
Loop until count < 2
How do I solve the listed issues?
You can try like this script just modify to yours :
Option Explicit
Dim strComputer,objPing,objStatus
strComputer = "smtp.gmail.com"
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\\").ExecQuery _
("select * from Win32_PingStatus where address = '" & strComputer & "'")
For Each objStatus in objPing
If objStatus.Statuscode = 0 Then
Call MyProgram()
wscript.quit
End If
Next
'****************************************************
Sub MyProgram()
Dim objShell
Set objShell = CreateObject( "WScript.Shell" )
objShell.Run("calc.exe")
Set objShell = Nothing
End Sub
'****************************************************
Inspired from Loop a function?
If StrComp(right(WScript.FullName,11),"wscript.exe",1) = 0 Then '' hide the popup of cmd windows
WScript.Quit CreateObject("WScript.Shell").Run("cscript.exe //nologo """ & WScript.ScriptFullName & """", 0, False)
End If
Dim target 'define target ip
Dim result 'define ping result
target= "8.8.8.8" 'Archeage EU server IP (possibly Shatigon)
result = "Request timed out" 'Initial result
Dim Shell
Set Shell = WScript.CreateObject("WScript.Shell") 'create WScript shell
Dim count
count = 1
Do
Set shellexec = Shell.Exec("ping " & target) 'setting up the ping
result = LCase(shellexec.StdOut.ReadAll)
If InStr(1,result , "TTL=",1)> 0 Then
Shell.Run "sound.vbs",0,False
Exit Do
Else
WScript.Sleep 4000
count = count + 1
End If
Loop Until count > 2
Set Shell = Nothing
WScript.Quit
1-The first 3 line of code hide the popup of command line windows
2-exec the ping command have to done inside do loop not out so you will have second retry if first ping fail
3- Use TTL= instead of replay from (localhost or router can send replay from while target not reachable )
4- until > 2 not less than (infinity loop)

Open multiple .vbs one by one

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

Scripting MMC with vbscript

I would like to add a snap in via vbscript and I have been having a problem getting the snap in to add to the console. It will be run in a Windows 7 environment. If someone could have a look see and direct me in the right direction I would be most grateful. Thanks.
<code>
'Elevated privileges start
'Start of UAC workaround code
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If WScript.Arguments.length =0 Then
Set objShell = CreateObject("Shell.Application")
objShell.ShellExecute "wscript.exe", Chr(34) & _
WScript.ScriptFullName & Chr(34) & " uac", "", "runas", 1
Else
consoleName = "C:\Burnett.msc"
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(consoleName) Then
Wscript.Echo "console already exists"
Else
On Error Resume Next
Set objMMC = CreateObject("MMC20.Application")
If err.Number <> 0 Then
Wscript.Echo "an error occurred. unable to create mmc console"
Wscript.Quit(0)
End If
objMMC.Show
Set objDoc = objMMC.Document
objDoc.snapins.add("Local Computer\Non-Administrators")
if err then
'Trap the error just after the statement where an error/exception can occur and handle it elegantly
msgbox("Snap-in Not found")
err.clear
end if
objDoc.ActiveView.StatusBarText = "Pane 1|Pane 2|Pane 3"
objMMC.UserControl = 1
objDoc.Name = consoleName
objDoc.Save()
End If
Set fso = Nothing
End If
</code>
"Local Computer\Non-Administrators" is just a system-supplied description for the particular configuration of a snap-in. In this case, the actual snap-in name is "Group Policy Object Editor". Thus to eliminate the error in the code change
objDoc.snapins.add("Local Computer\Non-Administrators")
to
objDoc.snapins.add("Group Policy Object Editor")
Unfortunately, this will only get you as far as MMC putting up a "Select Group Policy Object" dialog. You will then have to manually select the configuration you need using that dialog. As far as I can tell there is no way to supply Snapins.Add with the parameters to select the local non-admin users.
The code below will fully automate the process of setting up the snap-in. However, its reliance on SendKeys makes it extremely brittle. It worked on my system, but there's a good chance you'll need to modify the sequence of key strokes and/or the timing delays to make it work on your system. And once you get it working, there's no guarantee it will continue to do so as local conditions are mutable and can greatly effect the timing.
option explicit
if WScript.Arguments.Named.Exists("elevated") = false then
'Launch the script again with UAC permissions
CreateObject("Shell.Application").ShellExecute "wscript.exe", """" & WScript.ScriptFullName & """ /elevated", "", "runas", 1
WScript.Quit
end if
Dim mmc : set mmc = WScript.CreateObject("MMC20.Application")
mmc.Show
mmc.UserControl = 1 'to keep MMC open
Dim oShell : set oShell = WScript.CreateObject("Wscript.Shell")
oShell.AppActivate "Console1"
WScript.Sleep 200
oShell.SendKeys "%f"
WScript.Sleep 200
oShell.SendKeys "m"
WScript.Sleep 400
oShell.SendKeys "group{TAB}{ENTER}"
WScript.Sleep 1000
oShell.SendKeys "{TAB}{ENTER}"
WScript.Sleep 1000
oShell.SendKeys "{TAB}{TAB}{TAB}{RIGHT}{TAB}Non{ENTER}"
WScript.Sleep 1000
oShell.SendKeys "{TAB}{TAB}{ENTER}"
WScript.Sleep 1000
oShell.SendKeys "{TAB}{TAB}{TAB}{TAB}{ENTER}"

VBScript to Notepad/Wordpad

I'd like to write output from VBScript to notepad/wordpad in realtime. What's the best way to do this? I'm aware of sendkeys, but it requires that I parse the input for special commands.
SendKeys is the only method for writing to a third-party application in realtime. Why don't you use CScript and write to the standard output instead? That is what it is meant for.
' Force the script to run in the CScript engine
If LCase(Right(WScript.FullName, 11)) <> "cscript.exe" Then
strPath = WScript.ScriptFullName
strCommand = "%comspec% /k cscript " & Chr(34) & strPath & chr(34)
CreateObject("WScript.Shell").Run(strCommand)
WScript.Quit
End If
For i = 1 to 10
For j = 0 to 25
WScript.StdOut.WriteLine String(j, " ") & "."
WScript.Sleep 50
Next
For j = 24 to 1 Step - 1
WScript.StdOut.WriteLine String(j, " ") & "."
WScript.Sleep 50
Next
Next
Try this
Const fsoForWriting = 2
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Open the text file
Dim objTextStream
Set objTextStream = objFSO.OpenTextFile("C:\SomeFile.txt", fsoForWriting, True)
'Display the contents of the text file
objTextStream.WriteLine "Hello, World!"
'Close the file and clean up
objTextStream.Close
Set objTextStream = Nothing
Set objFSO = Nothing

Resources