I try to create visual basic 2010 program that detect which connection is connected and its ip address. For example if i connect with wireless and cable, it will show both media connected and its ip address. This code i take from WMI code creator
Dim strComputer = "."
Dim Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery( _
"SELECT * FROM Win32_NetworkAdapterConfiguration",,48)
For Each objItem in colItems
Wscript.Echo "-----------------------------------"
Wscript.Echo "Win32_NetworkAdapterConfiguration instance"
Wscript.Echo "-----------------------------------"
If isNull(objItem.IPAddress) Then
Wscript.Echo "IPAddress: "
Else
Wscript.Echo "IPAddress: " & Join(objItem.IPAddress, ",")
End If
Then i got error message
'colItems' is not declared. It may be inaccessible due to its protection level.
Am i doing wrongly? Can someone show me if this is the wrong code or not?
Better use the class ManagementObjectSearcher. Here an example:
Private objOS As ManagementObjectSearcher
Private objCS As ManagementObjectSearcher
Private objMgmt As ManagementObject
Private m_strComputerName As String
Private m_strManufacturer As String
Private m_StrModel As String
Private m_strOSName As String
Private m_strOSVersion As String
Private m_strSystemType As String
Private m_strTPM As String
Private m_strWindowsDir As String
Public Sub New()
objOS = New ManagementObjectSearcher("SELECT * FROM Win32_OperatingSystem")
objCS = New ManagementObjectSearcher("SELECT * FROM Win32_ComputerSystem")
For Each objMgmt In objOS.Get
m_strOSName = objMgmt("name").ToString()
m_strOSVersion = objMgmt("version").ToString()
m_strComputerName = objMgmt("csname").ToString()
m_strWindowsDir = objMgmt("windowsdirectory").ToString()
Next
Just change the query to: SELECT * FROM Win32_NetworkAdapterConfiguration
Related
Private Function SelectAPrinter(myName As String) As Printer
Dim strComputer As String
Dim objWMIService As Object
Dim myPrinter As Object
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set myPrinter = objWMIService.ExecQuery("Select * from Win32_Printer where Name = '" & myName & "'")
Set SelectAPrinter = myPrinter
End Function
so of course VB6 barks at me with "type mismatch" which is no surprise. I am attempting to set an object
(myPrinter) to type Printer.
I DO NOT Know how to finish this function.
IS THERE a method of "casting" an object to type Printer?
If you do not mind setting the default printer temporarily, then perhaps the following will work.
Option Explicit
Private Sub Command1_Click()
Dim saveme As String
Dim yourprinter As Printer
saveme = Printer.DeviceName
Set yourprinter = SelectAPrinter("Canon iR-ADV C5045/5051 PCL5c")
Debug.Print "selected", yourprinter.DeviceName ' Microsoft Print to PDF
Call SelectAPrinter(saveme) ' restore default
Debug.Print "restored", Printer.DeviceName
End Sub
Private Function SelectAPrinter(myName As String) As Printer
Dim strComputer As String
Dim objWMIService As Object
Dim colInstalledPrinters As Object
Dim myPrinter As Object
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colInstalledPrinters = objWMIService.ExecQuery("Select * from Win32_Printer where Name = '" & myName & "'")
For Each myPrinter In colInstalledPrinters
myPrinter.SetDefaultPrinter
Exit For
Next
Set SelectAPrinter = Printer
End Function
You can use a helper method to "cast" the object to a Printer. However, the helper method does use the Printers collection:
Private Function SelectAPrinter(myName As String) As Printer
Dim MyWMIService As Object
Dim MyPrinters As Object
Dim MyPrinter As Object
Set MyWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set MyPrinters = MyWMIService.ExecQuery("Select Name from Win32_Printer where Name = '" & myName & "'")
For Each MyPrinter In MyPrinters
Set SelectAPrinter = FindPrinter(MyPrinter.Name)
Exit For
Next
End Function
Private Function FindPrinter(ByVal DeviceName As String) As Printer
Dim p As Printer
For Each p In Printers
If UCase(p.DeviceName) = UCase(DeviceName) Then
Set FindPrinter = p
Exit For
End If
Next
End Function
I am trying to use some nVidia functions in there WMI API (attached, it is a txt file but should be renamed to chm for help file)
I am new to vbscript so can be doing something wrong.
My code is as follows:
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
arrComputers = Array(".")
For Each strComputer In arrComputers
WScript.Echo
WScript.Echo "=========================================="
WScript.Echo "Computer: " & strComputer
WScript.Echo "=========================================="
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2\NV")
Set colItems = objWMIService.ExecQuery("SELECT * FROM SyncTopology", "WQL", _
wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
NodeID = objItem.id
WScript.Echo "id: " & NodeID
WScript.Echo
Next
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2\NV")
Set SyncClass = objWMIService.Get("Sync")
if (SyncClass.toggleSource()) Then
wscript.echo "done!"
End if
Next
I am actually trying to use a different function but this one is the easiest and takes no arguments.
The class is 'Sync' the function is toggleSource, should be too easy!
I get an error on line:
if (SyncClass.toggleSource()) Then
stating:
C:\Users\User\Desktop\test3.vbs(28, 2) SWbemObjectEx: Invalid method Parameter(s)
I can query attributes in the class just can run methods :(
I can use these methods in Powershell so they should work, just can't get it working in vbscript!! AHHH...
I am attempting to create an application that will allow me to input a username and switch that user's default printer by modifying the registry under HKEY_USERS\UserSID. I cannot seem write values to that section of the registry though. Perhaps it's a Windows limitation? Here's the code I have so far.
Dim strComputer = "."
Dim objWMIService As Object = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Dim theUsername As String = TextBox1.Text
Dim theDomain As String = TextBox2.Text
Dim objAccount As Object = objWMIService.Get("Win32_UserAccount.Name='" & theUsername & "',Domain='" & theDomain & "'")
Dim theport As RegistryKey
theport = Registry.CurrentUser.OpenSubKey("Software\\Microsoft\\Windows NT\\CurrentVersion\\Devices")
Dim val As Object = theport.GetValue(ListBox1.SelectedItem)
theport.Close()
Dim theSid As String = objAccount.sid
Dim theKey As RegistryKey = Registry.Users.OpenSubKey(theSid + "\\Software\\Microsoft\\Windows NT\\CurrentVersion\\Windows", True)
I don't think that there is some Windows limitation, because I wrote to HKEY_USERS\SIDs many times. But I used for this purpose the vbscript. Also I should warn you that you can only read&write to Users registry if they are logged. For not logged users - use the ActiveSetup.
There is my script on vbs which writes some registry to all logged users. Hope you could adapt it to VB.NET.
Option Explicit
Const HKEY_USERS = &H80000003
Dim objReg, objWMI, colSessions, objSession, colList, colUsers, objUser, Domain, UserName, objUserAccount, SID, WshShell
Set WshShell = CreateObject("WScript.Shell")
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colSessions = objWMI.ExecQuery("Select * from Win32_LogonSession Where LogonType = 2 Or LogonType = 10")
If colSessions.Count <> 0 Then
For Each objSession in colSessions
Set colUsers = objWMI.ExecQuery("Associators of " & "{Win32_LogonSession.LogonId=" & objSession.LogonId & "} " & "Where AssocClass=Win32_LoggedOnUser Role=Dependent" )
For Each objUser in colUsers
Domain = objUser.Domain : UserName = objUser.Name
Set objUserAccount = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2:Win32_UserAccount.Domain='" & Domain & "',Name='" & UserName & "'")
SID = objUserAccount.SID
objReg.CreateKey HKEY_USERS, SID & "\Control Panel\Desktop"
objReg.SetStringValue HKEY_USERS, SID & "\Control Panel\Desktop", "Example", "1"
objReg.SetDwordValue HKEY_USERS, SID & "\Control Panel\Desktop", "Example", "2"
Next
Next
End If
Some time ago on I asked about limiting the number of instances of Excel being run concurrently in Windows.
Thanks to the help I got on StackOverflow.com I was able to put together the following function that shuts down any instance of Excel that is launched if there is already another instance of Excel running.
Private Function KillDuplicateProcesses() As Boolean
Dim objWMIService As Object
Dim colItems As Variant
Dim objItem As Object
Dim intCount As Integer
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.InstancesOf("Win32_Process")
For Each objItem In colItems
intCount = intCount + Abs(LCase(objItem.Name) = "excel.exe")
If intCount > 1 Then
MsgBox "Excel is already running." & vbCrLf & vbCrLf & _
"To open a file use " & IIf(Application.Version >= 12, "Office Button", "File") & " > Open (Ctrl + O).", vbCritical
KillDuplicateProcesses = True
Application.Quit
Exit For
End If
Next
End Function
The problem is that if a user is logged onto a remote desktop session as an administrator, that user account can see all of the other users and the processes that they have running. So if another user is logged onto the same machine and is running Excel, the function counts those instances as well and shuts down the instance of Excel that has just been launched.
I need to limit the scope of that function to the currently running session. According to MSDN documentation there is a class property called SessionID. Can I use that property and compare it against the current session's ID to limit what the function counts, or is there a better way to do it?
Any suggestions would be greatly appreciated.
Thanks!
Below is the solution code per Tim's suggestion. Note I am comparing the GetOwner properties against Environ UserName and UserDomain. Environ is considered unreliable because it can be changed by the user.
Private Function KillDuplicateProcesses() As Boolean
Dim objWMIService As Object
Dim colItems As Variant
Dim objItem As Object
Dim intCount As Integer
Dim strProcessUser As Variant
Dim strProcessDomain As Variant
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name = 'excel.exe'")
If colItems.Count > 1 Then
For Each objItem In colItems
strProcessUser = ""
strProcessDomain = ""
objItem.GetOwner strProcessUser, strProcessDomain
If IsNull(strProcessUser) Then strProcessUser = ""
If IsNull(strProcessDomain) Then strProcessDomain = ""
intCount = intCount + Abs(strProcessUser = Environ("UserName") _
And strProcessDomain = Environ("UserDomain"))
If intCount > 1 Then
MsgBox "You cannot run more than one instance of Excel while iTools is activated." & vbCrLf & vbCrLf & _
"To open a file use " & IIf(Application.Version >= 12, "Office Button", "File") & " > Open (Ctrl + O).", vbCritical
KillDuplicateProcesses = True
Application.Quit
Exit For
End If
Next
End If
End Function
'get process owner username and domain
Dim strUser, strDomain
objItem.getOwner strUser, strDomain
MsgBox strUser & ", " & strDomain
can you help out access the database... I have been reading some tutorials but I don't know where to start doing this one. I used DataControl to access the database. First, the program will prompt for the ID Number and then Search for the further information and display it in texboxes when Search Employee button clicked. I know how to set the properties of textboxes in order to appear the value of my database to my output without clicking the Search Employee button but I want to click first the button Search Employee. I'm a beginner in VB6. Please help me out! I need this project now.
Ok, I had some time to spare, here you go, first add a reference to Microsoft ActiveX Data Objects 2.X Library:
Form1 Code:
Option Explicit
''Add the following items to your form and name them as indicated:
''Four(4) text boxes - Named: tbIDNumber, tbName, tbAddress, and tbContactName.
''One(1) Command button - Named Command1
Private Sub Command1_Click()
Dim rs As ADODB.Recordset
Dim DB As cDatabase
Dim l As Long
Set rs = New ADODB.Recordset
Set DB = New cDatabase
With DB
.DBCursorType = adOpenForwardOnly
.DBLockType = adLockReadOnly
.DBOptions = adCmdText
.DSNName = "Your_DSN_Name"
.SQLUserID = "Your_SQL_Login_Name"
.SQLPassword = "Your_SQL_Login_Password"
Set rs = .GetRS("Select Name, Address, ContactNumber FROM YourTableName WHERE IDNumber = '" & tbIDNumber.Text & "'")
End With
If rs.RecordCount > 0 Then
tbName.Text = rs(0).Value & ""
tbAddress.Text = rs(1).Value & ""
tbContactName.Text = rs(2).Value & ""
End If
Exit_Sub:
rs.Close
Set rs = Nothing
Set DB = Nothing
End Sub
Add a Class Module Object to your project and name it cDatabase. Then copy the following Code into it:
Option Explicit
Private m_eDBCursorType As ADODB.CursorTypeEnum 'Cursor (Dynamic, Forward Only, Keyset, Static)
Private m_eDBLockType As ADODB.LockTypeEnum 'Locks (BatchOptimistic,Optimistic,Pessimistic, Read Only)
Private m_eDBOptions As ADODB.CommandTypeEnum 'DB Options
Private m_sDSNName As String
Private m_sSQLUserID As String
Private m_sSQLPassword As String
Private cn As ADODB.Connection
Private Sub Class_Initialize()
m_eDBCursorType = adOpenForwardOnly
m_eDBLockType = adLockReadOnly
m_eDBOptions = adCmdText
End Sub
Private Function ConnectionString() As String
ConnectionString = "DSN=" & m_sDSNName & "" & _
";UID=" & m_sSQLUserID & _
";PWD=" & m_sSQLPassword & ";"
''If you are using MS Access as your back end you will need to change the connection string to the following:
''ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
''If you are using a DNS-Less connection to SQL Server, then you will need to change the connection string to the following:
''ConnectionString = "Data Source=myServerAddress;Initial Catalog=myDataBase;User Id=" & m_sSQLUserID & ";Password=" & m_sSQLPassword & ";"
''You can find more Connection Strings at http://connectionstrings.com/
End Function
Private Sub GetCN()
On Error GoTo GetCN_Error
If cn.State = 0 Then
StartCN:
Set cn = New ADODB.Connection
cn.Open ConnectionString
With cn
.CommandTimeout = 0
.CursorLocation = adUseClient
End With
End If
On Error GoTo 0
Exit Sub
GetCN_Error:
If Err.Number = 91 Then
Resume StartCN
Else
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetCN of Module modDatabaseConnections"
End If
End Sub
Public Function GetRS(sSQL As String) As ADODB.Recordset
Dim eRS As ADODB.Recordset
On Error GoTo GetRS_Error
TryAgain:
If Len(Trim(sSQL)) > 0 Then
Call GetCN
Set eRS = New ADODB.Recordset 'Creates record set
eRS.Open sSQL, cn, m_eDBCursorType, m_eDBLockType, m_eDBOptions
Set GetRS = eRS
Else
MsgBox "You have to submit a SQL String"
End If
On Error GoTo 0
Exit Function
GetRS_Error:
If Err.Number = 91 Then
Call GetCN
GoTo TryAgain
ElseIf Err.Number = -2147217900 Then
Exit Function
Else
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetRS of Module" & vbCrLf & vbCrLf & "SQL - " & sSQL
End If
End Function
Public Property Get DBOptions() As ADODB.CommandTypeEnum
DBOptions = m_eDBOptions
End Property
Public Property Let DBOptions(ByVal eDBOptions As ADODB.CommandTypeEnum)
m_eDBOptions = eDBOptions
End Property
Public Property Get DBCursorType() As ADODB.CursorTypeEnum
DBCursorType = m_eDBCursorType
End Property
Public Property Let DBCursorType(ByVal eDBCursorType As ADODB.CursorTypeEnum)
m_eDBCursorType = eDBCursorType
End Property
Public Property Get DBLockType() As ADODB.LockTypeEnum
DBLockType = m_eDBLockType
End Property
Public Property Let DBLockType(ByVal eDBLockType As ADODB.LockTypeEnum)
m_eDBLockType = eDBLockType
End Property
Public Property Get DSNName() As String
DSNName = m_sDSNName
End Property
Public Property Let DSNName(ByVal sDSNName As String)
m_sDSNName = sDSNName
End Property
Public Property Get SQLUserID() As String
SQLUserID = m_sSQLUserID
End Property
Public Property Let SQLUserID(ByVal sSQLUserID As String)
m_sSQLUserID = sSQLUserID
End Property
Public Property Get SQLPassword() As String
SQLPassword = m_sSQLPassword
End Property
Public Property Let SQLPassword(ByVal sSQLPassword As String)
m_sSQLPassword = sSQLPassword
End Property
This should do the trick.