Getting errors with Parameterized Update Sub - tsql

No idea why this isn't working.
I have a simple form with some text boxes and drop down lists. It displays the profile of an employee. Users should be able to manually edit the fields and click Save. When they click save I keep getting errors.
Q1: How can I handle inserting Null values for SmallDateTime data types?
Q2: What am I doing wrong with the TinyInt (SqlServer 2005) on the JobGrade?
Option Explicit On
Imports System
Imports System.Data
Imports System.Data.SqlClient
Protected Sub btnSave_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnSave.Click
Dim sqlJobsDB As New SqlConnection(ConfigurationManager.ConnectionStrings("JobsDB").ConnectionString)
Dim sqlCmdUpdate As SqlCommand = sqlJobsDB.CreateCommand()
Try
sqlJobsDB.Open()
sqlCmdUpdate.CommandText = _
"UPDATE tblEmployee " + _
"SET Firstname = #Firstname, LastName = #LastName, HiredLastName = #HiredLastName, " + _
"DateHired = #DateHired, Role = #Role, CADate = #CADate, CAType = #CAType, " + _
"JobDate = #JobDate, JobGrade = #JobGrade " + _
"WHERE EUID = '" & Session("sProfileEUID") & "';"
sqlCmdUpdate.Parameters.Add("#FirstName", SqlDbType.VarChar)
sqlCmdUpdate.Parameters.Add("#LastName", SqlDbType.VarChar)
sqlCmdUpdate.Parameters.Add("#HiredLastName", SqlDbType.VarChar)
sqlCmdUpdate.Parameters.Add("#DateHired", SqlDbType.SmallDateTime)
sqlCmdUpdate.Parameters.Add("#Role", SqlDbType.VarChar)
sqlCmdUpdate.Parameters.Add("#CADate", SqlDbType.SmallDateTime)
sqlCmdUpdate.Parameters.Add("#CAType", SqlDbType.VarChar)
sqlCmdUpdate.Parameters.Add("#JobDate", SqlDbType.SmallDateTime)
sqlCmdUpdate.Parameters.Add("#JobGrade", SqlDbType.TinyInt)
sqlCmdUpdate.Parameters("#FirstName").Value = txtFirstName.Text
sqlCmdUpdate.Parameters("#LastName").Value = txtLastName.Text
sqlCmdUpdate.Parameters("#HiredLastName").Value = txtHiredLastName.Text
sqlCmdUpdate.Parameters("#DateHired").Value = txtDateHired.Text
sqlCmdUpdate.Parameters("#Role").Value = ddlRole.SelectedValue.ToString
If txtCADate.Text = "" Then
sqlCmdUpdate.Parameters("#CADate").Value = 0
Else
sqlCmdUpdate.Parameters("#CADate").Value = txtCADate.Text
End If
sqlCmdUpdate.Parameters("#CAType").Value = ddlCAType.SelectedValue
If txtJobDate.Text = "" Then
sqlCmdUpdate.Parameters("#JobDate").Value = 0
Else
sqlCmdUpdate.Parameters("#JobDate").Value = txtJobDate.Text
End If
sqlCmdUpdate.Parameters("#JobGrade").Value = CByte(txtJobGrade.Text)
sqlCmdUpdate.ExecuteNonQuery()
Catch ex As Exception
'Debugging
lblErrMsg.Text = ex.ToString
lblErrMsg.Visible = True
Finally
sqlJobsDB.Close()
End Try
End Sub</code>
I open the form and fill it out correctly.
I'll enter something like "4" (no quotes) for JobGrade. It still says "conversion from strink ''" like its not even seeing when I input items on the form.
Errors are below:
System.InvalidCastException: Conversion from string "" to type 'Byte' is not valid. ---> System.FormatException: Input string was not in a correct format. at Microsoft.VisualBasic.CompilerServices.Conversions.ParseDouble(String Value, NumberFormatInfo NumberFormat) at Microsoft.VisualBasic.CompilerServices.Conversions.ToByte(String Value) --- End of inner exception stack trace --- at Microsoft.VisualBasic.CompilerServices.Conversions.ToByte(String Value) at Profile.btnSave_Click(Object sender, EventArgs e) in
Update
The DBNull.Value issue is resolved.
The JobGrade, and Role are still issues. When throwing up some breakpoints on it doens't fetch the contents of the textbox or the dropdown list.
** Updated Code **
Protected Sub btnCancel_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnCancel.Click
Session("sProfileEUID") = Nothing
Response.Redirect("~/Management/EditUsers.aspx")
End Sub
Protected Sub btnSave_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnSave.Click
Dim sqlJobsDB As New SqlConnection(ConfigurationManager.ConnectionStrings("JobsDB").ConnectionString)
Dim sqlCmdUpdate As SqlCommand = sqlJobsDB.CreateCommand()
Try
sqlJobsDB.Open()
sqlCmdUpdate.CommandText = _
"UPDATE tblEmployee " + _
"SET FirstName = #FirstName, LastName = #LastName, HiredLastName = #HiredLastName, " + _
"DateHired = #DateHired, Role = #Role, CADate = #CADate, CAType = #CAType, " + _
"JobDate = #JobDate, JobGrade = #JobGrade " + _
"WHERE EUID = '" & Session("sProfileEUID") & "';"
sqlCmdUpdate.Parameters.Add("#FirstName", SqlDbType.VarChar)
sqlCmdUpdate.Parameters.Add("#LastName", SqlDbType.VarChar)
sqlCmdUpdate.Parameters.Add("#HiredLastName", SqlDbType.VarChar)
sqlCmdUpdate.Parameters.Add("#DateHired", SqlDbType.SmallDateTime)
sqlCmdUpdate.Parameters.Add("#Role", SqlDbType.VarChar)
sqlCmdUpdate.Parameters.Add("#CADate", SqlDbType.SmallDateTime)
sqlCmdUpdate.Parameters.Add("#CAType", SqlDbType.VarChar)
sqlCmdUpdate.Parameters.Add("#JobDate", SqlDbType.SmallDateTime)
sqlCmdUpdate.Parameters.Add("#JobGrade", SqlDbType.TinyInt)
sqlCmdUpdate.Parameters("#FirstName").Value = txtFirstName.Text
sqlCmdUpdate.Parameters("#LastName").Value = txtLastName.Text
sqlCmdUpdate.Parameters("#HiredLastName").Value = txtHiredLastName.Text
sqlCmdUpdate.Parameters("#DateHired").Value = txtDateHired.Text
sqlCmdUpdate.Parameters("#Role").Value = ddlRole.SelectedValue.ToString
If txtCADate.Text <> "" Then sqlCmdUpdate.Parameters("#CADate").Value = CDate(txtCADate.Text)
If txtCADate.Text = "" Then sqlCmdUpdate.Parameters("#CADate").Value = DBNull.Value
If ddlCAType.Text <> "" Then sqlCmdUpdate.Parameters("#CAType").Value = ddlCAType.SelectedValue
If ddlCAType.Text = "" Then sqlCmdUpdate.Parameters("#CAType").Value = DBNull.Value
If txtJobDate.Text <> "" Then sqlCmdUpdate.Parameters("#JobDate").Value = CDate(txtJobDate.Text)
If txtJobDate.Text = "" Then sqlCmdUpdate.Parameters("#JobDate").Value = DBNull.Value
If txtJobGrade.Text <> "" Then sqlCmdUpdate.Parameters("#JobGrade").Value = CInt(txtJobGrade.Text)
If txtJobGrade.Text = "" Then sqlCmdUpdate.Parameters("#JobGrade").Value = DBNull.Value
sqlCmdUpdate.ExecuteNonQuery()
Catch ex As Exception
lblErrMsg.Text = ex.ToString
lblErrMsg.Visible = True
Finally
sqlJobsDB.Close()
End Try
End Sub
Edit 2:
So I've pretty much given up on this, and instead moved the table into an FormView ItemTemplate, with an EditTemplate also. I modified it as described in the following link. http://www.beansoftware.com/ASP.NET-Tutorials/FormView-Control.aspx

