Is there any way to show windows 10 toast notification using vbscript? - vbscript

I'm trying to create and show notification in windows 10 using vbscript. i found a easy solution for mac, where i can easily show notification using this applescript
display notification "All graphics have been converted." with title "My Graphic Processing Script" subtitle "Processing is complete." sound name "Frog"
is there anything similar on windows for vbscript?

Here an example to show you how to write a .PS1 file (Powershell Script) and execute it from vbscript.
Option Explicit
Dim Ws,Ret,ByPassPSFile,PSFile
Set Ws = CreateObject("wscript.Shell")
ByPassPSFile = "cmd /c PowerShell.exe -ExecutionPolicy bypass -noprofile -file "
Call WritePSFile("Warning","10","'Please wait...'","' Scan is in progress....'","'Warning'","10")
Ret = Ws.run(ByPassPSFile & PSFile,0,True)
'------------------------------------------------------------------------------------------------------------
Sub WritePSFile(notifyicon,time,title,text,icon,Timeout)
Const ForWriting = 2
Dim fso,ts,strText
PSFile = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & "ps1"
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(PSFile,ForWriting,True)
strText = strText & "[reflection.assembly]::loadwithpartialname('System.Windows.Forms') | Out-Null;" & VbCrlF
strText = strText & "[reflection.assembly]::loadwithpartialname('System.Drawing') | Out-Null;" & VbCrlF
strText = strText & "$notify = new-object system.windows.forms.notifyicon;" & VbCrlF
strText = strText & "$notify.icon = [System.Drawing.SystemIcons]::"& notifyicon &";" & VbCrlF
strText = strText & "$notify.visible = $true;"
strText = strText & "$notify.showballoontip("& time &","& title &","& text &","& icon &");" & VbCrlF
strText = strText & "Start-Sleep -s " & Timeout &";" & VbCrlF
strText = strText & "$notify.Dispose()"
ts.WriteLine strText
End Sub
'------------------------------------------------------------------------------------------------------------
Edit :
Another example that can get your Public IP and your ISP and show them on the BallonTip.
Option Explicit
Dim Ws,Ret,ByPassPSFile,PSFile
Set Ws = CreateObject("wscript.Shell")
ByPassPSFile = "cmd /C PowerShell.exe -ExecutionPolicy bypass -noprofile -file "
Call WritePSFile(DblQuote("Warning"),"20",DblQuote("Public IP Information"),DblQuote(showIP),DblQuote("Warning"),"10")
Ret = Ws.run(ByPassPSFile & PSFile,0,True)
'------------------------------------------------------------------------------------------------------------
Sub WritePSFile(notifyicon,time,title,text,icon,Timeout)
Const ForWriting = 2
Dim fso,ts,strText
PSFile = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & "ps1"
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(PSFile,ForWriting,True)
strText = strText & "[reflection.assembly]::loadwithpartialname('System.Windows.Forms') | Out-Null;" & VbCrlF
strText = strText & "[reflection.assembly]::loadwithpartialname('System.Drawing') | Out-Null;" & VbCrlF
strText = strText & "$notify = new-object system.windows.forms.notifyicon;" & VbCrlF
strText = strText & "$notify.icon = [System.Drawing.SystemIcons]::"& notifyicon &";" & VbCrlF
strText = strText & "$notify.visible = $true;"
strText = strText & "$notify.showballoontip("& time &","& title &","& text &","& icon &");" & VbCrlF
strText = strText & "Start-Sleep -s " & Timeout &";" & VbCrlF
strText = strText & "$notify.Dispose()"
ts.WriteLine strText
End Sub
'------------------------------------------------------------------------------------------------------------
Function ShowIP()
Dim http,strJson,j,Info
Set http = CreateObject("Msxml2.XMLHTTP")
http.open "GET","http://ip-api.com/json/",False
http.send
strJson = http.responseText
Set j = Parse(strJson)
Info = Info & "IP="&j.query & vbCrLf &_
"ISP="&j.isp & vbCrLf &_
"Country="&j.country & vbCrLf &_
"City="&j.city
ShowIP = Info
End Function
'------------------------------------------------------------------------------------------------------------
Function Parse(strJson)
Dim html,window
Set html = CreateObject("htmlfile")
Set window = html.parentWindow
window.execScript "var json = " & strJson, "JScript"
Set Parse = window.json
End Function
'------------------------------------------------------------------------------------------------------------
Function DblQuote(Str)
DblQuote = chr(34) & Str & chr(34)
End function
'------------------------------------------------------------------------------------------------------------
Another way with vbscript without powershell but using the object CreateObject('Internet.HHCtrl').TextPopup
Option Explicit
Dim http,strJson,j,Info,HH
Set http = CreateObject("Msxml2.XMLHTTP")
http.open "GET","http://ip-api.com/json/",False
http.send
strJson = http.responseText
Set j = Parse(strJson)
Info = Info & "IP="&j.query & vbCrLf &_
"ISP="&j.isp & vbCrLf &_
"Country="&j.country & vbCrLf &_
"City="&j.city & vbCrLf &_
"TimeZone="&j.timezone & vbCrLf &_
"CountryCode="&j.countryCode & vbCrLf &_
"org="&j.org & vbCrLf &_
"AS="&j.as & vbCrLf &_
"Latitude="&j.lat & vbCrLf &_
"Longitude="&j.lon
Set HH = CreateObject("Internet.HHCtrl")
HH.TextPopup Info,"Verdana,12",12,12,12,12
WScript.Sleep 10000
Wscript.Quit()
'****************************************************************************
Function Parse(strJson)
Dim html,window
Set html = CreateObject("htmlfile")
Set window = html.parentWindow
window.execScript "var json = " & strJson, "JScript"
Set Parse = window.json
End Function
'****************************************************************************

