I'm developing a routine using VB6, you must refresh the screen each second, searching for a specific process running on the system.
I'm using WMI to query processes. But sometimes I get a return "not found", and the application closes. the question is, I can filter the user inside the WMI query using a join or something?
below is my source code
Dim UserName As String
Dim UserDomain As String
Dim proc_query As String
Dim proc_results As Object
UserName = Environ("USERNAME")
proc_query = "select * from Win32_Process where Name = 'Exe1234.EXE'"
Set proc_results = GetObject("Winmgmts:").ExecQuery(proc_query)
For Each info In proc_results
colProperties = info.GetOwner(strNameOfUser, strUserDomain)
If strNameOfUser = UserName Then
// Call a external .exe
Unload Me: Exit For
End If
Next info
Related
I'm, unable to retrieve the PC model in VB6, the property I request from the query returns empty. I try to emulate the result of this CMD command.
wmic computersystem get model
This is the code I try to use. (I added Microsoft WMI scripting lib 1.2 as a reference in the project).
Function wmiInfo() As String
Dim List
Dim Msg
Dim Object
On Local Error Resume Next
Set List = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_BaseBoard")
For Each Object In List
Msg = Msg & "Motherboard Serial Number: " & Object.Model & vbCrLf
Next
MsgBox Msg
end function
I expect the function to retrieve just a string with the model of the PC something like "Optiplex 790" (it is what the cmd command returns).
Any help is greatly appreciated.
(OS Windows 7)
I found the issue. I was requesting the wrong class.
Win32_computerSystem has the property I'm looking for.
Function wmiProcessorInfo() As String
Dim msg As String
Dim cpuSet As SWbemObjectSet
Dim cpu As SWbemObject
Dim itmx As ListItem
On Local Error Resume Next
Set cpuSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_ComputerSystem")
For Each cpu In cpuSet
msg = cpu.Model
Next
MsgBox msg
End Function
I've got an application running a manufacturing process on a Windows 7 computer. The app has some time-sensitive components that sometimes run slow for a second or two. I know there are a lot of background operations happening in the CLR and OS that can cause program delays, but I've also seen the users sometimes log in to their personal accounts to check email, etc., while my app is running. I'm sure their doing this causes some of the slow-downs. IT says they can't block user accounts on individual computers, so I'd like to have my app text me when the system is running slow and users are logged in to their personal accounts, so I can run over there and call them out on it. Thank you.
This worked:
Function GetActiveUsers() As List(Of String)
Dim activeusers As New List(Of String)
Dim userskey As RegistryKey = Registry.LocalMachine.OpenSubKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList")
For Each keyname As String In userskey.GetSubKeyNames()
Using key As RegistryKey = userskey.OpenSubKey(keyname)
Dim userpath As String = DirectCast(key.GetValue("ProfileImagePath"), String)
Dim username As String = System.IO.Path.GetFileNameWithoutExtension(userpath)
Dim useractive As Integer = 0
If key.GetValueNames.Contains("RefCount") Then useractive = DirectCast(key.GetValue("RefCount"), Integer)
If useractive <> 0 Then activeusers.Add(username)
End Using
Next
Return activeusers
End Function
Whenever I run my program I get this error:
An unhandled exception of type 'System.Data.OleDb.OleDbException' occurred in System.Data.dll
Additional information: No value given for one or more required parameters.
Sub admininfoo()
Dim q As String = "Select * from Table2 where AdminPassword=" & AdminLogin.TextBox1.Text
Dim cmd As New OleDb.OleDbCommand(q, connection)
Dim reader As OleDb.OleDbDataReader = cmd.ExecuteReader()
reader.Read()
AdminInterface.Label2.Text = reader("Name")
reader.Close()
End Sub
btw I am using Visual Basic 2013 and Microsoft Access Database
You are not sanitizing your inputs. If your password has an '?' character in it, the OleDb provider will interpret it as a parameter that you will need pass in, which you should be doing anyways, to prevent any injection.
Use the OleDbCommand.Parameters.AddWithValue method to add your parameter.
Dim q As String = "Select * from Table2 where AdminPassword=?"
Dim cmd As New OleDb.OleDbCommand(q, connection)
cmd.Parameters.AddWithValue("AdminPassword", AdminLogin.TextBox1.Text)
Dim reader As OleDb.OleDbDataReader = cmd.ExecuteReader()
I'm trying to get hold of running instances of MS Access 2010+ (on Win10) but the usual tip; GetObject(, "Access.Application") ... for works only for hidden instances started by myself with script, but not any instances started from GUI by the user.
And yes, I've read perhaps ten or more google hits on the subject, both on WMI and GetObject, but I seem to have missed something important.
However, I've tried the code below and I can get hold of any process of running Access instances in this way, and I can even .terminate() them, but, that's not what I want to do. Instead I want to grab the process and assign it to a usable (correct type) Access variable (see "OutInstance" in the code below) :
[Edit: Using WHERE clause, and skipped Exit as to retrieve the last instance]
Public Function GetRunningInstance(sAppName sComputer, ByRef OutInstance)
Dim oWMIService
Dim wProcesses
Dim oPrc
GetRunningInstance = False
Set OutInstance = Nothing
if sComputer = "" then sComputer = "."
Set oWMIService = GetObject("winmgmts:" & "{impersonationLevel=" & _
"impersonate}!\\" & sComputer & "\root\cimv2")
Set wProcesses = oWMIService.ExecQuery ("SELECT * FROM Win32_Process " & _
"WHERE Name = '" & sAppName & "'")
For Each oPrc in wProcesses
''' oPrc.Terminate() ''' Works, I can shut down Access...
Set OutInstance = oPrc
GetRunningInstance = True
''' By not exiting we get the last instance.
Next
End Function
Now, after trying to get hold of an instance, how do I "cast" the process to a usable Access application variable in this VBScript?
Sub Test_DoStuff()
Dim InstProc
Dim AccessApp
If GetRunningInstance("msaccess.exe", "127.0.0.1", InstProc) Then
Set AccessApp = ''' cast 'InstProc' to my "Access.Application" somehow?
Else
Set AccessApp = CreateObject("Access.Application")
End If
'''
''' Doing my stuff
'''
AccessApp.CloseCurrentDatabase
AccessApp.DoCmd.Quit
End Sub
Test
I (also) don't understand why GetObject(, "Access.Application") doesn't work in all cases. Permissions? (I understand that it's 'unsafe' to close a database currently being used by a user, but also that can be dealt with).
// Rolf
I am trying to port over Thunderbird/Firefox profile customization scripts from OS X to Windows 7. On OS X they are super simple, using ldapsearch -x -h ldap.place.edu uid="username" to retrieve the email address, real name etc from the OpenLDAP server then throwing these variables into the various configuration files before the applications are loaded.
On Windows this is much more complex, I started trying to use the search.vbs activedirectory/ldap tool that comes with Windows Server 2003 but it doesn't work properly, I also tried simply writing a quick vbs script to connect and query but I always get errors either that the server won't process the request or that just fails... here is my latest vbs script that totally flunks out...
Dim oConn,oRS,vSearch,vCount,vMailList,vValue,vProblem,vMsg
vProblem = False
vSearch = "(uid=username)"
Set oConn = CreateObject("ADODB.Connection")
oConn.Provider = "ADsDSOObject"
oConn.Open "ADs Provider", "ou=people,dc=place,dc=edu"
Set oRS = oConn.Execute("<LDAP://ldap.place.edu/dc=edu/dc=place>;" & vSearch &_";cn,mail")
vCount = 1
While not oRS.EOF
For Each vValue in oRS.Fields(0).value
WScript.Echo vValue
Next
vCount = vCount + 1
oRS.MoveNext
Wend
Figured it out a little while back and totally forgot about this, so here it is. I realised I was trying to connect to a anonymous server but was providing a DN while implies a password level of authentication instead of the simple version I needed.
'Server name
sRoot = "LDAP://server"
Dim oDS: Set oDS = GetObject("LDAP:")
'Don't provide a DN for anonymous authentication, also &H0010 implies simple auth mode
Dim oAuth: Set oAuth = oDS.OpenDSObject(sRoot, "", "", &H0010)
Dim oConn: Set oConn = CreateObject("ADODB.Connection")
oConn.Provider = "ADSDSOObject"
oConn.Open "Ads Provider", sDN
Dim rs
'Execute query
Set rs = oConn.Execute("<" & sRoot & ">;(uid=testuser);cn,mail;subtree")
'retrieve values
z = rs.Fields.Item(0).Value
x = rs.Fields.Item(1).Value