Q1: Make sure the table structure allows nulls and set the parameter value to DBNull.Value.
Q2:
If IsNumeric(txtJobGrade.Text) Then
sqlCmdUpdate.Parameters("#JobGrade").Value = CInt(txtJobGrade.Text)
Else
sqlCmdUpdate.Parameters("#JobGrade").Value = 0 'Or Default Value
End If
You can always make that a drop down list to prevent open ended data input.

It's a little odd to see how you're done the parameters. Typically, I'd expect to see something more along these lines:
With sqlCmdUpdate.Parameters
.clear()
.addWithValue("#parm1", mytextbox1.text)
.addWithValue("#parm2", mytextbox2.text)
End With
For one, .add has been deprecated -- still works, but some issues to be aware of (http://msdn.microsoft.com/en-us/library/system.data.sqlclient.sqlparametercollection.addwithvalue.aspx).
Secondly, it's always best to call .clear().
Also -- you might think about a more standard approach to checking for values -- for example:
If txtJobGrade.Text <> "" Then...
Would be better written as
If NOT string.isnullorempty(me.txtJobGrade.text) Then...
Try making a few of those changes, and see what (if any) errors you're still getting.

Related

Getting Email Addresses for Recipients (Outlook)

I have a code that I was able to string together that logs my sent emails into an excel sheet so i can use that data for other analysis.
In it, I have it resolving the name into an email as outlook shortens it ("Jimenez, Ramon" = email#address.com) as outlook configured this and it works when i send an email to anyone in my company as they are in my address book.
Now, when I email anyone outside it defaults to lastName, firstName so it is not converting this and logging it.
I thought the code I have in here already does this, but I guess not. I have already come this far and I am NOT a software guru at all. Does anyone have insight on how I can also include this as well?? Please see code below:
Private WithEvents Items As Outlook.Items
Const strFile As String = "C:\Users\a0227084\Videos\work\test.xlsx"
Private Sub Application_Startup()
Dim OLApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set OLApp = Outlook.Application
Set objNS = OLApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderSentMail).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
' ******************
FullName = Split(Msg.To, ";")
For i = 0 To UBound(FullName)
If i = 0 Then
STRNAME = ResolveDisplayNameToSMTP(FullName(i))
Call Write_to_excel(CStr(Msg.ReceivedTime), CStr(Msg.Subject), CStr(STRNAME))
ElseIf ResolveDisplayNameToSMTP(FullName(i)) <> "" Then
STRNAME = ResolveDisplayNameToSMTP(FullName(i))
Call Write_to_excel(CStr(Msg.ReceivedTime), CStr(Msg.Subject), CStr(STRNAME))
End If
Next i
'Call Write_to_excel(CStr(Msg.ReceivedTime), CStr(Msg.Subject), CStr(STRNAME))
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Sub tes2t()
End Sub
Function getRecepientEmailAddress(eml As Variant)
Set out = CreateObject("System.Collections.Arraylist") ' a JavaScript-y array
For Each emlAddr In eml.Recipients
If Left(emlAddr.Address, 1) = "/" Then
' it's an Exchange email address... resolve it to an SMTP email address
out.Add ResolveDisplayNameToSMTP(emlAddr)
Else
out.Add emlAddr.Address
End If
Next
getRecepientEmailAddres = Join(out.ToArray(), ";")
End Function
Function ResolveDisplayNameToSMTP(sFromName) As String
' takes a Display Name (i.e. "James Smith") and turns it into an email address (james.smith#myco.com)
' necessary because the Outlook address is a long, convoluted string when the email is going to someone in the organization.
' source: https://stackoverflow.com/questions/31161726/creating-a-check-names-button-in-excel
Dim OLApp As Object 'Outlook.Application
Dim oRecip As Object 'Outlook.Recipient
Dim oEU As Object 'Outlook.ExchangeUser
Dim oEDL As Object 'Outlook.ExchangeDistributionList
Set OLApp = CreateObject("Outlook.Application")
Set oRecip = OLApp.Session.CreateRecipient(sFromName)
oRecip.Resolve
If oRecip.Resolved Then
Select Case oRecip.AddressEntry.AddressEntryUserType
Case 0, 5 'olExchangeUserAddressEntry & olExchangeRemoteUserAddressEntry
Set oEU = oRecip.AddressEntry.GetExchangeUser
If Not (oEU Is Nothing) Then
ResolveDisplayNameToSMTP = oEU.PrimarySmtpAddress
End If
Case 10, 30 'olOutlookContactAddressEntry & 'olSmtpAddressEntry
Dim PR_SMTP_ADDRESS As String
PR_SMTP_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
ResolveDisplayNameToSMTP = oRecip.AddressEntry.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
End Select
End If
End Function
Sub Write_to_excel(str1 As String, str2 As String, str3 As String)
Dim xlApp As Object
Dim sourceWB As Workbook
Dim sourceWH As Worksheet
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = True
.EnableEvents = False
End With
Set sourceWB = Workbooks.Open(strFile, False, False)
Set sourceWH = sourceWB.Worksheets("Sheet1")
sourceWB.Activate
With sourceWH
lastrow = .Cells(.rows.Count, "A").End(xlUp).Row
End With
sourceWH.Cells(lastrow + 1, 1) = str1
sourceWH.Cells(lastrow + 1, 2) = str2
sourceWH.Cells(lastrow + 1, 3) = str3
sourceWB.Save
sourceWB.Close
End Sub
Error message and corrected code
Regards,
Ramon
First of all, there is no need to create a new Application instance in the ResolveDisplayNameToSMTP method:
Set OLApp = CreateObject("Outlook.Application")
Instead, you can use the Application property available in the Outlook VBA editor out of the box.
Second, you need to use the following code to get the SMTP address from the AddressEntry object:
Dim PR_SMTP_ADDRESS As String
Set PR_SMTP_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
ResolveDisplayNameToSMTP = oRecip.AddressEntry.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
Instead of the following line:
ResolveDisplayNameToSMTP = oRecip.AddressEntry.Address
Read more about that in the How to get the SMTP Address of the Sender of a Mail Item using Outlook Object Model? article.

CreateChangesetAsync - How to checkin an existing file without knowing enconding or file type (just file path)

i tried to follow the example on how to create a changeset with multiple files: [See link][1]
Although i am a bit stuck at the TFVCItem and ItemContent stage where i don't know how to extract the content and enconding of my file.
Im trying to write some code in order to checkin a file given to me by a filePath and check it in at a given location.
Would anyone care to help me out on how to do this?
This is what i came up so far:
Public Function CreateChangeset(ByVal projectName As String,
ByVal files As Dictionary(Of String, String),
ByVal comment As String) As TfvcChangesetRef
Dim c = TFSConnection.GetClient(Of TfvcHttpClient)
Dim newChangetset = New TfvcChangeset
Dim changes = New List(Of TfvcChange)
For Each fKP In files
Dim fileSource = fKP.Key
Dim fileTarget = fKP.Value
Dim newChange = New TfvcChange
newChange.ChangeType = VersionControlChangeType.Add
Dim newItem = New TfvcItem
newItem.Path = $"&/{projectName}/{fileTarget}"
newItem.ContentMetadata = New FileContentMetadata
'' TODO: How to extract the correct encoding, and type?...
'newItem.ContentMetadata.Encoding = GetFileEncoding(fileSource)
'newItem.ContentMetadata.ContentType = "text/plain"
'newChange.Item = newItem
'' TODO: How to extract the correct content, and type?...
'Dim newContent = New ItemContent
'newContent.Content = "Blabla"
'newContent.ContentType = ItemContentType.RawText
'newChange.NewContent = newContent
changes.Add(newChange)
Next
newChangetset.Changes = changes
newChangetset.Comment = comment
Dim changesetRef = c.CreateChangesetAsync(newChangetset).Result
Return changesetRef
End Function
UPDATE:
Ok so i managed to make it work but i still am not sure how to properly set the ContentType.
I have the choice between ItemContentType.RawText and ItemContentType.Base64Encoded but i am not sure when to use one or the other.
Here is the new code which seems to work:
Public Function CreateChangeset(ByVal projectName As String,
ByVal files As Dictionary(Of String, String),
ByVal comment As String) As TfvcChangesetRef
Dim c = TFSConnection.GetClient(Of TfvcHttpClient)
Dim newChangetset = New TfvcChangeset
Dim changes = New List(Of TfvcChange)
For Each fKP In files
' Extract and build our target and source paths.
Dim fileSource = fKP.Key
Dim fileTarget = fKP.Value
Dim fileName = IO.Path.GetFileName(fileSource)
Dim newChange = New TfvcChange
' Create the new TFVC item which will be checked-in.
Dim newItem = New TfvcItem
newItem.Path = $"$/{projectName}/{fileTarget}/{fileName}"
newItem.ContentMetadata = New FileContentMetadata
' Try to extract the item from the server.
Dim serverItem = c.GetItemAsync(newItem.Path).Result
If serverItem Is Nothing Then
' If the file is not on the server, then its a new file.
newChange.ChangeType = VersionControlChangeType.Add
Else
' Indicate that we are dealing with a file modification
' and specify which version we are editing.
newChange.ChangeType = VersionControlChangeType.Edit
newItem.ChangesetVersion = serverItem.ChangesetVersion
End If
' Read the file content to a stream.
Using reader = New StreamReader(fileSource,
Text.Encoding.Default,
True) ' This last parameter allows to extract the correct encoding.
Dim fileContent As String = String.Empty
' Read all the file content to a string so that we can store
' it in the itemcontent.
' NOTE: reading it also allows to retrieve the correct file enconding.
If reader.Peek() >= 0 Then
fileContent = reader.ReadToEnd
End If
' Set the file enconding and MIME Type.
newItem.ContentMetadata.Encoding = reader.CurrentEncoding.WindowsCodePage
newItem.ContentMetadata.ContentType = System.Web.MimeMapping.GetMimeMapping(fileSource)
newChange.Item = newItem
' Set the file content.
Dim newContent = New ItemContent
newContent.Content = fileContent
' TODO: What should be the logic to set the Content Type? Not too sure...
' If newItem.ContentMetadata.ContentType.StartsWith("text/") Then
newContent.ContentType = ItemContentType.RawText
' Else
' newContent.ContentType = ItemContentType.Base64Encoded
' End If
' Store the content to the change.
newChange.NewContent = newContent
End Using
changes.Add(newChange)
Next
newChangetset.Changes = changes
newChangetset.Comment = comment
Dim changesetRef = c.CreateChangesetAsync(newChangetset).Result
Return changesetRef
End Function

how to hide other column

In my datagridview, I just want to show other fields such as ID,LastName,FirstName, and MiddleName and i dont want to show any fields but i want it to retrieve even it's hidden. But when i specify what i just want to show in my datagridview it causes runtime error.
this is my code to load the datagridview.
MysqlConn.Open()
Dim Query As String
Query = "select ID,LastName,FirstName,MiddleName from god.precord"
COMMAND = New MySqlCommand(Query, MysqlConn)
SDA.SelectCommand = COMMAND
SDA.Fill(dbDataSet)
bSource.DataSource = dbDataSet
DataGridView1.DataSource = bSource
SDA.Update(dbDataSet)
MysqlConn.Close()
Catch ex As Exception
MessageBox.Show(ex.Message)
Finally
MysqlConn.Dispose()
End Try
then this is my code for retrieve data into textboxes
Private Sub DataGridView1_CellContentClick(sender As System.Object, e As System.Windows.Forms.DataGridViewCellEventArgs) Handles DataGridView1.CellContentClick
If e.RowIndex >= 0 Then
Dim row As DataGridViewRow
row = Me.DataGridView1.Rows(e.RowIndex)
txtid.Text = row.Cells("ID").Value.ToString
txtlastname.Text = row.Cells("LastName").Value.ToString
txtfirstname.Text = row.Cells("FirstName").Value.ToString
txtmiddlename.Text = row.Cells("MiddleName").Value.ToString
txtaddress.Text = row.Cells("Address").Value.ToString
txtcontactno.Text = row.Cells("ContactNo").Value.ToString
txtgender.Text = row.Cells("Gender").Value.ToString
dtpbirthdate.Text = row.Cells("Birthdate").Value.ToString
txtage.Text = row.Cells("Age").Value.ToString
End If
End Sub
runtime error
please help me this is for my thesis
thankyou in advance <3
You have to add hidden column into the select query to retreive the data.
Hide the column from the DataGridView instead.
try
MysqlConn.Open()
Dim Query As String
Query = "select ID,LastName,FirstName,MiddleName,Address from god.precord"
COMMAND = New MySqlCommand(Query, MysqlConn)
SDA.SelectCommand = COMMAND
SDA.Fill(dbDataSet)
bSource.DataSource = dbDataSet
DataGridView1.DataSource = bSource
SDA.Update(dbDataSet)
DataGridView1.Columns("Address").Visible = false
MysqlConn.Close()
Catch ex As Exception
MessageBox.Show(ex.Message)
Finally
MysqlConn.Dispose()
End Try

Mail merge with Libre Office using .net

I have following code block which is working perfectly for OpenOffice SDK to automate Mail merge functionality.
Public Function runQueryOnDataSource(ByVal nameOfdDtaource As String, ByVal query As String) As Boolean
strLog = strLog + vbCrLf + Now.ToString() + ": runQueryOnDataSource nameOfdDtaource:" + nameOfdDtaource + ",query:" + query + "-Started"
Dim oDB As Object, oBase As Object
Dim oStatement As Object
Dim rSQL As String
Dim oRequete As Object
Dim oServiceManager As Object, CreateUnoService As Object
Try
'Creation instance Open office
oServiceManager = CreateObject("com.sun.star.ServiceManager")
CreateUnoService = oServiceManager.createInstance("com.sun.star.sdb.DatabaseContext")
mxMSFactory = (uno.util.Bootstrap.bootstrap()).getServiceManager()
oDB = CreateUnoService.getByName(nameOfdDtaource) 'oDB=XDataSource
'Connection
oBase = oDB.getConnection("", "") 'oBase=XConnection
oStatement = oBase.createStatement 'XStatement
'rSQL = "SELECT * FROM ""26_MailMergeResult_DEMO"
rSQL = query
oRequete = oStatement.execute(rSQL)
Return True
Catch ex As Exception
strLog = strLog + vbCrLf + Now.ToString() + ": Exception" + ex.ToString()
Throw ex
Finally
oDB = Nothing
oBase.Close()
oBase.Dispose()
End Try
strLog = strLog + vbCrLf + Now.ToString() + ": runQueryOnDataSource-Finished"
Return True
End Function
Above code is used to insert data into the DataSource already registered with libre office.But Now when I try to use it, line oServiceManager = CreateObject("com.sun.star.ServiceManager") generates error "Error Creating ActiveX object".
Do anyone have idea, How do I fix this.
This code does not look right, so I'm surprised it ever worked. In other examples, the bootstrap() line always goes first. Then use that service manager instead of a separate oServiceManager variable.
For example, see the Java code at https://www.openoffice.org/udk/common/man/spec/transparentofficecomponents.html.
EDIT:
You're almost there. The getByName() method returns uno.Any, which has a property called Value that DirectCast can use.
Dim oDB As XDataSource
Dim oBase As XConnection = Nothing
Dim xContext As XComponentContext = uno.util.Bootstrap.bootstrap()
Dim xMSFactory As XMultiServiceFactory = DirectCast(
xContext.getServiceManager(), XMultiServiceFactory)
Dim xNameAccess As XNameAccess = DirectCast(
xMSFactory.createInstance("com.sun.star.sdb.DatabaseContext"), XNameAccess)
oDB = DirectCast(xNameAccess.getByName("Bibliography").Value, XDataSource)
oBase = DirectCast(oDB.getConnection("", ""), XConnection)

VB.NET How can I detect if an iPhone is plugged in?

I need to detect if an iPhone is plugged in. I don't know how to make that in VB.NET. I tried to play around with WMI but I'm just a beginner.
Can everyone help me?
I tried this but it only detects Mass Storage
Public Class Form1
Private WithEvents m_MediaConnectWatcher As ManagementEventWatcher
Public USBDriveName As String
Public USBDriveLetter As String
Public Sub StartDetection()
' __InstanceOperationEvent will trap both Creation and Deletion of class instances
Dim query2 As New WqlEventQuery("SELECT * FROM __InstanceOperationEvent WITHIN 1 " _
& "WHERE TargetInstance ISA 'Win32_DiskDrive'")
m_MediaConnectWatcher = New ManagementEventWatcher
m_MediaConnectWatcher.Query = query2
m_MediaConnectWatcher.Start()
End Sub
Private Sub Arrived(ByVal sender As Object, ByVal e As System.Management.EventArrivedEventArgs) Handles m_MediaConnectWatcher.EventArrived
Dim mbo, obj As ManagementBaseObject
' the first thing we have to do is figure out if this is a creation or deletion event
mbo = CType(e.NewEvent, ManagementBaseObject)
' next we need a copy of the instance that was either created or deleted
obj = CType(mbo("TargetInstance"), ManagementBaseObject)
Select Case mbo.ClassPath.ClassName
Case "__InstanceCreationEvent"
If obj("InterfaceType") = "USB" Then
MsgBox(obj("Caption") & " (Drive letter " & GetDriveLetterFromDisk(obj("Name")) & ") has been plugged in")
Else
MsgBox(obj("InterfaceType"))
End If
Case "__InstanceDeletionEvent"
If obj("InterfaceType") = "USB" Then
MsgBox(obj("Caption") & " has been unplugged")
If obj("Caption") = USBDriveName Then
USBDriveLetter = ""
USBDriveName = ""
End If
Else
MsgBox(obj("InterfaceType"))
End If
Case Else
MsgBox("nope: " & obj("Caption"))
End Select
End Sub
Private Function GetDriveLetterFromDisk(ByVal Name As String) As String
Dim oq_part, oq_disk As ObjectQuery
Dim mos_part, mos_disk As ManagementObjectSearcher
Dim obj_part, obj_disk As ManagementObject
Dim ans As String = ""
' WMI queries use the "\" as an escape charcter
Name = Replace(Name, "\", "\\")
' First we map the Win32_DiskDrive instance with the association called
' Win32_DiskDriveToDiskPartition. Then we map the Win23_DiskPartion
' instance with the assocation called Win32_LogicalDiskToPartition
oq_part = New ObjectQuery("ASSOCIATORS OF {Win32_DiskDrive.DeviceID=""" & Name & """} WHERE AssocClass = Win32_DiskDriveToDiskPartition")
mos_part = New ManagementObjectSearcher(oq_part)
For Each obj_part In mos_part.Get()
oq_disk = New ObjectQuery("ASSOCIATORS OF {Win32_DiskPartition.DeviceID=""" & obj_part("DeviceID") & """} WHERE AssocClass = Win32_LogicalDiskToPartition")
mos_disk = New ManagementObjectSearcher(oq_disk)
For Each obj_disk In mos_disk.Get()
ans &= obj_disk("Name") & ","
Next
Next
Return ans.Trim(","c)
End Function
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
StartDetection()
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
m_MediaConnectWatcher.Stop()
Application.Exit()
End Sub
End Class