Related

Checking Installed programs

I need help in finding installed software version, license etc.
the below script works fine but it lists out all the installed softwares.
But am trying to find out a particular software.It gives nice output, can you help me here.
==================================================
'This script outputs to a .tsv file a list of applications installed on the computer
'Output file is software.tsv
'Usage: cscript applications.vbs
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.CreateTextFile("C:\WINDOWS\system32\temp\software.tsv", True)
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colSoftware = objWMIService.ExecQuery _
("Select * from Win32_Product")
objTextFile.WriteLine "Caption" & vbtab & _
"Description" & vbtab & "Identifying Number" & vbtab & _
"Install Date" & vbtab & "Install Location" & vbtab & _
"Install State" & vbtab & "Name" & vbtab & _
"Package Cache" & vbtab & "SKU Number" & vbtab & "Vendor" & vbtab _
& "Version"
For Each objSoftware in colSoftware
objTextFile.WriteLine objSoftware.Caption & vbtab & _
objSoftware.Description & vbtab & _
objSoftware.IdentifyingNumber & vbtab & _
objSoftware.InstallDate2 & vbtab & _
objSoftware.InstallLocation & vbtab & _
objSoftware.InstallState & vbtab & _
objSoftware.Name & vbtab & _
objSoftware.PackageCache & vbtab & _
objSoftware.SKUNumber & vbtab & _
objSoftware.Vendor & vbtab & _
objSoftware.Version
Next
objTextFile.Close
======================================================
i just looking for details of C:\Program Files\HP\hponcfg\hponcfg.exe and i do not bother about other installed softwares, by default the above script gives the details of all the softwares, but i just do not need that.
where do i insert this line in the script.??
regards,
Dharanesh,
Check this modification, i tried it with name Google, so check it if retruns for you what do you expect or not ?
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set Ws = CreateObject("WScript.Shell")
LogFile = "software.tsv"
if objFSO.FileExists(LogFile) Then
objFSO.DeleteFile(LogFile)
End if
Set objTextFile = objFSO.OpenTextFile(LogFile,8,True)
MySoftware = "Google"
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colSoftware = objWMIService.ExecQuery _
("Select * from Win32_Product where Name Like " & CommandLineLike(MySoftware))
objTextFile.WriteLine "Caption" & vbtab & _
"Description" & vbtab & "Identifying Number" & vbtab & _
"Install Date" & vbtab & "Install Location" & vbtab & _
"Install State" & vbtab & "Name" & vbtab & _
"Package Cache" & vbtab & "SKU Number" & vbtab & "Vendor" & vbtab _
& "Version"
For Each objSoftware in colSoftware
objTextFile.WriteLine objSoftware.Caption & vbtab & _
objSoftware.Description & vbtab & _
objSoftware.IdentifyingNumber & vbtab & _
objSoftware.InstallDate2 & vbtab & _
objSoftware.InstallLocation & vbtab & _
objSoftware.InstallState & vbtab & _
objSoftware.Name & vbtab & _
objSoftware.PackageCache & vbtab & _
objSoftware.SKUNumber & vbtab & _
objSoftware.Vendor & vbtab & _
objSoftware.Version
Next
objTextFile.Close
ws.run "Notepad software.tsv"
'**************************************************************************
Function CommandLineLike(MySoftware)
MySoftware = Replace(MySoftware, "\", "\\")
CommandLineLike = "'%" & MySoftware & "%'"
End Function
'**************************************************************************
How to get the extended information of a file ?
For example this vbscript can get the extended information of Firefox.exe :
Option Explicit
Dim fso,ws,RootFolder,LogFile,stFolder,stFile,oShell,oFolder,oFile,i
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("WScript.Shell")
LogFile = Left(Wscript.ScriptFullName,InstrRev(Wscript.ScriptFullName, ".")) & "txt"
If fso.FileExists(LogFile) Then
fso.DeleteFile(LogFile)
End If
stFolder = Ws.ExpandEnvironmentStrings("%PROGRAMFILES%\Mozilla Firefox")
stFile ="firefox.exe"
Set oShell = CreateObject("Shell.Application")
Set oFolder = oShell.Namespace(stFolder)
Set oFile = oFolder.Items.Item(stFile)
'Displays extended file properties
For i = 0 to 34
WriteLog("[" & i & "] " & oFolder.GetDetailsOf(oFolder.Items, i ) & " : " & oFolder.GetDetailsOf(oFile, i))
Next
ws.run DblQuote(LogFile)
'*********************************************************************************************************************
Sub WriteLog(strText)
Dim fs,ts,LogFile
Const ForAppending = 8
LogFile = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & "txt"
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(LogFile,ForAppending,True)
ts.WriteLine strText
ts.Close
End Sub
'*********************************************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************************************
Or if you want to check the version of Firefox installed and if it is uptodate or not try this vbscript :
Option Explicit
Const ForWriting = 2
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
Dim RC , sPath, sNames, iTypes, sValue, objRegistry
Dim ROOT, i, j , msg, sKey, RC1, sKeyNames, fso, Fich
Set fso = CreateObject("Scripting.FileSystemObject")
Set Fich = fso.OpenTextFile("Version.txt", ForWriting, true)
Dim shell : Set shell = CreateObject("WScript.Shell")
sPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
ROOT = HKEY_LOCAL_MACHINE
Dim OK
OK = False
Set objRegistry = GetObject("WinMgmts:root\default:StdRegProv")
RC1 = objRegistry.EnumKey(ROOT, sPath, sKeyNames)
If (RC1 = 0) And (Err.Number = 0) And Not IsEmpty(sKeyNames) Then
For j = LBound(sKeyNames) To UBound(sKeyNames)
RC = objRegistry.EnumValues(ROOT, sPath & sKeyNames(j), sNames, iTypes)
If (RC = 0) And (Err.Number = 0) And IsArray(sNames) Then
If VerifTypes(ROOT, sPath & sKeyNames(j), iTypes) And OK Then Fich.WriteLine vbNewLine & sKeyNames(j) & " : "
For i = LBound(iTypes) To UBound(iTypes)
If iTypes(i) = REG_SZ Then
RC = objRegistry.GetStringValue(ROOT , sPath & sKeyNames(J), sNames(i), sValue)
If (LCase(sNames(i)) = "displayname" And sValue <> "") Or (LCase(sNames(i)) = "displayversion" And sValue <> "") Then
If InStr(1,LCase(sValue),"firefox") > 0 Then
msg = msg & sNames(i) & " = " & sValue
OK = True
MsgBox sValue & VbcrLf & "La version installée du soft Firefox est : "& ExtractVersion(sValue),64,"La Version installée du Soft Firefox"
Dim MyVer,NetVersion,URL,ws
MyVer = ExtractVersion(sValue)
URL = "http://www.mozilla.org/fr/firefox/new/"
NetVersion = GetFirefoxMajorVersion(URL)
msgbox NetVersion
If CompareVersions(MyVer,NetVersion) = -1 Then
MsgBox "La dernière version de Firefox est : " & NetVersion & VbCrlf &_
"Il y a une mise à jour en ligne !",48,"Il y a une mise à jour en ligne ! "
set ws = CreateObject("WScript.Shell")
ws.run URL
Else
MsgBox "Firefox est à jour !",64,"Firefox est à jour !"
end if
Fich.Write msg & vbNewLine & "La version installée du soft Firefox est : "& ExtractVersion(sValue) & vbNewLine
End If
End If
OK = False
End If
msg = ""
Next ' pour i
'MsgBox msg
Else
'Msgbox "L'erreur suivante est survenue : " & Err.Description
End If
Next ' pour J
Fich.Close
End If
Shell.run "version.txt"
'******************************************************************************************************************
Function Lsh(ByVal N, ByVal Bits)
Lsh = N * (2 ^ Bits)
End Function
'***************************************************************************************
Function VerifTypes(ROOT, strPath, Types)
' Cette fonction vérifie si la clé (strPath) contient des valeurs
' "DisplayVersion" ou "DisplayName" et qui ne sont pas être vides
' pour ne pas retourner celles qui n'en contiennent pas.
Dim Ret, strNames, Verif, ind
Verif = False
Ret = objRegistry.EnumValues(ROOT, strPath,strNames, Types)
If (Ret = 0) And (Err.Number = 0) And IsArray(strNames) Then
For ind = LBound(strNames) To UBound(strNames)
If LCase(strNames(ind)) = "displayname" Or LCase(strNames(ind)) = "displayversion" Then
Verif = True
Exit For
ELse
Verif = False
End If
Next
End If
VerifTypes = Verif
End Function
'***************************************************************************************
Function ExtractVersion(Data)
Dim objRegex,Match,Matches
Set objRegex = new RegExp
objRegex.Pattern = "\d{2}\.\d"
objRegex.Global = False
objRegex.IgnoreCase = True
Set Matches = objRegex.Execute(Data)
For Each Match in Matches
ExtractVersion = Match.Value
Next
End Function
'***************************************************************************************
Function GetVersionStringAsArray(ByVal Version)
Dim VersionAll, VersionParts, N
VersionAll = Array(0, 0, 0, 0)
VersionParts = Split(Version, ".")
For N = 0 To UBound(VersionParts)
VersionAll(N) = CLng(VersionParts(N))
Next
Dim Hi, Lo
Hi = Lsh(VersionAll(0), 16) + VersionAll(1)
Lo = Lsh(VersionAll(2), 16) + VersionAll(3)
GetVersionStringAsArray = Array(Hi, Lo)
End Function
'***************************************************************************************
' Compares two versions "a.b.c.d". If Version1 < Version2,
' returns -1. If Version1 = Version2, returns 0.
' If Version1 > Version2, returns 1.
Function CompareVersions(ByVal Version1, ByVal Version2)
Dim Ver1, Ver2, Result
Ver1 = GetVersionStringAsArray(Version1)
Ver2 = GetVersionStringAsArray(Version2)
If Ver1(0) < Ver2(0) Then
Result = -1
ElseIf Ver1(0) = Ver2(0) Then
If Ver1(1) < Ver2(1) Then
Result = -1
ElseIf Ver1(1) = Ver2(1) Then
Result = 0
Else
Result = 1
End If
Else
Result = 1
End If
CompareVersions = Result
End Function
'***************************************************************************************
Function GetFirefoxMajorVersion(URL)
Dim Titre,ie,objFSO,Data,OutPut,objRegex,Match,Matches
Titre = "La dernière version de Firefox"
Set ie = CreateObject("InternetExplorer.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
ie.Navigate(URL)
ie.Visible=False
DO WHILE ie.busy
Wscript.Sleep 100
Loop
Data = ie.document.documentElement.innerHTML
Set objRegex = new RegExp
objRegex.Pattern = "\d{2}\.\d"
objRegex.Global = True
objRegex.IgnoreCase = True
Set Matches = objRegex.Execute(Data)
For Each Match in Matches
GetFirefoxMajorVersion = Match.Value
Next
ie.Quit
Set ie = Nothing
End Function
'***************************************************************************************
Here is another way to get FileVersion of Firefox.exe using Powershell and Vbscript
GetFileDetailsFirefox.vbs
Option Explicit
Dim MyCmd,Ws,Ret,ByPassPSFile,PSFile,PathFile,OutPut
Set Ws = CreateObject("wscript.Shell")
PathFile = Ws.ExpandEnvironmentStrings("%ProgramFiles%") & "\Mozilla Firefox\Firefox.exe"
OutPut = Ws.ExpandEnvironmentStrings("%Temp%") & "\firefox_version.txt"
PSFile = Left(Wscript.ScriptFullName,InstrRev(Wscript.ScriptFullName, ".")) & "ps1"
ByPassPSFile = "cmd /c PowerShell.exe -ExecutionPolicy bypass -noprofile -file "
MyCmd = "Get-ChildItem "& DblQuote(PathFile) &" | Get-ItemProperty | Select VersionInfo | Format-List > " & OutPut &""
Call WriteLog(MyCmd)
Ret = Ws.run(ByPassPSFile & PSFile,0,True)
ws.run DblQuote(OutPut)
'**********************************************************************************************
Sub WriteLog(strText)
Dim fs,ts,PSFile
Const ForWriting = 2
PSFile = Left(Wscript.ScriptFullName,InstrRev(Wscript.ScriptFullName, ".")) & "ps1"
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(PSFile,ForWriting,True)
ts.WriteLine strText
ts.Close
End Sub
'**********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'***********************************************************************************************

how to create a VB script file without a pop up window

I googled a code that works just as I wanted,
But when I schedule it in task manager issue occurs ..after every pop up screen i need to click ok..then only the file gets updated.Please let me know what changes are to be done so that after running VBS it silently updates the file.
actual code:
source:http://www.wisesoft.co.uk/scripts/vbscript_disk_space_usage_report.aspx
OPTION EXPLICIT
CONST strComputer = "."
CONST strReport = "D:\diskspace.txt"
DIM objWMIService, objItem, colItems
DIM strDriveType, strDiskSize, txt
SET objWMIService = GETOBJECT("winmgmts:\\" & strComputer & "\root\cimv2")
SET colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk WHERE DriveType=3")
txt = "Drive" & vbtab & "Size" & vbtab & "Used" & vbtab & "Free" & vbtab & "Free(%)" & vbcrlf
FOR EACH objItem in colItems
DIM pctFreeSpace,strFreeSpace,strusedSpace
pctFreeSpace = INT((objItem.FreeSpace / objItem.Size) * 1000)/10
strDiskSize = Int(objItem.Size /1073741824) & "Gb"
strFreeSpace = Int(objItem.FreeSpace /1073741824) & "Gb"
strUsedSpace = Int((objItem.Size-objItem.FreeSpace)/1073741824) & "Gb"
txt = txt & objItem.Name & vbtab & strDiskSize & vbtab & strUsedSpace & vbTab & strFreeSpace & vbtab & pctFreeSpace & vbcrlf
NEXT
writeTextFile txt, strReport
wscript.echo "Report written to " & strReport & vbcrlf & vbcrlf & txt
' Procedure to write output to a text file
PRIVATE SUB writeTextFile(BYVAL txt,BYVAL strTextFilePath)
DIM objFSO,objTextFile
SET objFSO = CREATEOBJECT("Scripting.FileSystemObject")
SET objTextFile = objFSO.CreateTextFile(strTextFilePath)
objTextFile.Write(txt)
objTextFile.Close
SET objTextFile = NOTHING
END SUB
Call the script with cscript script_file.vbs instead of wscript script_file.vbs.
Popup massage genarated by wscript.echo if you delete that line, code will run silently
wscript.echo "Report written to " & strReport & vbcrlf & vbcrlf & txt

VB script to check if the file size has been increased from the previous check

i need a VB script that checks the file size and captures it and in the next check it compares it with the previous check. If the size has increased, it should prompt File size increased.
You can give a try to this vbscript :
Option Explicit
const bytesToKb = 1024
Dim strFile,Title
Title = "The File Size Checker by Hackoo 2015"
strFile = "C:\test.txt"
Call CheckSize(strFile)
'*****************************************************************
Sub CheckSize(File)
Dim ws,fso,objFile,ReadSize,WriteSize,MySizeFile,Temp,LastSize
Set ws = CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
MySizeFile = Temp & "\MyFileSize.txt"
If Not fso.FileExists(MySizeFile) Then
Set WriteSize = fso.OpenTextFile(MySizeFile,2,True)
set objFile = fso.GetFile(strFile)
WriteSize.Write objFile.Size
End If
Set ReadSize = fso.OpenTextFile(MySizeFile,1)
LastSize = ReadSize.readall
set objFile = fso.GetFile(strFile)
If CLng(objFile.Size) = CLng(LastSize) Then
MsgBox "There is no change on file size : " & CLng(LastSize) & " bytes" & vbcr &_
"Size in Kb : "& CLng(objFile.Size/bytesToKb) & " Kb",VbInformation,Title
else
Set WriteSize = fso.OpenTextFile(MySizeFile,2,True)
MsgBox "Last File Size is : " & CLng(LastSize) & " bytes" & vbcr &_
"New File Size is : " & objFile.Size & " bytes" & vbcr &_
"Size in Kb : "& CLng(objFile.Size/bytesToKb) & " Kb",VbExclamation,Title
WriteSize.Write objFile.Size
end if
End Sub
'*******************************************************************
I improved a little this script to check every minute in a loop if the size was changed or not, if yes it will popup a msgbox to notify you that size was changed, if no, it sleeps for 1 minute and it checks it again.
Option Explicit
const bytesToKb = 1024
Dim strFile,Title
Title = "The File Size Checker by Hackoo 2015"
strFile = "C:\test.txt"
If AppPrevInstance() Then
MsgBox "There is an existing proceeding",VbExclamation,"There is an existing proceeding"
WScript.Quit
Else
Do
Call CheckSize(strFile)
Loop
End If
'*****************************************************************
Sub CheckSize(File)
Dim ws,fso,objFile,ReadSize,WriteSize,MySizeFile,Temp,LastSize
Set ws = CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
MySizeFile = Temp & "\MyFileSize.txt"
If Not fso.FileExists(MySizeFile) Then
Set WriteSize = fso.OpenTextFile(MySizeFile,2,True)
set objFile = fso.GetFile(strFile)
WriteSize.Write objFile.Size
End If
Set ReadSize = fso.OpenTextFile(MySizeFile,1)
LastSize = ReadSize.readall
set objFile = fso.GetFile(strFile)
If CLng(objFile.Size) = CLng(LastSize) Then
Call Pause(1) 'To sleep for 1 minute
else
Set WriteSize = fso.OpenTextFile(MySizeFile,2,True)
MsgBox strFile & vbcr &"Last Size is : " & CLng(LastSize) & " bytes" & vbcr &_
"New Size is : " & objFile.Size & " bytes" & vbcr &_
"Size in Kb : "& CLng(objFile.Size/bytesToKb) & " Kb",VbExclamation,Title
WriteSize.Write objFile.Size
end if
End Sub
'**************************************************************************
'Checks whether a script with the same name as this script is already running
Function AppPrevInstance()
With GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
With .ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE " & CommandLineLike(WScript.ScriptFullName) & _
" AND CommandLine LIKE '%WScript%' OR CommandLine LIKE '%cscript%'")
AppPrevInstance = (.Count > 1)
End With
End With
End Function
'**************************************************************************
Function CommandLineLike(ProcessPath)
ProcessPath = Replace(ProcessPath, "\", "\\")
CommandLineLike = "'%" & ProcessPath & "%'"
End Function
'**************************************************************************
Sub Pause(Minutes)
Wscript.Sleep(Minutes*1000*60)
End Sub
'**************************************************************************
Here is another approch that can monitor and check more than one file in changing size :
Option Explicit
const bytesToKb = 1024
Dim Title,strFile,ListFiles
Title = "The File Size Checker by Hackoo 2015"
ListFiles = Array("c:\test.txt","E:\My test dossier\t.txt","E:\My test dossier\TmpLog.txt")
If AppPrevInstance() Then
MsgBox "There is an existing proceeding",VbExclamation,"There is an existing proceeding"
WScript.Quit
Else
Do
Call Main(ListFiles)
Call Pause(1) 'To Sleep for 1 minute
Loop
End If
'******************************************************************
Sub Main(strFilesPaths)
Dim strFile
For Each strFile In strFilesPaths
CheckSize(strFile)
Next
End Sub
'******************************************************************
Function StripPath(Path)
Dim arrStr : arrStr = Split(Path,"\")
StripPath = arrStr(UBound(arrStr))
End Function
'*****************************************************************
Sub CheckSize(File)
Dim ws,fso,objFile,ReadSize,WriteSize,MySizeFile,Temp,LastSize,strFile
Set ws = CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
For Each strFile In ListFiles
MySizeFile = Temp & "\" & StripPath(strFile)
If Not fso.FileExists(MySizeFile) Then
Set WriteSize = fso.OpenTextFile(MySizeFile,2,True)
set objFile = fso.GetFile(strFile)
WriteSize.Write objFile.Size
End If
Set ReadSize = fso.OpenTextFile(MySizeFile,1)
LastSize = ReadSize.readall
set objFile = fso.GetFile(strFile)
If CLng(objFile.Size) = CLng(LastSize) Then
else
Set WriteSize = fso.OpenTextFile(MySizeFile,2,True)
MsgBox strFile & vbcr &"Last Size is : " & CLng(LastSize) & " bytes" & vbcr &_
"New Size is : " & objFile.Size & " bytes" & vbcr &_
"Size in Kb : "& CLng(objFile.Size/bytesToKb) & " Kb",VbExclamation,Title
WriteSize.Write objFile.Size
end if
Next
End Sub
'**************************************************************************
'Checks whether a script with the same name as this script is already running
Function AppPrevInstance()
With GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
With .ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE " & CommandLineLike(WScript.ScriptFullName) & _
" AND CommandLine LIKE '%WScript%' OR CommandLine LIKE '%cscript%'")
AppPrevInstance = (.Count > 1)
End With
End With
End Function
'**************************************************************************
Function CommandLineLike(ProcessPath)
ProcessPath = Replace(ProcessPath, "\", "\\")
CommandLineLike = "'%" & ProcessPath & "%'"
End Function
'**************************************************************************
Sub Pause(Minutes)
Wscript.Sleep(Minutes*1000*60)
End Sub
'**************************************************************************

VBScript - skip and read lines in text file

Would you be able to help me figure out/make pretty my code?
I have a file I need to edit and save some of it to next file. Saving is not an issue here, only editing.
I need to skip 2 lines and read next 30 or so to memory. Until now I've been using:
Const ForReading = 1
Const ForWriting = 2
set WshShell = WScript.CreateObject("WScript.Shell")
strMyDocs = WshShell.SpecialFolders("MyDocuments")
strDesktop = WshShell.SpecialFolders("Desktop")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDesktop & "\folder\blabla.vbs", ForReading)
strText = objFile.SkipLine & objFile.SkipLine
strText = objFile.ReadLine & vbNewLine & objFile.ReadLine & vbNewLine &
objFile.ReadLine & vbNewLine & objFile.ReadLine & vbNewLine & objFile.ReadLine &
vbNewLine & objFile.ReadLine & vbNewLine &_
objFile.ReadLine & vbNewLine & objFile.ReadLine & vbNewLine & objFile.ReadLine &
vbNewLine & objFile.ReadLine & vbNewLine & objFile.ReadLine & vbNewLine &
objFile.ReadLine & vbNewLine & objFile.ReadLine & vbNewLine &_
objFile.ReadLine & vbNewLine & objFile.ReadLine & vbNewLine & objFile.ReadLine &
vbNewLine & objFile.ReadLine & vbNewLine & objFile.ReadLine & vbNewLine &
objFile.ReadLine & vbNewLine & objFile.ReadLine & vbNewLine &_
objFile.ReadLine & vbNewLine & objFile.ReadLine & vbNewLine & objFile.ReadLine &
vbNewLine & objFile.ReadLine & vbNewLine & objFile.ReadLine & vbNewLine &
objFile.ReadLine & vbNewLine & objFile.ReadLine & vbNewLine & objFile.ReadLine
objFile.Close
...
As you can see it looks pretty lame, it does the job though.
I was able to find something to replace skilLine part:
For a = 1 to 30
If ((a =< 2) And (ObjFile.AtEndOfStream <> True)) Then
objFile.SkipLine
Do Until a = 30
objFile.ReadLine
Loop
Else
objFile.Close
End If
but cannot find a way to read next 28lines. I tried a lot and it always reads 28 lines but starting with line 31, not 3.
Could you help me?
Thanks
Here's another way.
' Read all lines into an array...
a = Split(objFSO.OpenTextFile(strDesktop & "\folder\blabla.vbs", ForReading).ReadAll, vbCrLf)
' Start with the 3rd line and read 28 lines (if available)...
For i = 2 To 29
If UBound(a) >= i Then strText = strText & a(i) & vbCrLf
Next
Does this work? Note the addition of the Do Until loop.
Const ForReading = 1
Const ForWriting = 2
set WshShell = WScript.CreateObject("WScript.Shell")
strMyDocs = WshShell.SpecialFolders("MyDocuments")
strDesktop = WshShell.SpecialFolders("Desktop")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDesktop & "\folder\blabla.vbs", ForReading)
objfile.SkipLine
objfile.SkipLine
Dim strText
Do Until objFile.AtEndOfStream
If(Len(strText) > 0) Then strText = strText & vbNewLine
strText = strText & objFile.ReadLine
Loop
objFile.Close
This will read a line if the rowcount is greater than 2 or less than 30, else it will skip the line, you can then do something with that line in strText
rowcount = 1
Do While NOT objFile.AtEndOfStream
if((rowcount > 2) And (rowcount < 30))Then
strText = objTextFile.Readline
'or strText = strText & vbCrLf & objTextFile.Readline
Else
strText = objTextFile.SkipLine
End If
rowcount = rowcount + 1
Loop

attempting to run multiple scripts, have them all output to one file, and all use the same IP address

I have a couple questions and am hoping this is the correct place.
basically what i want to do is to be able to remotely get info about a domain computer.
i have 3 seperate scripts that give me 1( IP configuration, comp name ... ), 2 ( installed software ) and 3 ( mapped drives ).
the first two ask for the IP/computer name and the 3rd i have to input that into the script... i would like to only have to input the IP address once and have it work for all 3
secondly i would like the output file that this info is put into to be named like the installed software script does and then just have the other two scripts add ( ammend ) to the already created output.
I am super new to vbs so any help would be awesome
SCRIPT 1 ( gets IP configuration )
dim strComputer 'for computer name or IP
dim colAdapters 'collection of adapters
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("output.txt", True)
strComputer = ""
'open a dialog box asking for the computer name/IP
do
strComputer = inputbox( "Please enter a computername/IP, or . for local computer", "Input" )
Loop until strComputer <> "" 'run until a name/IP is entered
Set objWMIService = GetObject ("winmgmts:" & "!\\" & strComputer & "\root\cimv2") 'open the WMI service on the remote PC
Set colAdapters = objWMIService.ExecQuery ("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = True")
'go through the list of adapters and gather data
For Each objAdapter in colAdapters
objFile.Writeline "Host name: " & objAdapter.DNSHostName
objFile.Writeline "DNS domain: " & objAdapter.DNSDomain
objFile.Writeline "DNS suffix search list: " & objAdapter.DNSDomainSuffixSearchOrder
objFile.Writeline "Description: " & objAdapter.Description
objFile.Writeline "Physical address: " & objAdapter.MACAddress
objFile.Writeline "DHCP enabled: " & objAdapter.DHCPEnabled
If Not IsNull(objAdapter.IPAddress) Then
For i = LBound(objAdapter.IPAddress) To UBound(objAdapter.IPAddress)
objFile.Writeline "IP address: " & objAdapter.IPAddress(i)
Next
End If
If Not IsNull(objAdapter.IPSubnet) Then
For i = LBound(objAdapter.IPSubnet) To UBound(objAdapter.IPSubnet)
objFile.Writeline "Subnet: " & objAdapter.IPSubnet(i)
Next
End If
If Not IsNull(objAdapter.DefaultIPGateway) Then
For i = LBound(objAdapter.DefaultIPGateway) To UBound(objAdapter.DefaultIPGateway)
objFile.Writeline "Default gateway: " & objAdapter.DefaultIPGateway(i)
Next
End If
objFile.Writeline "DHCP server: " & objAdapter.DHCPServer
If Not IsNull(objAdapter.DNSServerSearchOrder) Then
For i = LBound(objAdapter.DNSServerSearchOrder) To UBound(objAdapter.DNSServerSearchOrder)
objFile.Writeline "DNS server: " & objAdapter.DNSServerSearchOrder(i)
Next
End If
objFile.Writeline "Primary WINS server: " & objAdapter.WINSPrimaryServer
objFile.Writeline "Secondary WINS server: " & objAdapter.WINSSecondaryServer
objFile.Writeline "Lease obtained: " & objAdapter.DHCPLeaseObtained
objFile.Writeline "Lease expires: " & objAdapter.DHCPLeaseExpires
Next
SCRIPT 2 ( gets installed software )
Option Explicit
Dim sTitle
sTitle = "InstalledPrograms.vbs by Bill James"
Dim StrComputer
strComputer = InputBox("Enter I.P. or name of computer to check for " & _
"installed software (leave blank to check " & _
"local system)." & vbcrlf & vbcrlf & "Remote " & _
"checking only from NT type OS to NT type OS " & _
"with same Admin level UID & PW", sTitle)
If IsEmpty(strComputer) Then WScript.Quit
strComputer = Trim(strComputer)
If strComputer = "" Then strComputer = "."
'Wscript.Echo GetAddRemove(strComputer)
Dim sCompName : sCompName = GetProbedID(StrComputer)
Dim sFileName
sFileName = sCompName & "_" & GetDTFileName() & "_Software.txt"
Dim s : s = GetAddRemove(strComputer)
If WriteFile(s, sFileName) Then
'optional prompt for display
If MsgBox("Finished processing. Results saved to " & sFileName & _
vbcrlf & vbcrlf & "Do you want to view the results now?", _
4 + 32, sTitle) = 6 Then
WScript.CreateObject("WScript.Shell").Run sFileName, 9
End If
End If
Function GetAddRemove(sComp)
'Function credit to Torgeir Bakken
Dim cnt, oReg, sBaseKey, iRC, aSubKeys
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
sComp & "/root/default:StdRegProv")
sBaseKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
iRC = oReg.EnumKey(HKLM, sBaseKey, aSubKeys)
Dim sKey, sValue, sTmp, sVersion, sDateValue, sYr, sMth, sDay
For Each sKey In aSubKeys
iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, "DisplayName", sValue)
If iRC <> 0 Then
oReg.GetStringValue HKLM, sBaseKey & sKey, "QuietDisplayName", sValue
End If
If sValue <> "" Then
iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, _
"DisplayVersion", sVersion)
If sVersion <> "" Then
sValue = sValue & vbTab & "Ver: " & sVersion
Else
sValue = sValue & vbTab
End If
iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, _
"InstallDate", sDateValue)
If sDateValue <> "" Then
sYr = Left(sDateValue, 4)
sMth = Mid(sDateValue, 5, 2)
sDay = Right(sDateValue, 2)
'some Registry entries have improper date format
On Error Resume Next
sDateValue = DateSerial(sYr, sMth, sDay)
On Error GoTo 0
If sdateValue <> "" Then
sValue = sValue & vbTab & "Installed: " & sDateValue
End If
End If
sTmp = sTmp & sValue & vbcrlf
cnt = cnt + 1
End If
Next
sTmp = BubbleSort(sTmp)
GetAddRemove = "INSTALLED SOFTWARE (" & cnt & ") - " & sCompName & _
" - " & Now() & vbcrlf & vbcrlf & sTmp
End Function
Function BubbleSort(sTmp)
'cheapo bubble sort
Dim aTmp, i, j, temp
aTmp = Split(sTmp, vbcrlf)
For i = UBound(aTmp) - 1 To 0 Step -1
For j = 0 to i - 1
If LCase(aTmp(j)) > LCase(aTmp(j+1)) Then
temp = aTmp(j + 1)
aTmp(j + 1) = aTmp(j)
aTmp(j) = temp
End if
Next
Next
BubbleSort = Join(aTmp, vbcrlf)
End Function
Function GetProbedID(sComp)
Dim objWMIService, colItems, objItem
Set objWMIService = GetObject("winmgmts:\\" & sComp & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select SystemName from " & _
"Win32_NetworkAdapter",,48)
For Each objItem in colItems
GetProbedID = objItem.SystemName
Next
End Function
Function GetDTFileName()
dim sNow, sMth, sDay, sYr, sHr, sMin, sSec
sNow = Now
sMth = Right("0" & Month(sNow), 2)
sDay = Right("0" & Day(sNow), 2)
sYr = Right("00" & Year(sNow), 4)
sHr = Right("0" & Hour(sNow), 2)
sMin = Right("0" & Minute(sNow), 2)
sSec = Right("0" & Second(sNow), 2)
GetDTFileName = sMth & sDay & sYr & "_" & sHr & sMin & sSec
End Function
Function WriteFile(sData, sFileName)
Dim fso, OutFile, bWrite
bWrite = True
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set OutFile = fso.OpenTextFile(sFileName, 2, True)
'Possibly need a prompt to close the file and one recursion attempt.
If Err = 70 Then
Wscript.Echo "Could not write to file " & sFileName & ", results " & _
"not saved." & vbcrlf & vbcrlf & "This is probably " & _
"because the file is already open."
bWrite = False
ElseIf Err Then
WScript.Echo err & vbcrlf & err.description
bWrite = False
End If
On Error GoTo 0
If bWrite Then
OutFile.WriteLine(sData)
OutFile.Close
End If
Set fso = Nothing
Set OutFile = Nothing
WriteFile = bWrite
End Function
SCRIPT 3 ( gets mapped drives )
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("mappedoutput.txt", True)
' List Mapped Network Drives
On Error Resume Next
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_MappedLogicalDisk")
For Each objItem in colItems
objFile.Writeline "Compressed: " & objItem.Compressed
objFile.Writeline "Description: " & objItem.Description
objFile.Writeline "Device ID: " & objItem.DeviceID
objFile.Writeline "File System: " & objItem.FileSystem
objFile.Writeline "Free Space: " & objItem.FreeSpace
objFile.Writeline "Maximum Component Length: " & objItem.MaximumComponentLength
objFile.Writeline "Name: " & objItem.Name
objFile.Writeline "Provider Name: " & objItem.ProviderName
objFile.Writeline "Session ID: " & objItem.SessionID
objFile.Writeline "Size: " & objItem.Size
objFile.Writeline "Supports Disk Quotas: " & objItem.SupportsDiskQuotas
objFile.Writeline "Supports File-Based Compression: " & _
objItem.SupportsFileBasedCompression
objFile.Writeline "Volume Name: " & objItem.VolumeName
objFile.Writeline "Volume Serial Number: " & objItem.VolumeSerialNumber
objFile.Writeline
Next
Again thank you
Can you put all the three scripts as 1 single script? In that case, you will need to input the IP address only once.
Or else write another script which will ask for the IP address and call these scripts by using cscript and passing the IPaddress to them as a parameter. Try this code for that:
strcomputer = inputbox("Enter the IP address")
set obj1 = createobject("wscript.shell")
set obj2 = createobject("wscript.shell")
set obj3 = createobject("wscript.shell")
pgm1 = "cscript script1.vbs " & strcomputer
pgm2 = "cscript script2.vbs " & strcomputer
pgm3 = "cscript script3.vbs " & strcomputer
obj1.run pgm1,3,true
obj2.run pgm2,3,true
obj3.run pgm3,3,true
set obj1 = nothing
set obj2 = nothing
set obj3 = nothing
In above code, script1.vbs, script2.vbs, script3.vbs are your 3 scripts and you are executing them one by one using a new script.
In script1.vbs, add this line of code :
strcomputer = wscript.Arguments.item(0)
It will store the 1rst argument that you have passed from your new script to script1.vbs, into the variable 'strcomputer'(in your case, the IP address).
Similarly, in both script2.vbs and script3.vbs also, add the statement
strcomputer = wscript.Arguments.item(0)
Regarding your output file, I am not sure what you are asking for. Maybe this can help:
Use the below to write to a file (overwrites if data is already present):
Set fso1 = CreateObject("Scripting.FileSystemObject" )
Set file1 = fso1.OpenTextFile("C:\New\textfile1.txt",2,true)
Use the below to add data or append to a file (does NOT overwrite):
Set fso1 = CreateObject("Scripting.FileSystemObject" )
Set file1 = fso1.OpenTextFile("C:\New\textfile1.txt",8,true)
Use the below to read from a file:
Set fso1 = CreateObject("Scripting.FileSystemObject" )
Set file1 = fso1.OpenTextFile("C:\New\textfile1.txt",1,true)

Resources