How to check if command prompt/window is open using VB Script?
I am using Visual Studio 2010 - Setup Project, and I want my VB Script to check if the command line is closed, and when it's closed, it will raise an error and terminate the whole installation.
class Win32_ProcessStartTrace : Win32_ProcessTrace
{
uint4 PageDirectoryBase;
string ParentProcessName;
uint32 ProcessID;
string ProcessName;
uint8 SECURITY_DESCRIPTOR[];
uint32 SessionID;
uint8 Sid[];
uint8 TIME_CREATED;
};
This monitors starts and stops. Above properties is from starts only and same properties as below object. Also there is a stop object. My code can only do one event, there's an alternative that can do multi events but you have to set up event handlers.
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
Set objEvents = objWMIService.ExecNotificationQuery _
("SELECT * FROM Win32_ProcessTrace")
Do
Set objReceivedEvent = objEvents.NextEvent
msgbox objReceivedEvent.ProcessName
Loop
You can get extra info from the Process class.
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_Process")
For Each objItem in colItems
'Get process id you want from other script
If obj.ProcessID = 1004 Then
msgbox objItem.ProcessID & " " & FormatDateTime(CDate(objItem.CreationDate))
EndIf
Next
These are it's properties. It also has methods.
class Win32_Process : CIM_Process
{
string Caption;
string CommandLine;
string CreationClassName;
datetime CreationDate;
string CSCreationClassName;
string CSName;
string Description;
string ExecutablePath;
uint16 ExecutionState;
string Handle;
uint32 HandleCount;
datetime InstallDate;
uint64 KernelModeTime;
uint32 MaximumWorkingSetSize;
uint32 MinimumWorkingSetSize;
string Name;
string OSCreationClassName;
string OSName;
uint64 OtherOperationCount;
uint64 OtherTransferCount;
uint32 PageFaults;
uint32 PageFileUsage;
uint32 ParentProcessId;
uint32 PeakPageFileUsage;
uint64 PeakVirtualSize;
uint32 PeakWorkingSetSize;
uint32 Priority;
uint64 PrivatePageCount;
uint32 ProcessId;
uint32 QuotaNonPagedPoolUsage;
uint32 QuotaPagedPoolUsage;
uint32 QuotaPeakNonPagedPoolUsage;
uint32 QuotaPeakPagedPoolUsage;
uint64 ReadOperationCount;
uint64 ReadTransferCount;
uint32 SessionId;
string Status;
datetime TerminationDate;
uint32 ThreadCount;
uint64 UserModeTime;
uint64 VirtualSize;
string WindowsVersion;
uint64 WorkingSetSize;
uint64 WriteOperationCount;
uint64 WriteTransferCount;
};
Her's a sample script from Help showing how to do multiple events handlers.
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & _
strComputer & "\root\CIMV2")
Set EventSink = WScript.CreateObject( _
"WbemScripting.SWbemSink","SINK_")
objWMIservice.ExecNotificationQueryAsync EventSink, _
"SELECT * FROM Win32_ProcessTrace WITHIN 10"
WScript.Echo "Waiting for events..."
i = 0
While (True)
Wscript.Sleep(1000)
Wend
Sub SINK_OnObjectReady(objObject, objAsyncContext)
Wscript.Echo "Win32_ProcessTrace event has occurred."
i = i+1
If i = 3 Then WScript.Quit 0
End Sub
Related
I get an hresult 0x800a01b6 on the seccond passing of my code.
When it runs the first time it works but fails seccond time around. IE opens then program stops.
Dim pID As String
Dim mesg As String
Dim pw As String
Dim Id As String
Dim ie As Object
Dim l As String
'For Each Id In ListBox2.Items'
For i As Integer = 0 To Me.ListBox2.Items.Count - 1
Id = Me.ListBox2.Items(i).ToString
If Id = "me " Then
Id = "466901"
ElseIf "you" Then
Id = "466942"
End If
ie = CreateObject("InternetExplorer.Application")
ie.Navigate("http://www.webpage.com.au/")
ie.Visible = True
mesg = TextBox1.Text.ToString()
pw = "....."
ie.Document.All("password").Value = pw
ie.Document.All("idpagers").Value = Id
ie.Document.All("message").Value = mesg
ie.Document.All("Send").Click()
pID = ie.Document.All().ToString
'MessageBox.Show(pID)
MessageBox.Show(l & mesg & pw, "Test")'
Next
End Sub
I am trying to find a string in the list of shared folder names in an IP address in VBA.
The below routine works for folders but does not work. The error it says is Err-76, path not found.
could any one tell me how to access shared folder names in an IP address.
Sub findfolder()
Dim myFolder As Folder
Dim objfile As Object
Dim subfolder As Object
Dim FSO As New FileSystemObject
Dim txt As String
Dim strname As String
txt = "\\10.4.32.33"
'spath = GetFolder(txt)
strname = InputBox(Prompt:="You Search String please.", _
Title:="ENTER SEARCH STRING", Default:="Your Search String here")
Set myFolder = FSO.GetFolder(txt)
For Each subfolder In myFolder.SubFolders
cnt = 0
If (InStr(LCase(subfolder.Name), strname)) Then MsgBox ("found string" & subfolder.Name)
Next
End Sub
Use Shell.Application ActiveX instead of FSO, here is an example:
Sub ShowSharedFolders()
Const SHCONTF_CHECKING_FOR_CHILDREN = &H10
Const SHCONTF_FOLDERS = &H20
Const SHCONTF_NONFOLDERS = &H40
Const SHCONTF_INCLUDEHIDDEN = &H80
Const SHCONTF_INIT_ON_FIRST_NEXT = &H100
Const SHCONTF_NETPRINTERSRCH = &H200
Const SHCONTF_SHAREABLE = &H400
Const SHCONTF_STORAGE = &H800
Const SHCONTF_NAVIGATION_ENUM = &H1000
Const SHCONTF_FASTITEMS = &H2000
Const SHCONTF_FLATLIST = &H4000
Const SHCONTF_ENABLE_ASYNC = &H8000
Const SHCONTF_INCLUDESUPERHIDDEN = &H10000
strPath = "\\10.4.32.33\"
Set objShellApp = CreateObject("Shell.Application")
Set objFolder = objShellApp.Namespace(strPath)
Set objFolderItems = objFolder.Items()
objFolderItems.Filter SHCONTF_FOLDERS + SHCONTF_INCLUDEHIDDEN, "*.*"
For Each objFolderItem In objFolderItems
Debug.Print objFolderItem.Name & vbTab & objFolderItem.Path
Next
End Sub
For early binding Set objShellApp = New Shell you have to add the reference to Microsoft Shell Controls and Automation (Shell32).
I have an Access database which has a filename field, along with width and height fields for an image. Instead of populating the width and height manually, I'm trying to read the height and width from the filename alone (full file path) and then insert into a record.
The reading of dimensions is fairly trivial in most languages, but can't find much for Access VBA. All I can find is for Excel which assumes the image is already in the spreadsheet as an object.
Just try googling "Use vba to read image file dimensions"
eg
https://social.msdn.microsoft.com/Forums/office/en-US/5f375529-a002-4312-a54b-b70d6d3eb6ae/how-to-retrieve-image-dimensions-using-vba-?forum=accessdev
for example
Dim objShell As Object
Dim objFolder As Object
Dim objFile As Object
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace("C:\Documents and Settings\Administrator\Desktop")
Set objFile = objFolder.ParseName("file_name.bmp")
MsgBox objFile.ExtendedProperty("Dimensions")
You can extract what you need from the string displayed in the message box
You can do this:
Dim objShell As Object
Dim objFolder As Object
Dim objFile As Object
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace("C:\Documents and Settings\Administrator\Desktop")
Set objFile = objFolder.ParseName("file_name.bmp")
MsgBox objFile.ExtendedProperty("Dimensions")
That messagebox should give you something along the lines of "300 X 500" (or whatever the Length X Width is). If you need the individual dimensions, you'll need to use something like
FileLen = CInt(Trim(Mid(objFile.ExtendedProperty, 2, InStr(objFile.ExtendedProperty, "X") - 1)))
and
FileWid = CInt(Trim(Mid(objFile.ExtendedProperty, InStr(objFile.ExtendedProperty, "X") + 2, Len(objFile.ExtendedProperty))))
You can also accomplish this with a class, which lets you use code like this:
targetImage.PixelWidth
targetImage.PixelHeight
Create a new Class Module and name it ImageDimensions.
Paste the following code into that class module:
Class Module Code
Option Explicit
Private pPixelWidth As Long
Private pPixelHeight As Long
Private pImageFullPath As String
Public Property Get ImageFullPath() As String
ImageFullPath = pImageFullPath
End Property
Public Property Let ImageFullPath(fullPath As String)
pImageFullPath = fullPath
Dim dimensionsText As String
dimensionsText = GetImageDimensions(fullPath)
pPixelWidth = Left$(dimensionsText, InStr(dimensionsText, ",") - 1)
pPixelHeight = Mid$(dimensionsText, InStr(dimensionsText, ",") + 1)
End Property
Public Property Get PixelWidth() As Long
PixelWidth = pPixelWidth
End Property
Private Property Let PixelWidth(value As Long)
pPixelWidth = value
End Property
Public Property Get PixelHeight() As Long
PixelHeight = pPixelHeight
End Property
Private Property Let PixelHeight(value As Long)
pPixelHeight = value
End Property
Private Function GetImageDimensions(ByVal fullPath As String)
Dim fileName As String
Dim fileFolder As String
fileName = FilenameFromPath(fullPath)
fileFolder = FolderFromFilePath(fullPath)
Dim objShell As Object
Set objShell = CreateObject("Shell.Application")
Dim targetFolder As Object
Set targetFolder = objShell.Namespace(fileFolder & vbNullString)
Const IMAGE_DIMENSIONS As Long = 31
Dim dimensionsPrep As String
dimensionsPrep = targetFolder.GetDetailsOf( _
targetFolder.Items.Item(fileName & vbNullString), _
IMAGE_DIMENSIONS)
dimensionsPrep = Replace(dimensionsPrep, " x ", ",")
dimensionsPrep = Mid$(dimensionsPrep, 2, Len(dimensionsPrep) - 2)
GetImageDimensions = dimensionsPrep
End Function
Private Function FolderFromFilePath(ByVal filePath As String) As String
Dim filesystem As Object
Set filesystem = CreateObject("Scripting.FileSystemObject")
FolderFromFilePath = filesystem.GetParentFolderName(filePath) & "\"
End Function
Private Function FilenameFromPath(ByVal filePathAndName As String) As String
Dim pathLength As Long
Dim iString As String
pathLength = Len(filePathAndName)
iString = vbNullString
Dim iCount As Long
For iCount = pathLength To 1 Step -1
If Mid$(filePathAndName, iCount, 1) = Application.PathSeparator Then
FilenameFromPath = iString
Exit Function
End If
iString = Mid$(filePathAndName, iCount, 1) & iString
Next iCount
FilenameFromPath = filePathAndName
End Function
Example Usage
Put this code in a regular code module (not a class module):
Sub ExampleImageDimensions()
Dim targetImage As ImageDimensions
Set targetImage = New ImageDimensions
targetImage = "C:\Users\ChrisB\Downloads\Screenshot.jpg"
Debug.Print targetImage.PixelHeight
Debug.Print targetImage.PixelWidth
End Sub
Is there any Way to get Start Time(with date), total running time and location of a running application using its PID value under windows by using CMD or VBS? If so, how? thanks in advance.
You can query the Win32_Process WMI class with a VBScript to get the executable path and the start time of a process. The duration can be derived from the start time:
pid = 23
Set wmi = GetObject("winmgmts://./root/cimv2")
Set convert = CreateObject("WbemScripting.SWbemDateTime")
qry = "SELECT * FROM Win32_Process WHERE ProcessId = " & pid
For Each p In wmi.ExecQuery(qry)
If IsNull(p.CreationDate) Then
'leave start time and duration empty if CreationDate can't be read
startTime = ""
duration = ""
Else
'convert start time from a string yyyyMMddHHmmss.ffffff±zzz to a date
convert.Value = p.CreationDate
startTime = convert.GetVarDate(True)
'calculate duration in minutes
duration = DateDiff("n", startTime, Now)
End If
WScript.Echo startTime & vbTab & duration & vbTab & p.ExecutablePath
Next
Note that you need the SeDebugPrivilege privilege (administrators have it by default) to be able to see the executable path of the processes of other users. Without that privilege p.ExecutablePath will be Null for processes not running in the context of the current user.
Not as such (for time - path's available).
You can monitor process starts and exits and calculate it yourself.
So Tasklist /v gives you the command line which includes the path.
The same thing in VBS.
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_Process")
For Each objItem in colItems
msgbox objItem.ProcessID & " " & objItem.Caption
Next
This is a VBS script that monitors process starts and exits.
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
Set objEvents = objWMIService.ExecNotificationQuery _
("SELECT * FROM Win32_ProcessTrace")
Do
Set objReceivedEvent = objEvents.NextEvent
msgbox objReceivedEvent.ProcessName
Loop
No such thing as StartTime
class Win32_Process : CIM_Process
{
string Caption;
string CommandLine;
string CreationClassName;
datetime CreationDate;
string CSCreationClassName;
string CSName;
string Description;
string ExecutablePath;
uint16 ExecutionState;
string Handle;
uint32 HandleCount;
datetime InstallDate;
uint64 KernelModeTime;
uint32 MaximumWorkingSetSize;
uint32 MinimumWorkingSetSize;
string Name;
string OSCreationClassName;
string OSName;
uint64 OtherOperationCount;
uint64 OtherTransferCount;
uint32 PageFaults;
uint32 PageFileUsage;
uint32 ParentProcessId;
uint32 PeakPageFileUsage;
uint64 PeakVirtualSize;
uint32 PeakWorkingSetSize;
uint32 Priority;
uint64 PrivatePageCount;
uint32 ProcessId;
uint32 QuotaNonPagedPoolUsage;
uint32 QuotaPagedPoolUsage;
uint32 QuotaPeakNonPagedPoolUsage;
uint32 QuotaPeakPagedPoolUsage;
uint64 ReadOperationCount;
uint64 ReadTransferCount;
uint32 SessionId;
string Status;
datetime TerminationDate;
uint32 ThreadCount;
uint64 UserModeTime;
uint64 VirtualSize;
string WindowsVersion;
uint64 WorkingSetSize;
uint64 WriteOperationCount;
uint64 WriteTransferCount;
};
all
I am using CreateProcessWithLogon method to installing softwares for non autherized users to installing software, it was working fine for windows XP users, but same application shows the error as follows in windows 7 machine.
System.ComponentModel.Win32Exception(0x80004005): the requested operation requires elevation
please any one suggest me any idea to fix it.
i am using the code as follows
Private Const LOGON_NETCREDENTIALS_ONLY As Integer = &H2
Private Const NORMAL_PRIORITY_CLASS As Integer = &H20
Private Const CREATE_DEFAULT_ERROR_MODE As Integer = &H4000000
Private Const CREATE_NEW_CONSOLE As Integer = &H10
Private Const CREATE_NEW_PROCESS_GROUP As Integer = &H200
Private Const LOGON_WITH_PROFILE As Integer = &H1
Private Const LOGON_WITH_PROFILE1 As Integer = 0
Dim siStartup As STARTUPINFO
Dim piProcess As PROCESS_INFORMATION
Dim intReturn As Integer
Dim bResult As Boolean = False
Dim result As Integer
Dim sFile, sArg As String
IMP_USER_NAME = AppSettings("UserName")
IMP_PASS_WORD = AppSettings("Password")
IMP_DOMAIN_NAME = AppSettings("Domain")
Try
If sApplication.EndsWith(".msi") Then
sApplication = sApplication & " " & """ALLUSERS=1"""
sArg = "msiexec.exe /i """ & sApplication & """"
sFile = vbNullString
Else
If bToExecute = False Then
sArg = vbNullString
sFile = sApplication
Else
sArg = "cmd /c """ & sApplication & """"
sFile = vbNullString
End If
End If
siStartup.cb = Marshal.SizeOf(siStartup)
siStartup.dwFlags = 0
intReturn = CreateProcessWithLogon(IMP_USER_NAME, IMP_DOMAIN_NAME, IMP_PASS_WORD, LOGON_WITH_PROFILE, sFile, sArg, _
NORMAL_PRIORITY_CLASS Or CREATE_DEFAULT_ERROR_MODE Or CREATE_NEW_CONSOLE Or CREATE_NEW_PROCESS_GROUP, _
IntPtr.Zero, IntPtr.Zero, siStartup, piProcess)
Thanks,
Senthil
See http://blogs.msdn.com/b/cjacks/archive/2010/02/01/why-can-t-i-elevate-my-application-to-run-as-administrator-while-using-createprocesswithlogonw.aspx : you need an intermediate process that execute ShellExec() to elevate the priveleges of an application called with CreateProcessWithLogon
Alternativeley, you can call cmd /c cd <targetDir>&<targetDrive>:&<execName> with CreateProcessWithLogon to avoid creating that intermediate process.
Probably the reason is that you use LOGON_WITH_PROFILE flag. In the "Remark" part of the CreateProcessWithLogonW documentation you can read following
By default, CreateProcessWithLogonW
does not load the specified user
profile into the HKEY_USERS registry
key. This means that access to
information in the HKEY_CURRENT_USER
registry key may not produce results
that are consistent with a normal
interactive logon. It is your
responsibility to load the user
registry hive into HKEY_USERS before
calling CreateProcessWithLogonW, by
using LOGON_WITH_PROFILE, or by
calling the LoadUserProfile function.
So I recommend you to try the same code without LOGON_WITH_PROFILE flag. If you will see that it was the problem and you do need to use the flag you should use LoadUserProfile function and UnloadUserProfile in your code.